oauth2: support for renewing the access token using refresh

extra/google/gmail/gmail.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2016 Björn Lindqvist.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays json.reader kernel namespaces oauth2 sequences ;
+USING: accessors arrays json.reader kernel namespaces oauth2 sequences ;
 IN: google.gmail
 
 CONSTANT: api-base "https://www.googleapis.com/gmail/v1/users"
@@ -18,13 +18,19 @@ SYMBOL: access-token
 
 : ensure-token ( -- )
     access-token [
-        [ oauth2 get console-flow ] unless*
+        [
+            dup access-expired? [
+                oauth2 get over refresh-flow update-tokens
+            ] when
+        ] [
+            oauth2 get console-flow
+        ] if*
     ] change ;
 
 : api-call ( method get-params -- result )
     ensure-token
     [ api-base prepend ] dip string+params>url
-    access-token get oauth-http-get nip
+    access-token get access>> oauth-http-get nip
     json> ;
 
 : list-drafts ( -- seq )

extra/oauth2/oauth2-tests.factor

@@ -1,6 +1,19 @@
-USING: kernel oauth2 tools.test urls ;
+USING: accessors calendar kernel oauth2 tools.test urls ;
 IN: oauth2.tests
 
+! assoc>tokens
+{
+    "blah" "bleh" t
+} [
+    H{
+        { "expires_in" 3600 }
+        { "access_token" "blah" }
+        { "token_type" "Bearer" }
+        { "refresh_token" "bleh" }
+    } assoc>tokens
+    [ access>> ] [ refresh>> ] [ expiry>> timestamp? ] tri
+] unit-test
+
 ! oauth2>auth-uri
 {
     URL" https://github.com/login/oauth/authorize?client_id=1234&scope=user&redirect_uri=test-pest&state=abcd&response_type=code&access_type=offline"
@@ -12,14 +25,14 @@ IN: oauth2.tests
     { { "state" "abcd" } } oauth2 boa oauth2>auth-uri
 ] unit-test
 
-! token-params
+! tokens-params
 {
     {
+        { "code" "hej" }
         { "client_id" "1234" }
         { "client_secret" "password" }
         { "redirect_uri" "test-pest" }
         { "state" "abcd" }
-        { "code" "hej" }
         { "grant_type" "authorization_code" }
     }
 } [
@@ -27,5 +40,5 @@ IN: oauth2.tests
     "https://github.com/login/oauth/access_token"
     "test-pest"
     "1234" "password" "user" { { "state" "abcd" } } oauth2 boa
-    "hej" token-params
+    "hej" tokens-params
 ] unit-test

extra/oauth2/oauth2.factor

@@ -1,9 +1,40 @@
 ! Copyright (C) 2016 Björn Lindqvist.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs http.client io json.reader kernel
+USING: accessors assocs calendar combinators http.client io
-sequences unicode urls webbrowser ;
+json.reader kernel make math.order sequences unicode urls webbrowser ;
 IN: oauth2
 
+! Random utility
+: set-query-params ( url params -- url )
+    [ first2 swap set-query-param ] each ;
+
+: string+params>url ( string params -- url )
+    [ >url ] dip set-query-params ;
+
+: console-prompt ( query -- str/f )
+    write flush readln [ blank? ] trim
+    dup "" = [ drop f ] [ ] if ;
+
+: post-json-request ( params token-uri -- assoc )
+    <post-request> dup header>> "application/json" "Accept" rot set-at
+    http-request nip json> ;
+
+TUPLE: tokens access refresh expiry ;
+
+: assoc>expiry ( json -- expiry )
+    "expires_in" of [ seconds now time+ ] [ f ] if* ;
+
+: assoc>tokens ( json -- tokens )
+    [ "access_token" of ]
+    [ "refresh_token" of ]
+    [ assoc>expiry ] tri tokens boa ;
+
+: access-expired? ( tokens -- ? )
+    expiry>> [ now before? ] [ f ] if* ;
+
+: update-tokens ( tokens1 tokens2 -- tokens1 )
+    2dup expiry>> >>expiry drop access>> >>access ;
+
 TUPLE: oauth2
     auth-uri
     token-uri
@@ -13,56 +44,58 @@ TUPLE: oauth2
     scope
     extra-params ;
 
-: set-query-params ( url params -- url )
+: tokens-params ( oauth2 code -- params )
-    [ first2 swap set-query-param ] each ;
-
-: string+params>url ( string params -- url )
-    [ >url ] dip set-query-params ;
-
-: console-prompt ( query -- str )
-    write flush readln [ blank? ] trim ;
-
-: token-params ( oauth2 code -- params )
     [
+        "code" ,,
+        {
+            [ client-id>> "client_id" ,, ]
+            [ client-secret>> "client_secret" ,, ]
+            [ redirect-uri>> "redirect_uri" ,, ]
+            [ extra-params>> %% ]
+        } cleave
+        "authorization_code" "grant_type" ,,
+    ] { } make ;
+
+: refresh-params ( oauth2 refresh -- params )
     [
-            [ client-id>> "client_id" swap 2array ]
+        "refresh_token" ,,
-            [ client-secret>> "client_secret" swap 2array ]
+        [ client-id>> "client_id" ,, ]
-            [ redirect-uri>> "redirect_uri" swap 2array ] tri 3array
+        [ client-secret>> "client_secret" ,, ]
-        ] [ extra-params>> ] bi append
+        [ extra-params>> %% ] tri
-    ] [
+        "refresh_token" "grant_type" ,,
-        "code" swap 2array
+    ] { } make ;
-    ] bi* suffix {
-        { "grant_type" "authorization_code" }
-    } append ;
 
 : auth-params ( oauth2 -- params )
     [
-        [ client-id>> "client_id" swap 2array ]
+        {
-        [ scope>> "scope" swap 2array ]
+            [ client-id>> "client_id" ,, ]
-        [ redirect-uri>> "redirect_uri" swap 2array ] tri 3array
+            [ scope>> "scope" ,, ]
-    ] [ extra-params>> ] bi append {
+            [ redirect-uri>> "redirect_uri" ,, ]
-        { "response_type" "code" }
+            [ extra-params>> %% ]
-        { "access_type" "offline" }
+        } cleave
-    } append ;
+        "code" "response_type" ,,
+        "offline" "access_type" ,,
+    ] { } make ;
 
 : oauth2>auth-uri ( oauth2 -- uri )
     [ auth-uri>> ] [ auth-params ] bi string+params>url ;
 
-: post-token-request ( params token-uri -- token )
-    <post-request> dup header>> "application/json" "Accept" rot set-at
-    http-request nip json> "access_token" of ;
-
 ! Other flows can be useful to support too.
-: console-flow ( oauth2 -- token )
+: console-flow ( oauth2 -- tokens/f )
-    [ oauth2>auth-uri open-url ] [
+    dup oauth2>auth-uri open-url
-        [ "Enter verification code: " console-prompt token-params ]
+    "Enter verification code: " console-prompt
-        [ token-uri>> ] bi
+    [
-        post-token-request
+        dupd tokens-params swap token-uri>> post-json-request
-    ] bi ;
+        assoc>tokens
+    ] [ drop f ] if* ;
+
+: refresh-flow ( oauth2 tokens -- tokens' )
+    dupd refresh>> refresh-params swap token-uri>> post-json-request
+    assoc>tokens ;
 
 ! Using the token to access secured resources.
 : add-token ( request url -- )
     "Bearer " prepend "Authorization" rot header>> set-at ;
 
-: oauth-http-get ( url token -- response data )
+: oauth-http-get ( url access-token -- response data )
     [ <get-request> dup ] dip add-token http-request ;