refresh google access tokens

ape/dojo.hoon

@@ -502,8 +502,9 @@
           =+  hit=;;(httr q.q.cay)
           =-  (flop (turn `wall`- |=(a=tape leaf/(dash:ut a ''))))
           :-  "HTTP {<p.hit>}"
-          %+  weld
+          %+  welp
             (turn q.hit |=([a=@t b=@t] "{(trip a)}: {(trip b)}"))
+          :-  ""
           (turn `wain`?~(r.hit ~ (lore q.u.r.hit)) trip)
       ==
     ::

arvo/eyre.hoon

@@ -66,8 +66,9 @@
 ++  whir-of  ,[p=span:ship q=term r=wire]               ::  path in dock
 ++  whir-se
   $?  %core                                             ::  build agent
-      %bak                                              ::  ++bak auth response
       %out                                              ::  ++out mod request
+      %res                                              ::  ++res use result
+      %bak                                              ::  ++bak auth response
       %in                                               ::  ++in handle code 
   ==                                                    ::
 --                                                      ::
@@ -723,7 +724,7 @@
         %thou
       ?+    -.tee  !!
         %ay  (ames-gram (slav %p p.tee) got/~ (slav %uv q.tee) |2.sih)
-        %hi  (cast-thou p.tee p.sih)
+        %hi  (cast-thou p.tee httr/!>(p.sih))
         %se  (get-thou:(dom-vi q.tee) p.tee p.sih)
       ==
     ::
@@ -880,8 +881,7 @@
     (pass-note tea (ford-req root-beak [%cast mar `cay]))
   ::
   ++  cast-thou
-    |=  [mar=mark hit=httr]
-    =+  cay=[%httr !>(`httr`hit)]
+    |=  [mar=mark cay=cage]
     ?:  ?=(%httr mar)  (give-sigh %& cay)
     (back si/~ mar cay)
   ::
@@ -1603,6 +1603,7 @@
     --
   ++  vi                                                ::  auth engine
     |_  [dom=path cor=(unit vase) req=(qeu ,[p=duct q=mark r=vase:hiss])]
+    ++  self  .
     ++  abet  +>(sec (~(put by sec) +<))
     ++  dead-hiss  |=(a=tang (give-sigh:abet %| a))
     ++  dead-this  |=(a=tang (fail:abet 500 0v0 a))
@@ -1620,7 +1621,7 @@
       (call(hen p.u.ole) %out hiss/r.u.ole)
     ::
     ++  call
-      |=  [arm=?(%bak %out %in) sam=cage]
+      |=  [arm=?(%bak %res %out %in) sam=cage]
       ?~  cor  ~|(%no-core !!)
       =.  +12.q.u.cor
         =+  ato=(sky %cx (tope root-beak [%atom (flop %_(dom . sec/dom))]))
@@ -1639,9 +1640,10 @@
       |=  [wir=whir-se dep=@uvH res=(each cage tang)]  ^+  abet
       ?-  wir
         %core  (get-upd dep res)
-        %bak   (res-bak res)
         %out   (res-out res)
+        %res   (res-res res)
         %in    (res-in res)
+        %bak   (res-bak res)
       ==
     ::
     ++  get-thou
@@ -1649,12 +1651,20 @@
       ?+  wir  !!
         %in  (call %bak httr/!>(hit))
         %out
-          =^  ole  req  ~(get to req)
-          =>  .(ole `[p=duct q=mark *]`ole)             :: XX types
-          =.  ..vi  (cast-thou(hen p.ole) q.ole hit)    :: error?
-          pump
+          =+  opt=(sa (sloe ?~(cor %void p.u.cor)))
+          ?:  (~(has in opt) %res)
+            (call %res httr/!>(hit))
+          (do-give !>([%give hit]))
       ==
     ::
+    ++  do-give
+      |=  vax=vase
+      =.  vax  (slam !>(|=([%give a=httr] a)) vax)
+      =^  ole  req  ~(get to req)
+      =>  .(ole `[p=duct q=mark *]`ole)             :: XX types
+      =.  ..vi  (cast-thou(hen p.ole) q.ole httr/vax)    :: error?
+      pump
+    ::
     ++  on-error
       |=  [err=$+(tang _abet) try=$+(vase _abet)]
       |=  a=(each cage tang)  ^+  abet
@@ -1677,21 +1687,37 @@
     ::
     ++  res-in
       %+  on-error  dead-this
-      (allow send/(to-eyre %in) ~)
+      (allow send/(do-send %in) ~)
     ::
-    ++  to-eyre
+    ++  do-send
       |=  wir=whir-se  ^-  $+(vase _abet)
       |=  res=vase
       (eyre-them wir (slam !>(|=([%send a=hiss] a)) res))
     ::
+    ++  res-res
+      %+  on-error  |=(a=tang (dead-hiss(req ~(nap to req)) a))
+      %-  stateful  |=  a=_self  =>  a
+      %-  allow  :~
+        give/do-give
+        send/(do-send %out)
+        redo/,_pump
+      ==
+    ::
     ++  res-bak
       %+  on-error  dead-this
+      %-  stateful  |=  a=_self  =>  a
+      %-  allow  :~
+        give/do-give
+        redo/,_pump(..vi (give-html 200 ~ exit:xml))
+      ==
+    ::
+    ++  stateful
+      |=  han=$+(_self $+(vase:sec-move _abet))
       |=  res=vase  ^+  abet
       ?~  cor  ~|(%lost-core !!)
       =^  mow  u.cor
         ~|(%split [mow=(slot 2 res) cor=(slot 3 res)])
-      =<  ((allow redo/. ~) mow)
-      ,_pump(..vi (give-html 200 ~ exit:xml))
+      ((han self(cor cor)) mow)
     ::
     ++  res-out
       |=  a=(each cage tang)  ^+  abet
@@ -1700,10 +1726,12 @@
       %.  a
       %+  on-error  warn
       %-  allow  :~
-        send/(to-eyre %out)
-        show/(discard-with !>(auth-print))
+        give/do-give
+        send/(do-send %out)
+        show/do-show
       ==
     ::
+    ++  do-show  (discard-with !>(auth-print))
     ++  discard-with
       |=  a=vase:gate  ^-  $+(vase _abet)
       |=(b=vase =+((slam a b) abet))

arvo/zuse.hoon

@@ -1826,6 +1826,7 @@
 ++  sec-move                                            ::  driver effect
   $%  [%send p=hiss]                                    ::  http out
       [%show p=purl]                                    ::  direct user to url
+      [%give p=httr]                                    ::  respond immediately
       [%redo ~]                                         ::  restart request qeu
   ==                                                    ::
 ++  ball  ,@uw                                          ::  statement payload

sec/com/github/api.hoon

@@ -1,4 +1,4 @@
-|_  [(bale ,@t) ~]
-++  out  |=(a=hiss [%send %_(a q.q (~(add ja q.q.a) %authorization auth))])
-++  auth  (cat 3 'Basic ' key)
+|_  [bal=(bale ,@t) ~]
+++  out  |=(a=hiss [%send %_(a p.p [| `6.000 `/localhost], q.q (~(add ja q.q.a) %authorization auth))])
+++  auth  (cat 3 'Basic ' key.bal)
 --

sec/com/googleapis/www.hoon

@@ -40,7 +40,7 @@
     redirect-uri/redirect-uri
   ==
 ++  redirect-uri  'http://localhost:8443/~/ac/www.googleapis.com/auth'
-++  user-state  ,[ber=@t]
+++  user-state  ,[ber=@t ref=@t ded=@da]
 --
 ::
 ::::
@@ -49,44 +49,64 @@
 ++  decode-keys  ((hard ,[cid=@t cis=@t ~]) (lore key)) :: XX typed %jael
 ++  client-id      cid:decode-keys
 ++  client-secret  cis:decode-keys
+::
+++  need-refresh  (lth ded (add now ~m1))
 ++  out
   |=  a=hiss  ^-  sec-move
   ?~  ber  [%show (auth-url client-id 'userinfo.email' 'plus.me' ~)]
+  ?:  need-refresh
+    [%send toke-url (toke-req refresh-token/ref grant-type/'refresh_token' ~)]
   [%send %_(a q.q (~(add ja q.q.a) %authorization (cat 3 'Bearer ' ber)))]
 ::
-++  in
-  |=  a=quay  ^-  sec-move
-  =+  cod=~|(%no-code (~(got by (mo a)) %code))
-  =+  hed=(mo ~[content-type/~['application/x-www-form-urlencoded']])
-  =-  [%send toke-url %post hed `(tact +:(tail:earn code/cod -))]
+++  toke-req
+  |=  quy=quay  ^-  moth 
+  :+  %post  (mo ~[content-type/~['application/x-www-form-urlencoded']])
+  =-  `(tact +:(tail:earn -))
   %-  fass
+  %+  welp  quy
   :~  client-id/client-id
       client-secret/client-secret
       redirect-uri/redirect-uri
-      grant-type/'authorization_code'
+      
   ==
+++  in
+  |=  a=quay  ^-  sec-move
+  =+  cod=~|(%no-code (~(got by (mo a)) %code))
+  [%send toke-url (toke-req code/cod grant-type/'authorization_code' ~)]
 ::
-++  parse-auth
-  |=  [@u a=@t]
-  %.  a
-  ;~  biff
-    poja
-    =>  jo  %-  ot  :~
-      'token_type'^(su (jest 'Bearer'))
-      'access_token'^so
-      'refresh_token'^so
-      'expires_in'^ni
-    ==
+++  res
+  |=  a=httr  ^-  [sec-move _+>]
+  ?:  need-refresh
+    ?.  ?=(2 (div p.a 100))    :: bad response
+      ~&  bad-httr/p.a
+      [[%redo ~] +>.$]
+    ~|  %refreshed-token
+    [[%redo ~] (new-token (grab a parse-toke))]
+  [[%give a] +>.$]
+::
+++  new-token
+  |=  [typ=term ber=@t tim=@u]
+  ?>  ?=(%bearer typ)
+  +>.$(ber ber, ded (add now (mul ~s1 tim)))
+::
+++  grab
+  |*  [a=httr b=fist:jo]
+  ~|  bad-json/r.a
+  (need (;~(biff poja b) q:(need r.a)))
+::
+++  parse-toke
+  =>  jo  %-  ot  :~
+    'token_type'^(cu cass sa)
+    'access_token'^so
+    'expires_in'^ni
   ==
 ::
 ++  bak
-  |=  res=httr  ^-  [sec-move _+>]
-  ?.  ?=(2 (div p.res 100))    :: bad response
-    ~&  bad-httr/p.res
+  |=  a=httr  ^-  [sec-move _+>]
+  ?.  ?=(2 (div p.a 100))    :: bad response
+    ~&  bad-httr/p.a
     [[%redo ~] +>.$]
-  =+  ~|  bad-json/r.res
-      ^-  [@ ber=@t ref=@t tim=@u]
-      (need (parse-auth (need r.res)))
   :-  [%redo ~]
-  +>.$(ber ber)
+  =.  ref  (grab a (ot 'refresh_token'^so ~):jo)
+  (new-token (grab a parse-toke))
 --