extra/mediawiki/api/api.factor

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