extra/mediawiki/api/api.factor

   1 ! Copyright (C) 2021, 2022 Giftpflanze.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays accessors assocs assocs.extras calendar
   4 combinators combinators.short-circuit continuations formatting
   5 http http.client io json kernel locals make math math.parser
   6 namespaces oauth1 prettyprint sequences strings system threads ;
   7 IN: mediawiki.api
   8
   9 TUPLE: oauth-login consumer-token consumer-secret access-token
  10 access-secret ;
  11 TUPLE: password-login username password ;
  12
  13 C: <oauth-login> oauth-login
  14 C: <password-login> password-login
  15
  16 SYMBOLS: botflag contact cookies csrf-token endpoint oauth-login
  17 password-login ;
  18
  19 <PRIVATE
  20
  21 SYMBOLS: basetimestamp curtimestamp ;
  22
  23 PRIVATE>
  24
  25 t botflag set-global
  26
  27 <PRIVATE
  28
  29 : prepare ( params -- params' )
  30     [ {
  31         { [ dup t = ] [ drop "true" ] }
  32         { [ dup number? ] [ number>string ] }
  33         { [ dup string? ] [ ] }
  34         { [ dup sequence? ] [
  35             [ {
  36                 { [ dup number? ] [ number>string ] }
  37                 [ ]
  38             } cond ] map "|" join
  39         ] }
  40     } cond ] assoc-map ;
  41
  42 : <api-request> ( params -- request )
  43         {
  44             { "format" "json" }
  45             { "formatversion" 2 }
  46             { "maxlag" 5 }
  47         } swap assoc-union prepare
  48         endpoint get
  49     <post-request>
  50         contact get vm-version vm-git-id 7 head
  51         "%s Factor/%s %s mediawiki.api" sprintf "User-Agent"
  52         set-header ;
  53
  54 : oauth-post ( params -- response data )
  55     oauth-login get
  56         dup consumer-token>>
  57         over consumer-secret>> <token> consumer-token set
  58         dup access-token>>
  59         swap access-secret>> <token> access-token set
  60     <api-request>
  61         <oauth-request-params> set-oauth
  62     http-request ;
  63
  64 : cookie-post* ( params -- assoc )
  65     <api-request>
  66         cookies get >>cookies
  67     http-request [ cookies>> cookies set-global ] dip json> ;
  68
  69 : login-token ( -- token )
  70     {
  71         { "action" "query" }
  72         { "meta" "tokens" }
  73         { "type" "login" }
  74     } cookie-post*
  75     { "query" "tokens" "logintoken" } deep-of ;
  76
  77 : login ( -- cookies )
  78     [
  79         "login" "action" ,,
  80         password-login get dup username>> "lgname" ,,
  81         password>> "lgpassword" ,,
  82         login-token "lgtoken" ,,
  83     ] { } make cookie-post* drop cookies get ;
  84
  85 : cookie-post ( params -- response data )
  86     <api-request>
  87         cookies get [ login ] unless* >>cookies
  88     http-request ;
  89
  90 : anon-post ( params -- response data )
  91     <api-request> http-request ;
  92
  93 : code-200? ( response assoc -- ? )
  94     over code>> dup 200 = dup [ 3nip ] [
  95         -roll "http status code %d" printf
  96         swap header>> [ "=" glue print ] assoc-each
  97         ...
  98         10 minutes sleep
  99     ] if ;
 100
 101 : retry-after? ( response -- ? )
 102     header>> "retry-after" of dup [ dup seconds sleep ] when ;
 103
 104 : nonce-already-used? ( assoc -- ? )
 105     "error" of
 106     [ "code" of "mwoauth-invalid-authorization" = ]
 107     [ "info" of "Nonce already used" subseq-of? ] bi
 108     and ;
 109
 110 : readonly? ( assoc -- ? )
 111     { "error" "code" } deep-of "readonly" = dup
 112     [ 5 minutes sleep ] when ;
 113
 114 DEFER: get-csrf-token
 115 : badtoken? ( assoc -- ? )
 116     { "error" "code" } deep-of "badtoken" = dup
 117     [ get-csrf-token drop ] when ;
 118
 119 : failed? ( response assoc -- response assoc ? )
 120     2dup {
 121         [ code-200? not ]
 122         [ drop retry-after? ]
 123         [ nip nonce-already-used? ]
 124         [ nip readonly? ]
 125         [ nip badtoken? ]
 126     } 2|| ;
 127
 128 : dispatch-call ( params -- response data )
 129     {
 130         { [ oauth-login get ] [ oauth-post ] }
 131         { [ password-login get ] [ cookie-post ] }
 132         [ anon-post ]
 133     } cond ;
 134
 135 PRIVATE>
 136
 137 : api-call ( params -- assoc )
 138     f f [
 139         failed?
 140     ] [
 141         2drop dup dispatch-call
 142         [ json> ] [ swap print rethrow ] recover
 143         "warnings" "errors" [ over at [ ... ] when* ] bi@
 144     ] do while 2nip ;
 145
 146 <PRIVATE
 147
 148 :: (query) ( params -- obj assoc )
 149     { { "action" "query" } } params assoc-union api-call dup
 150     [ "query" of ] transmute
 151     "siprop" params key? [
 152         params { "prop" "list" "meta" } values-of sift first of
 153     ] unless swap ;
 154
 155 PRIVATE>
 156
 157 :: call-continue ( params quot1: ( params -- obj assoc )
 158 quot2: ( ... -- ... ) -- seq )
 159     f f [
 160         "continue" of dup
 161     ] [
 162         params assoc-union quot1 call
 163         [ quot2 call >alist append ] dip
 164     ] do while drop ; inline
 165
 166 : query ( params -- seq )
 167     [ (query) ] [ ] call-continue ;
 168
 169 :: page-content ( title -- content )
 170     {
 171         { "action" "query" }
 172         { "prop" "revisions" }
 173         { "rvprop" { "content" "timestamp" } }
 174         { "rvlimit" 1 }
 175         { "rvslots" "main" }
 176         { "titles" title }
 177         { "curtimestamp" t }
 178     } api-call
 179     [ "curtimestamp" of curtimestamp set-global ]
 180     [
 181         "query" of "pages" "revisions" [ of first ] bi@
 182         [ "timestamp" of basetimestamp set-global ]
 183         [ { "slots" "main" "content" } deep-of ] bi
 184     ] bi ;
 185
 186 <PRIVATE
 187
 188 : get-csrf-token ( -- csrf-token )
 189     {
 190         { "meta" "tokens" }
 191         { "type" "csrf" }
 192     } query
 193     "csrftoken" of dup csrf-token set-global ;
 194
 195 PRIVATE>
 196
 197 : token-call ( params -- assoc )
 198     [
 199         %%
 200         csrf-token get [ get-csrf-token ] unless* "token" ,,
 201     ] { } make api-call ;
 202
 203 :: edit-page ( title text summary params -- assoc )
 204     [
 205         "edit" "action" ,,
 206         title "title" ,,
 207         summary "summary" ,,
 208         text "text" ,,
 209         curtimestamp get "now" or "starttimestamp" ,,
 210         basetimestamp get "now" or "basetimestamp" ,,
 211     ] { } make
 212     botflag get { { "bot" t } } { } ?
 213     params [ assoc-union ] bi@ token-call ;
 214
 215 :: move-page ( from to reason params -- assoc )
 216     {
 217         { "action" "move" }
 218         { "from" from }
 219         { "to" to }
 220         { "reason" reason }
 221         { "movetalk" t }
 222     } params assoc-union token-call ;
 223
 224 :: email ( target subject text -- assoc )
 225     {
 226         { "action" "emailuser" }
 227         { "target" target }
 228         { "subject" subject }
 229         { "text" text }
 230     } token-call ;