resturcture /+oauth1,basic-auth so the ++standard magic is in one place

with sample usage in the comments
This commit is contained in:
Anton Dyudin 2016-04-07 10:37:28 -07:00
parent a24c4da4b3
commit f26446e150
4 changed files with 127 additions and 102 deletions

View File

@ -8,20 +8,26 @@
:: ::
:::: ::::
:: ::
|_ bal/(bale keys) |_ {bal/(bale keys) $~}
++ auth-header ++ auth
^- {term cord} |%
?~ key.bal ++ header
~_ leaf+"Run |init-auth-basic {<`path`dom.bal>}" ^- cord
~|(%basic-auth-no-key !!) ?~ key.bal
[%authorization (cat 3 'Basic ' key.bal)] ~_ leaf+"Run |init-auth-basic {<`path`dom.bal>}"
~|(%basic-auth-no-key !!)
(cat 3 'Basic ' key.bal)
--
::
++ add-auth-header
|= a/hiss ^- hiss
~& auth+(earn p.a)
%_(a q.q (~(add ja q.q.a) %authorization header:auth))
:: ::
++ standard ++ standard
|% |%
++ out-adding-header ++ out-adding-header
|= a/hiss ^- sec-move |= a/hiss ^- sec-move
=+ aut=auth-header [%send (add-auth-header a)]
~& aut=aut
[%send %_(a q.q (~(add ja q.q.a) -.aut +.aut))]
-- --
-- --

View File

@ -72,12 +72,12 @@
++ dbg-post `purl`[`hart`[| `6.000 [%& /localhost]] `pork``/testing `quay`/] ++ dbg-post `purl`[`hart`[| `6.000 [%& /localhost]] `pork``/testing `quay`/]
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &))) ++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ quay-keys |-($@(knot {$ $})) :: improper tree ++ quay-keys |-($@(knot {$ $})) :: improper tree
++ grab-quay :: ?=({@t @t @t} ((grab-quay *httr) %key1 %key2 %key3)) ++ grab-quay :: ?=({@t @t @t} (grab-quay r:*httr %key1 %key2 %key3))
|* {a/httr b/quay-keys} |* {a/(unit octs) b/quay-keys}
~| bad-quay+r.a =+ ~| bad-quay+a
=+ quy=(rash q:(need r.a) yquy:urlp) c=(rash q:(need `(unit octs)`a) yquy:urlp)
~| quy ~| grab-quay+[c b]
=+ all=(malt quy) =+ all=(malt c)
%. b %. b
|* b/quay-keys |* b/quay-keys
?@ b ~|(b (~(got by all) b)) ?@ b ~|(b (~(got by all) b))
@ -89,6 +89,11 @@
~| bad-url+a ~| bad-url+a
(rash a auri:epur) (rash a auri:epur)
:: ::
++ add-query
|= {a/$@(@t purl) b/quay} ^- purl
?@ a $(a (parse-url a)) :: deal with cord
a(r (weld r.a b))
::
++ interpolate-url ++ interpolate-url
|= {a/$@(cord purl) b/(unit hart) c/(list (pair term knot))} |= {a/$@(cord purl) b/(unit hart) c/(list (pair term knot))}
^- purl ^- purl
@ -110,12 +115,7 @@
!: !:
:::: ::::
:: ::
|= {request/$@(@t purl) dialog/$@(@t purl) code-exchange/$@(@t purl)} |_ {(bale keys) tok/token}
=+ :+ dialog-url=(parse-url dialog)
exchange-url=(parse-url code-exchange)
token-reqs-url=(parse-url request)
|_ {done/* (bale keys) tok/token}
+- core-move $^({sec-move _done} sec-move) :: stateful
++ consumer-key key:decode-keys ++ consumer-key key:decode-keys
++ consumer-secret sec:decode-keys ++ consumer-secret sec:decode-keys
++ decode-keys :: XX from bale w/ typed %jael ++ decode-keys :: XX from bale w/ typed %jael
@ -141,30 +141,20 @@
user+(scot %ta usr) user+(scot %ta usr)
== ==
:: ::
++ token-exchange
|= a/$@(@t purl) ^- hiss
(post-quay (parse-url a) ~)
:: ::
++ toke-url ++ token-request
|= quy/quay ^- purl |= a/$@(@t purl) ^- hiss
%_ dialog-url (post-quay (parse-url a) oauth-callback+oauth-callback ~)
r (fass ?~(usr quy [screen-name+usr quy]))
==
:: ::
++ token-exchange (post-quay exchange-url ~) ++ grab-token-response
++ token-request (post-quay token-reqs-url oauth-callback+oauth-callback ~) |= a/httr ^- {tok/@t sec/@t}
(grab-quay r.a 'oauth_token' 'oauth_token_secret')
:: ::
:: use token to sign authorization header. requires: ++ check-token-quay
:: ++ res (res-handle-reqt handle-token) :: take request token |= a/quay ^+ %&
:: ++ bak (res-save-access handle-token) :: obtained access token
++ out-math
^- $-(hiss $%({$send hiss} {$show purl}))
?~ tok
_[%send (add-auth ~ token-request)]
?: ?=($request-token -.tok)
_[%show (toke-url oauth-token+oauth-token.tok ~)]
|= a/hiss ^- {$send hiss}
[%send (add-auth [oauth-token+oauth-token.tok]~ a)]
::
++ in-oauth-token
|= a/quay ^- sec-move
=. a (sort a aor) =. a (sort a aor)
?. ?=({{$'oauth_token' oauth-token/@t} {$'oauth_verifier' @t} $~} a) ?. ?=({{$'oauth_token' oauth-token/@t} {$'oauth_verifier' @t} $~} a)
~|(no-token+a !!) ~|(no-token+a !!)
@ -173,54 +163,15 @@
?. =(oauth-token.tok oauth-token.q.i.a) ?. =(oauth-token.tok oauth-token.q.i.a)
~| wrong-token+[id=usr q.i.a] ~| wrong-token+[id=usr q.i.a]
~|(%multiple-tokens-unsupported !!) ~|(%multiple-tokens-unsupported !!)
[%send (add-auth a token-exchange)] %&
:: ::
++ token-response ['oauth_token' 'oauth_token_secret'] ++ auth
+- bak-save-access
|= handle/$-(token _done)
%- (res-parse token-response)
|= access-token/{tok/@t sec/@t} ^- core-move
[[%redo ~] (handle `token`[%access-token access-token])]
::
+- res-parse
|* para/quay-keys
|= handle/$-(_?~(para ~ (grab-quay *httr para)) core-move)
|= a/httr ^- core-move
?: (bad-response p.a)
[%give a]
:: [%redo ~] :: handle 4xx?
(handle (grab-quay a para))
::
++ res-give |=(a/httr [%give a])
+- res-handle-reqt
|= handle/$-(token _done) ^- $-(httr core-move)
?~ tok
(res-save-reqt handle)
res-give
::
+- res-save-reqt
|= handle/$-(token _done) ^- $-(httr core-move)
%- (res-parse token-response 'oauth_callback_confirmed')
|= {request-token/{tok/@t sec/@t} cof/term} ^- core-move
?. =(%true cof)
~|(%callback-rejected !!)
[[%redo ~] (handle `token`[%request-token request-token])]
::
::
++ add-auth
=< |= $: auq/quay :: extra oauth parameters
hiz/{purl meth hed/math (unit octs)}
==
^- hiss
~& add-auth+(earn -.hiz)
%_ hiz
hed (~(add ja hed.hiz) %authorization (authorization auq hiz))
==
|% |%
++ authorization ++ header
|= {auq/quay url/purl med/meth math bod/(unit octs)} |= {auq/quay url/purl med/meth math bod/(unit octs)}
^- cord
=^ quy url [r.url url(r ~)] :: query string handled separately =^ quy url [r.url url(r ~)] :: query string handled separately
=. auq (fass (weld auq auth-quay)) =. auq (fass (weld auq computed-query))
=+ ^- qen/quay-enc :: semi-encoded for sorting =+ ^- qen/quay-enc :: semi-encoded for sorting
%+ weld (parse-pairs bod) %+ weld (parse-pairs bod)
(encode-pairs (weld auq quy)) (encode-pairs (weld auq quy))
@ -229,7 +180,7 @@
=. auq ['oauth_signature'^(crip (urle sig)) auq] =. auq ['oauth_signature'^(crip (urle sig)) auq]
(crip "OAuth {(to-header auq)}") (crip "OAuth {(to-header auq)}")
:: ::
++ auth-quay ++ computed-query
^- quay ^- quay
:~ oauth-consumer-key+consumer-key :~ oauth-consumer-key+consumer-key
oauth-nonce+(scot %uw (shaf %non eny)) oauth-nonce+(scot %uw (shaf %non eny))
@ -256,4 +207,68 @@
(trip ?^(tok token-secret.tok '')) (trip ?^(tok token-secret.tok ''))
== ==
-- --
::
++ add-auth-header
|= {extra/quay request/{url/purl meth hed/math (unit octs)}}
^- hiss
~& add-auth-header+(earn url.request)
%_ request
hed
(~(add ja hed.request) %authorization (header:auth extra request))
==
:: expected semantics, to be copied and modified if anything doesn't work
++ standard
|* {done/* save/$-(token *)} :: save/$-(token _done)
|%
++ core-move $^({sec-move _done} sec-move) :: stateful
::
:: use token to sign authorization header. expects:
:: ++ res res-handle-request-token :: save request token
:: ++ in (in-token-exhange 'http://...') :: handle callback
++ out-adding-header
|= {request-url/$@(@t purl) dialog-url/$@(@t purl)}
::
|= a/hiss ^- $%({$send hiss} {$show purl})
?- tok
$~
[%send (add-auth-header ~ (token-request request-url))]
::
{$access-token ^}
[%send (add-auth-header [oauth-token+oauth-token.tok]~ a)]
::
{$request-token ^}
:- %show
%+ add-query dialog-url
%- fass
:- oauth-token+oauth-token.tok
?~(usr ~ [screen-name+usr]~)
==
::
:: If no token is saved, the http response we just got has a request token
++ res-handle-request-token
|= a/httr ^- core-move
?^ tok [%give a]
?. =(%true (grab-quay r.a 'oauth_callback_confirmed'))
~|(%callback-rejected !!)
=+ request-token=(grab-token-response a)
[[%redo ~] (save `token`[%request-token request-token])]
::
:: Exchange oauth_token in query string for access token. expects:
:: ++ bak bak-save-token :: save access token
++ in-token-exchange
|= exchange-url/$@(@t purl)
::
|= a/quay ^- sec-move
?> (check-token-quay a)
[%send (add-auth-header a (token-exchange exchange-url))]
::
:: If a valid access token has been returned, save it
++ bak-save-token
|= a/httr ^- core-move
?: (bad-response p.a)
[%give a] :: [%redo ~] :: handle 4xx?
=+ access-token=(grab-token-response a)
[[%redo ~] (save `token`[%access-token access-token])]
::
--
-- --

View File

@ -5,6 +5,6 @@
/+ basic-auth /+ basic-auth
!: !:
|_ {bal/(bale keys:basic-auth) $~} |_ {bal/(bale keys:basic-auth) $~}
++ aut ~(standard basic-auth bal) ++ aut ~(standard basic-auth bal ~)
++ out out-adding-header:aut ++ out out-adding-header:aut
-- --

View File

@ -6,17 +6,21 @@
!: !:
:::: ::::
:: ::
=+ ^= aut |_ {bal/(bale keys:oauth1) tok/token:oauth1}
%^ oauth1 :: aut is a "standard oauth1" core, which implements the
'https://api.twitter.com/oauth/request_token' :: most common handling of oauth1 semantics. see lib/oauth1 for more details.
'https://api.twitter.com/oauth/authorize' ++ aut (~(standard oauth1 bal tok) . |=(tok/token:oauth1 +>(tok tok)))
'https://api.twitter.com/oauth/access_token' ++ out
|_ {(bale keys:oauth1) tok/token:oauth1} %+ out-adding-header:aut
++ aut ~(. ^aut . +<- +<+) :: XX electroplating token-request='https://api.twitter.com/oauth/request_token'
++ out out-math:aut oauth-dialog='https://api.twitter.com/oauth/authorize'
++ in in-oauth-token:aut ::
++ bak (bak-save-access:aut save-token) ++ res res-handle-request-token:aut
++ res (res-handle-reqt:aut save-token) ++ bak bak-save-token:aut
++ save-token |=(tok/token:aut +>(tok tok)) ::
::++ wyp ~ ++ in
%- in-token-exchange:aut
exchange-url='https://api.twitter.com/oauth/access_token'
::
:: ++ wyp ~
-- --