basis/oauth1/oauth1.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs base64 calendar checksums.hmac
   4 checksums.sha http http.client kernel make math math.parser
   5 namespaces present random sequences sorting strings
   6 urls.encoding urls.private ;
   7 IN: oauth1
   8
   9 SYMBOL: consumer-token
  10
  11 TUPLE: token key secret user-data ;
  12
  13 : <token> ( key secret -- token )
  14     token new
  15         swap >>secret
  16         swap >>key ;
  17
  18 <PRIVATE
  19
  20 TUPLE: token-params
  21 consumer-token
  22 timestamp
  23 nonce ;
  24
  25 : new-token-params ( class -- params )
  26     new
  27         consumer-token get >>consumer-token
  28         now timestamp>unix-time >integer >>timestamp
  29         16 random-bytes bytes>hex-string >>nonce ; inline
  30
  31 : present-base-url ( url -- string )
  32     [
  33         [ unparse-protocol ]
  34         [ unparse-authority ]
  35         [ path>> url-encode % ] tri
  36     ] "" make ;
  37
  38 :: signature-base-string ( url request-method params -- string )
  39     [
  40         request-method % "&" %
  41         url present-base-url url-encode-full % "&" %
  42         params assoc>query url-encode-full %
  43         url query>> [ assoc>query "&" prepend url-encode-full % ] when*
  44     ] "" make ;
  45
  46 : hmac-key ( consumer-secret token-secret -- key )
  47     [ url-encode-full ] [ "" or url-encode-full ] bi* "&" glue ;
  48
  49 : make-token-params ( params quot -- assoc )
  50     '[
  51         "1.0" "oauth_version" ,,
  52         "HMAC-SHA1" "oauth_signature_method" ,,
  53
  54         _
  55         [
  56             [ consumer-token>> key>> "oauth_consumer_key" ,, ]
  57             [ timestamp>> "oauth_timestamp" ,, ]
  58             [ nonce>> "oauth_nonce" ,, ]
  59             tri
  60         ] bi
  61     ] H{ } make ; inline
  62
  63 ! Checksum all the params but only return the oauth_ params for
  64 ! use in the auth header.
  65 ! See https://github.com/factor/factor/issues/2487
  66 :: sign-params ( url request-method consumer-token request-token params -- oauth-params )
  67     params sort-keys :> params
  68     url request-method params signature-base-string :> sbs
  69     consumer-token secret>> request-token dup [ secret>> ] when
  70     hmac-key :> key
  71     sbs key sha1 hmac-bytes >base64 >string :> signature
  72     params { "oauth_signature" signature } prefix
  73     [ "oauth_" head? ] filter-keys ;
  74
  75 : extract-user-data ( assoc -- assoc' )
  76     [
  77         { "oauth_token" "oauth_token_secret" } member? not
  78     ] filter-keys ;
  79
  80 : parse-token ( response data -- token )
  81     nip
  82     query>assoc
  83     [ [ "oauth_token" ] dip at ]
  84     [ [ "oauth_token_secret" ] dip at ]
  85     [ extract-user-data ]
  86     tri
  87     [ <token> ] dip >>user-data ;
  88
  89 PRIVATE>
  90
  91 TUPLE: request-token-params < token-params
  92 { callback-url initial: "oob" } ;
  93
  94 : <request-token-params> ( -- params )
  95     request-token-params new-token-params ;
  96
  97 <PRIVATE
  98
  99 :: <token-request> ( url consumer-token request-token params -- request )
 100     url "POST" consumer-token request-token params sign-params
 101     url
 102     <post-request> ;
 103
 104 : make-request-token-params ( params -- assoc )
 105     [ callback-url>> "oauth_callback" ,, ] make-token-params ;
 106
 107 : <request-token-request> ( url params -- request )
 108     [ consumer-token>> f ] [ make-request-token-params ] bi
 109     <token-request> ;
 110
 111 PRIVATE>
 112
 113 : obtain-request-token ( url params -- token )
 114     <request-token-request> http-request parse-token ;
 115
 116 TUPLE: access-token-params < token-params request-token verifier ;
 117
 118 : <access-token-params> ( -- params )
 119     access-token-params new-token-params ;
 120
 121 <PRIVATE
 122
 123 : make-access-token-params ( params -- assoc )
 124     [
 125         [ request-token>> key>> "oauth_token" ,, ]
 126         [ verifier>> "oauth_verifier" ,, ]
 127         bi
 128     ] make-token-params ;
 129
 130 : <access-token-request> ( url params -- request )
 131     [ consumer-token>> ]
 132     [ request-token>> ]
 133     [ make-access-token-params ] tri
 134     <token-request> ;
 135
 136 PRIVATE>
 137
 138 : obtain-access-token ( url params -- token )
 139     <access-token-request> http-request parse-token ;
 140
 141 SYMBOL: access-token
 142
 143 TUPLE: oauth-request-params < token-params access-token ;
 144
 145 : <oauth-request-params> ( -- params )
 146     oauth-request-params new-token-params
 147         access-token get >>access-token ;
 148
 149 <PRIVATE
 150
 151 :: signed-oauth-request-params ( request params -- oauth-params )
 152     request url>>
 153     request method>>
 154     params consumer-token>>
 155     params access-token>>
 156     params
 157     [
 158         access-token>> key>> "oauth_token" ,,
 159         request post-data>> %%
 160     ] make-token-params
 161     sign-params ;
 162
 163 : build-auth-string ( oauth-params -- string )
 164     [ [ present url-encode-full ] bi@ "\"" "\"" surround "=" glue ] { } assoc>map
 165     ", " join "OAuth realm=\"\", " prepend ;
 166
 167 PRIVATE>
 168
 169 : set-oauth ( request params -- request )
 170     dupd signed-oauth-request-params build-auth-string
 171     "Authorization" set-header ;