1 ! Copyright (C) 2021 Giftpflanze.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays accessors assocs assocs.extras calendar
4 combinators continuations formatting http http.client io
5 json.reader kernel locals make math math.parser namespaces
6 oauth1 prettyprint sequences strings system threads ;
9 TUPLE: oauth-login consumer-token consumer-secret access-token
11 TUPLE: password-login username password ;
13 C: <oauth-login> oauth-login
14 C: <password-login> password-login
16 SYMBOLS: botflag contact cookies csrf-token endpoint oauth-login
21 SYMBOLS: basetimestamp curtimestamp ;
29 : prepare ( params -- params' )
31 { [ dup t = ] [ drop "true" ] }
32 { [ dup number? ] [ number>string ] }
33 { [ dup string? ] [ ] }
36 { [ dup number? ] [ number>string ] }
42 : <api-request> ( params -- request )
47 } swap assoc-union prepare
50 contact get vm-version vm-git-id 7 head
51 "%s Factor/%s %s mediawiki.api" sprintf "User-Agent"
54 : oauth-post ( params -- response data )
57 over consumer-secret>> <token> consumer-token set
59 swap access-secret>> <token> access-token set
61 <oauth-request-params> set-oauth
64 : cookie-post* ( params -- assoc )
67 http-request [ cookies>> cookies set-global ] dip json> ;
69 : login-token ( -- token )
75 "query" "tokens" "logintoken" [ of ] tri@ ;
77 : login ( -- cookies )
80 password-login get dup username>> "lgname" ,,
81 password>> "lgpassword" ,,
82 login-token "lgtoken" ,,
83 ] { } make cookie-post* drop cookies get ;
85 : cookie-post ( params -- response data )
87 cookies get [ login ] unless* >>cookies
90 : anon-post ( params -- response data )
91 <api-request> http-request ;
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
101 : retry-after? ( response -- ? )
102 header>> "retry-after" of dup [ dup seconds sleep ] when ;
104 : nonce-already-used? ( assoc -- ? )
106 [ "code" of "mwoauth-invalid-authorization" = ]
107 [ "info" of "Nonce already used" swap subseq-start ] bi
110 : readonly? ( assoc -- ? )
111 "error" "code" [ of ] bi@ "readonly" = dup
112 [ 5 minutes sleep ] when ;
114 : failed? ( response assoc -- response assoc ? )
115 2dup 2dup code-200? not
117 over nonce-already-used? or
120 : dispatch-call ( params -- response data )
122 { [ oauth-login get ] [ oauth-post ] }
123 { [ password-login get ] [ cookie-post ] }
129 : api-call ( params -- assoc )
133 2drop dup dispatch-call
134 [ json> ] [ swap print rethrow ] recover
135 "warnings" "errors" [ over at [ ... ] when* ] bi@
140 :: (query) ( params -- obj assoc )
141 { { "action" "query" } } params assoc-union api-call dup
142 dup "query" of [ nip ] when*
143 "siprop" params key? [
144 params { "prop" "list" "meta" } values-of sift first of
149 :: call-continue ( params quot1: ( params -- obj assoc )
150 quot2: ( ... -- ... ) -- seq )
154 params assoc-union quot1 call
155 [ quot2 call >alist append ] dip
156 ] do while drop ; inline
158 : query ( params -- seq )
159 [ (query) ] [ ] call-continue ;
161 :: page-content ( title -- content )
164 { "prop" "revisions" }
165 { "rvprop" { "content" "timestamp" } }
171 [ "curtimestamp" of curtimestamp set-global ]
173 "query" of "pages" "revisions" [ of first ] bi@
174 [ "timestamp" of basetimestamp set-global ]
175 [ "slots" "main" "content" [ of ] tri@ ] bi
180 : get-csrf-token ( -- csrf-token )
185 "csrftoken" of dup csrf-token set-global ;
189 : token-call ( params -- assoc )
192 csrf-token get [ get-csrf-token ] unless* "token" ,,
193 ] { } make api-call ;
195 :: edit-page ( title text summary params -- assoc )
201 curtimestamp get "now" or "starttimestamp" ,,
202 basetimestamp get "now" or "basetimestamp" ,,
204 botflag get { { "bot" t } } { } ?
205 params [ assoc-union ] bi@ token-call ;
207 :: move-page ( from to reason params -- assoc )
214 } params assoc-union token-call ;
216 :: email ( target subject text -- assoc )
218 { "action" "emailuser" }
220 { "subject" subject }