-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.OAuth where

import API.Brig
import API.BrigInternal
import API.Common (defPassword)
import API.Galley
import qualified API.Nginz as Nginz
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base64.URL as B64U
import Data.String.Conversions
import qualified Data.Text as T
import Data.UUID (UUID)
import qualified Data.UUID as UUID
import Database.CQL.IO
import Network.HTTP.Types
import Network.URI
import SetupHelpers
import Testlib.Prelude

testOAuthRevokeSession :: (HasCallStack) => App ()
testOAuthRevokeSession :: HasCallStack => App ()
testOAuthRevokeSession = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  let uri = String
"https://example.com"
  cid <- createOAuthClient user "foobar" uri >>= getJSON 200 >>= flip (%.) "client_id"
  let scopes = [String
"write-only:conversations"]

  -- create a session that will be revoked later
  (tokenToBeRevoked, sessionToBeRevoked) <- do
    token <- generateAccessToken user cid scopes uri
    [app] <- getOAuthApplications user >>= getJSON 200 >>= asList
    [session] <- app %. "sessions" >>= asList
    pure (token, session)

  -- create another session and assert that there are two sessions
  validToken <- do
    token <- generateAccessToken user cid scopes uri
    [app] <- getOAuthApplications user >>= getJSON 200 >>= asList
    sessions <- app %. "sessions" >>= asList
    length sessions `shouldMatchInt` 2
    pure token

  -- attempt to revoke a session with a wrong password should fail
  sessionToBeRevoked
    %. "refresh_token_id"
    >>= asString
    >>= deleteOAuthSession user cid "foobar"
    >>= assertStatus 403

  -- revoke the first session and assert that there is only one session left
  sessionToBeRevoked
    %. "refresh_token_id"
    >>= asString
    >>= deleteOAuthSession user cid defPassword
    >>= assertSuccess
  [app] <- getOAuthApplications user >>= getJSON 200 >>= asList
  sessions <- app %. "sessions" >>= asList
  length sessions `shouldMatchInt` 1

  -- try to use the revoked token and assert that it fails
  tokenToBeRevoked
    %. "refresh_token"
    >>= asString
    >>= createOAuthAccessTokenWithRefreshToken user cid
    >>= assertStatus 403

  -- try to use the valid token and assert that it works
  validToken
    %. "refresh_token"
    >>= asString
    >>= createOAuthAccessTokenWithRefreshToken user cid
    >>= assertSuccess

testRevokeApplicationAccountAccessV6 :: App ()
testRevokeApplicationAccountAccessV6 :: App ()
testRevokeApplicationAccountAccessV6 = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 0
  let uri = String
"https://example.com"
  let scopes = [String
"write-only:conversations"]
  replicateM_ 3 $ do
    cid <- createOAuthClient user "foobar" uri >>= getJSON 200 >>= flip (%.) "client_id"
    generateAccessToken user cid scopes uri
  [cid1, cid2, cid3] <- getOAuthApplications user >>= getJSON 200 >>= asList >>= mapM (%. "id")
  revokeApplicationAccessV6 user cid1 >>= assertSuccess
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 2
    ids <- for apps $ \Value
app -> Value
app Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    ids `shouldMatchSet` [cid2, cid3]
  revokeApplicationAccessV6 user cid2 >>= assertSuccess
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 1
    ids <- for apps $ \Value
app -> Value
app Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    ids `shouldMatchSet` [cid3]
  revokeApplicationAccessV6 user cid3 >>= assertSuccess
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 0

testRevokeApplicationAccountAccess :: App ()
testRevokeApplicationAccountAccess :: App ()
testRevokeApplicationAccountAccess = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 0
  let uri = String
"https://example.com"
  let scopes = [String
"write-only:conversations"]
  replicateM_ 3 $ do
    cid <- createOAuthClient user "foobar" uri >>= getJSON 200 >>= flip (%.) "client_id"
    generateAccessToken user cid scopes uri
  [cid1, cid2, cid3] <- getOAuthApplications user >>= getJSON 200 >>= asList >>= mapM (%. "id")
  revokeApplicationAccess user cid1 "foobar" >>= assertStatus 403
  revokeApplicationAccess user cid1 defPassword >>= assertSuccess
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 2
    ids <- for apps $ \Value
app -> Value
app Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    ids `shouldMatchSet` [cid2, cid3]
  revokeApplicationAccess user cid2 defPassword >>= assertSuccess
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 1
    ids <- for apps $ \Value
app -> Value
app Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
    ids `shouldMatchSet` [cid3]
  revokeApplicationAccess user cid3 defPassword >>= assertSuccess
  bindResponse (getOAuthApplications user) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    apps <- Response
resp.json Maybe Value -> (Maybe Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& Maybe Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
    length apps `shouldMatchInt` 0

-- | The tiers of a scope are separate: a token that may write may not read,
-- and the other way round.  This is about @/conversations/:cnv/code@, the one
-- location in the integration nginx.conf that uses 'oauth_scopes'.
testOAuthScopeTiersAreSeparate :: (HasCallStack) => App ()
testOAuthScopeTiersAreSeparate :: HasCallStack => App ()
testOAuthScopeTiersAreSeparate = do
  (user, _, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  conv <- postConversation user (allowGuests defProteus) >>= getJSON 201
  -- with a zauth token, so that there is a code to read later on
  postConversationCode user conv Nothing Nothing >>= assertSuccess

  cid <- oauthClient user
  readToken <- accessTokenFor user cid ["read:conversations_code"]
  writeToken <- accessTokenFor user cid ["write-only:conversations_code"]

  Nginz.getConversationCode user conv readToken >>= assertStatus 200
  Nginz.postConversationCode user conv readToken >>= assertStatus 403

  Nginz.postConversationCode user conv writeToken >>= assertSuccess
  Nginz.getConversationCode user conv writeToken >>= assertStatus 403

testOAuthRejectUnusefulTokenRequests :: (HasCallStack) => App ()
testOAuthRejectUnusefulTokenRequests :: HasCallStack => App ()
testOAuthRejectUnusefulTokenRequests = do
  (user, _, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  cid <- oauthClient user

  generateOAuthAuthorizationCode user cid [] redirectUri >>= assertStatus 400
  -- the 400 has to say which scopes would have worked
  bindResponse (generateOAuthAuthorizationCode user cid ["pizza"] redirectUri) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
400
    msg <- Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"message" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
    msg `shouldContainString` "read:self"
    msg `shouldContainString` "write-only:conversations"
  generateOAuthAuthorizationCode user cid ["delete-only:conversations"] redirectUri >>= assertStatus 400

testOAuthNewScopesOnDeprecatedAttribute :: (HasCallStack) => App ()
testOAuthNewScopesOnDeprecatedAttribute :: HasCallStack => App ()
testOAuthNewScopesOnDeprecatedAttribute = do
  user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  cid <- oauthClient user

  selfToken <- accessTokenFor user cid ["read:self"]
  Nginz.getSelf user selfToken >>= assertStatus 200

  convToken <- accessTokenFor user cid ["write-only:conversations"]
  Nginz.postConversation user defProteus convToken >>= assertStatus 201

  -- ... and the deprecated attribute still tells the scopes apart
  Nginz.getSelf user convToken >>= assertStatus 403

testOAuthDeprecatedScopesInCassandra :: (HasCallStack) => TaggedBool "old scope syntax" -> App ()
testOAuthDeprecatedScopesInCassandra :: HasCallStack => TaggedBool "old scope syntax" -> App ()
testOAuthDeprecatedScopesInCassandra (TaggedBool Bool
oldScopeSyntax) = do
  (user, _, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  conv <- postConversation user (allowGuests defProteus) >>= getJSON 201
  postConversationCode user conv Nothing Nothing >>= assertSuccess

  cid <- oauthClient user
  session <- generateAccessToken user cid ["write-only:conversations_code"] redirectUri

  when oldScopeSyntax (hackCassandra user)

  refreshToken <- session %. "refresh_token" & asString
  refreshed <- createOAuthAccessTokenWithRefreshToken user cid refreshToken >>= getJSON 200

  if oldScopeSyntax
    then do
      token <- refreshed %. "access_token" & asString
      hasScopes token ["read:conversations_code", "write-only:conversations_code"]
      Nginz.getConversationCode user conv token >>= assertSuccess
      Nginz.postConversationCode user conv token >>= assertSuccess
    else do
      token <- refreshed %. "access_token" & asString
      hasScopes token ["write-only:conversations_code"]
      Nginz.getConversationCode user conv token >>= assertStatus 403
      Nginz.postConversationCode user conv token >>= assertSuccess
  where
    -- pretend the session was created before the split
    hackCassandra :: Value -> App ()
    hackCassandra :: Value -> App ()
hackCassandra Value
user = do
      keyspace <- Service -> App Value
readServiceConfig Service
Brig App Value -> (App Value -> App Value) -> App Value
forall a b. a -> (a -> b) -> b
& (App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"cassandra.keyspace") App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      let setScope :: PrepQuery W (Identity UUID) () =
            fromString
              $ "UPDATE "
              <> keyspace
              <> ".oauth_refresh_token SET scope = {'write:conversations_code', 'read:pizza'} WHERE id = ?"
      rid <- refreshTokenId user
      write setScope (defQueryParams LocalQuorum (Identity rid))

    hasScopes :: String -> [String] -> App ()
    hasScopes :: String -> [String] -> App ()
hasScopes String
token [String]
expectedScopes = do
      claims <- HasCallStack => String -> App Value
String -> App Value
accessTokenClaims String
token
      scopes <- claims %. "scope" & asString
      words scopes `shouldMatchSet` expectedScopes

--------------------------------------------------------------------------------
-- helpers

redirectUri :: String
redirectUri :: String
redirectUri = String
"https://example.com"

oauthClient :: (HasCallStack, MakesValue user) => user -> App Value
oauthClient :: forall user. (HasCallStack, MakesValue user) => user -> App Value
oauthClient user
user =
  user -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
createOAuthClient user
user String
"foobar" String
redirectUri App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"client_id")

-- | The access token, which is the part nginz gets to see.
accessTokenFor :: (HasCallStack, MakesValue user, MakesValue cid) => user -> cid -> [String] -> App String
accessTokenFor :: forall user cid.
(HasCallStack, MakesValue user, MakesValue cid) =>
user -> cid -> [String] -> App String
accessTokenFor user
user cid
cid [String]
scopes =
  user -> cid -> [String] -> String -> App Value
forall cid user.
(MakesValue cid, MakesValue user) =>
user -> cid -> [String] -> String -> App Value
generateAccessToken user
user cid
cid [String]
scopes String
redirectUri App Value -> (Value -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"access_token") App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString

-- | The id of the one session the user has.
refreshTokenId :: (HasCallStack, MakesValue user) => user -> App UUID
refreshTokenId :: forall user. (HasCallStack, MakesValue user) => user -> App UUID
refreshTokenId user
user = do
  [app] <- user -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> App Response
getOAuthApplications user
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 App Value -> (Value -> App [Value]) -> App [Value]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
  [session] <- app %. "sessions" >>= asList
  rid <- session %. "refresh_token_id" & asString
  maybe (assertFailure ("not a uuid: " <> rid)) pure (UUID.fromString rid)

-- | The claims of an access token, read without verifying anything: we only
-- want to see what brig put in.
accessTokenClaims :: (HasCallStack) => String -> App Value
accessTokenClaims :: HasCallStack => String -> App Value
accessTokenClaims String
token = do
  payload <- case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
".") (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
token) of
    (Text
_ : Text
p : [Text]
_) -> Text -> App Text
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
p
    [Text]
_ -> String -> App Text
forall a. HasCallStack => String -> App a
assertFailure (String
"not a JWT: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
token)
  claims <- case B64U.decodeUnpadded (cs payload) of
    Left String
e -> String -> App ByteString
forall a. HasCallStack => String -> App a
assertFailure (String
"not base64url: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
token String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
    Right ByteString
bs -> ByteString -> App ByteString
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
  case Aeson.eitherDecode (cs claims) of
    Left String
e -> String -> App Value
forall a. HasCallStack => String -> App a
assertFailure (String
"not json: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
token String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
    Right Value
v -> Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v

generateAccessToken :: (MakesValue cid, MakesValue user) => user -> cid -> [String] -> String -> App Value
generateAccessToken :: forall cid user.
(MakesValue cid, MakesValue user) =>
user -> cid -> [String] -> String -> App Value
generateAccessToken user
user cid
cid [String]
scopes String
uri = do
  authCodeResponse <- user -> cid -> [String] -> String -> App Response
forall user cid.
(HasCallStack, MakesValue user, MakesValue cid) =>
user -> cid -> [String] -> String -> App Response
generateOAuthAuthorizationCode user
user cid
cid [String]
scopes String
uri
  let location = URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe (String -> URI
forall a. HasCallStack => String -> a
error String
"no location header") (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURI (String -> Maybe URI)
-> ((HeaderName, ByteString) -> String)
-> (HeaderName, ByteString)
-> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> String)
-> ((HeaderName, ByteString) -> ByteString)
-> (HeaderName, ByteString)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((HeaderName, ByteString) -> Maybe URI)
-> Maybe (HeaderName, ByteString) -> Maybe URI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response -> Maybe (HeaderName, ByteString)
locationHeader Response
authCodeResponse
  let code = String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"no code query param" ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Maybe ByteString -> String) -> Maybe ByteString -> String
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ByteString) -> Maybe ByteString)
-> Maybe (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
-> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
"code") ([(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString))
-> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Maybe ByteString)]
parseQuery (ByteString -> [(ByteString, Maybe ByteString)])
-> ByteString -> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs URI
location.uriQuery
  createOAuthAccessToken user cid code uri >>= getJSON 200