diff --git a/backend/Obelisk/OAuth/AccessToken.hs b/backend/Obelisk/OAuth/AccessToken.hs index a49d0b2..f3dd8ce 100644 --- a/backend/Obelisk/OAuth/AccessToken.hs +++ b/backend/Obelisk/OAuth/AccessToken.hs @@ -7,7 +7,9 @@ module Obelisk.OAuth.AccessToken where import Data.ByteString import Data.Functor.Identity import Data.Text (Text) +import Data.Text as T import qualified Data.Text.Encoding as T +import Network.URI import Network.HTTP.Client (Request(..), parseRequest) import Network.HTTP.Client.MultipartFormData (partBS, formDataBody) @@ -21,22 +23,20 @@ data TokenRequest r = TokenRequest { _tokenRequest_grant :: TokenGrant , _tokenRequest_clientId :: Text , _tokenRequest_clientSecret :: Text - , _tokenRequest_redirectUri :: (R OAuth -> R r) } getOauthToken :: String -- ^ Request url - -> Text -- ^ Application route - -> Encoder Identity Identity (R (FullRoute r a)) PageName + -> (R OAuth -> URI) -> TokenRequest r -> IO Request -getOauthToken reqUrl appRoute enc t = do +getOauthToken reqUrl encodeRoute t = do req <- parseRequest reqUrl let form = [ partBS "client_id" $ T.encodeUtf8 $ _tokenRequest_clientId t , partBS "client_secret" $ T.encodeUtf8 $ _tokenRequest_clientSecret t - , partBS "redirect_uri" $ T.encodeUtf8 $ - appRoute <> renderBackendRoute enc (_tokenRequest_redirectUri t $ OAuth_RedirectUri :/ Nothing) + , partBS "redirect_uri" $ T.encodeUtf8 $ T.pack $ + uriToString id (encodeRoute (OAuth_RedirectUri :/ Nothing)) "" ] ++ case _tokenRequest_grant t of TokenGrant_AuthorizationCode code -> [ partBS "grant_type" "authorization_code" diff --git a/backend/obelisk-oauth-backend.cabal b/backend/obelisk-oauth-backend.cabal index dbcae03..9de51cc 100644 --- a/backend/obelisk-oauth-backend.cabal +++ b/backend/obelisk-oauth-backend.cabal @@ -19,6 +19,7 @@ library base >=4.11, bytestring >=0.10, http-client, + network-uri >=2.6.3.0, obelisk-oauth-common, obelisk-route, text >=1.2 diff --git a/common/Obelisk/OAuth/Authorization.hs b/common/Obelisk/OAuth/Authorization.hs index 5faeb3d..5324a6e 100644 --- a/common/Obelisk/OAuth/Authorization.hs +++ b/common/Obelisk/OAuth/Authorization.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -30,6 +31,7 @@ import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) +import Network.URI import Obelisk.Route import Obelisk.Route.TH @@ -63,7 +65,7 @@ data AuthorizationRequest r = AuthorizationRequest -- ^ The type of authorization grant being requested. See 'AuthorizationResponseType'. , _authorizationRequest_clientId :: Text -- ^ The client application identifier, issued by the authorization server. See section R r) + , _authorizationRequest_redirectUri :: Maybe (R OAuth -> URI) -- ^ The client application's callback URI, where it expects to receive the authorization code. See section of the spec. The @r@ represents the client application's route type, of which the OAuth route will be a sub-route. , _authorizationRequest_scope :: [Text] -- ^ See section , "Access Token Scope" @@ -76,11 +78,9 @@ data AuthorizationRequest r = AuthorizationRequest -- defined in of the specification. -- This does not insert a leading @?@. authorizationRequestParams - :: Text -- ^ Base url - -> Encoder Identity Identity (R (FullRoute br a)) PageName - -> AuthorizationRequest br + :: AuthorizationRequest br -> Text -authorizationRequestParams route enc ar = encode (queryParametersTextEncoder @Identity @Identity) $ +authorizationRequestParams ar = encode (queryParametersTextEncoder @Identity @Identity) $ Map.toList $ fmap Just $ mconcat [ Map.singleton "response_type" $ case _authorizationRequest_responseType ar of AuthorizationResponseType_Code -> "code" @@ -88,8 +88,8 @@ authorizationRequestParams route enc ar = encode (queryParametersTextEncoder @Id , Map.singleton "client_id" (_authorizationRequest_clientId ar) , case _authorizationRequest_redirectUri ar of Nothing -> Map.empty - Just r -> Map.singleton "redirect_uri" $ - route <> renderBackendRoute enc (r $ OAuth_RedirectUri :/ Nothing) + Just renderRoute -> Map.singleton "redirect_uri" $ T.pack $ + uriToString id (renderRoute $ OAuth_RedirectUri :/ Nothing) "" , case _authorizationRequest_scope ar of [] -> Map.empty xs -> Map.singleton "scope" $ T.intercalate " " xs @@ -101,12 +101,10 @@ authorizationRequestParams route enc ar = encode (queryParametersTextEncoder @Id -- | Render the authorization request authorizationRequestHref :: Text -- ^ API request url - -> Text -- ^ Base application route url - -> Encoder Identity Identity (R (FullRoute br a)) PageName -- ^ Backend route encoder -> AuthorizationRequest br -> Text -- ^ Authorization grant request endpoint with query string -authorizationRequestHref reqUrl appUrl enc ar = - reqUrl <> "?" <> authorizationRequestParams appUrl enc ar +authorizationRequestHref reqUrl ar = + reqUrl <> "?" <> authorizationRequestParams ar -- | Parameters that the authorization server is expected to provide when granting -- an authorization code request. See section diff --git a/common/obelisk-oauth-common.cabal b/common/obelisk-oauth-common.cabal index 4fcc436..d50598a 100644 --- a/common/obelisk-oauth-common.cabal +++ b/common/obelisk-oauth-common.cabal @@ -34,6 +34,7 @@ library categories, containers >=0.5, mtl >=2, + network-uri >=2.6.3.0, obelisk-route, text >= 1.2 default-language: Haskell2010