basis/oauth2/oauth2.factor

   1 ! Copyright (C) 2016 Björn Lindqvist.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs calendar combinators http.client io
   4 json.reader kernel make math.order sequences unicode urls
   5 webbrowser ;
   6 IN: oauth2
   7
   8 : console-prompt ( query -- str/f )
   9     write flush readln [ blank? ] trim [ f ] when-empty ;
  10
  11 : post-json-request ( params token-uri -- assoc )
  12     <post-request> dup header>> "application/json" "Accept" rot set-at
  13     http-request nip json> ;
  14
  15 TUPLE: tokens access refresh expiry ;
  16
  17 : assoc>expiry ( json -- expiry )
  18     "expires_in" of [ seconds now time+ ] [ f ] if* ;
  19
  20 : assoc>tokens ( json -- tokens )
  21     [ "access_token" of ]
  22     [ "refresh_token" of ]
  23     [ assoc>expiry ] tri tokens boa ;
  24
  25 : access-expired? ( tokens -- ? )
  26     expiry>> [ now before? ] [ f ] if* ;
  27
  28 : update-tokens ( tokens1 tokens2 -- tokens1 )
  29     2dup expiry>> >>expiry drop access>> >>access ;
  30
  31 TUPLE: oauth2
  32     auth-uri
  33     token-uri
  34     redirect-uri
  35     client-id
  36     client-secret
  37     scope
  38     extra-params ;
  39
  40 : tokens-params ( oauth2 code -- params )
  41     [
  42         "code" ,,
  43         {
  44             [ client-id>> "client_id" ,, ]
  45             [ client-secret>> "client_secret" ,, ]
  46             [ redirect-uri>> "redirect_uri" ,, ]
  47             [ extra-params>> %% ]
  48         } cleave
  49         "authorization_code" "grant_type" ,,
  50     ] { } make ;
  51
  52 : refresh-params ( oauth2 refresh -- params )
  53     [
  54         "refresh_token" ,,
  55         [ client-id>> "client_id" ,, ]
  56         [ client-secret>> "client_secret" ,, ]
  57         [ extra-params>> %% ] tri
  58         "refresh_token" "grant_type" ,,
  59     ] { } make ;
  60
  61 : auth-params ( oauth2 -- params )
  62     [
  63         {
  64             [ client-id>> "client_id" ,, ]
  65             [ scope>> "scope" ,, ]
  66             [ redirect-uri>> "redirect_uri" ,, ]
  67             [ extra-params>> %% ]
  68         } cleave
  69         "code" "response_type" ,,
  70         "offline" "access_type" ,,
  71     ] { } make ;
  72
  73 : oauth2>auth-uri ( oauth2 -- uri )
  74     [ auth-uri>> >url ] [ auth-params ] bi set-query-params ;
  75
  76 ! Other flows can be useful to support too.
  77 : console-flow ( oauth2 -- tokens/f )
  78     dup oauth2>auth-uri open-url
  79     "Enter verification code: " console-prompt
  80     [
  81         dupd tokens-params swap token-uri>> post-json-request
  82         assoc>tokens
  83     ] [ drop f ] if* ;
  84
  85 : refresh-flow ( oauth2 tokens -- tokens' )
  86     dupd refresh>> refresh-params swap token-uri>> post-json-request
  87     assoc>tokens ;
  88
  89 ! Using the token to access secured resources.
  90 : add-token ( request url -- )
  91     "Bearer " prepend "Authorization" rot header>> set-at ;
  92
  93 : oauth-http-get ( url access-token -- response data )
  94     [ <get-request> dup ] dip add-token http-request ;