module Network.OAuth2.Experiment.Flows.AuthorizationRequest where
import Control.Monad.IO.Class (MonadIO (..))
import Data.Bifunctor
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Text.Lazy (Text)
import Network.OAuth.OAuth2 hiding (RefreshToken)
import Network.OAuth2.Experiment.Pkce
import Network.OAuth2.Experiment.Types
import Network.OAuth2.Experiment.Utils
import URI.ByteString hiding (UserInfo)
data AuthorizationRequestParam = AuthorizationRequestParam
{ AuthorizationRequestParam -> Set Scope
arScope :: Set Scope
, AuthorizationRequestParam -> AuthorizeState
arState :: AuthorizeState
, AuthorizationRequestParam -> ClientId
arClientId :: ClientId
, AuthorizationRequestParam -> Maybe RedirectUri
arRedirectUri :: Maybe RedirectUri
, AuthorizationRequestParam -> ResponseType
arResponseType :: ResponseType
, :: Map Text Text
}
instance ToQueryParam AuthorizationRequestParam where
toQueryParam :: AuthorizationRequestParam -> Map Text Text
toQueryParam AuthorizationRequestParam {Maybe RedirectUri
Map Text Text
Set Scope
AuthorizeState
ClientId
ResponseType
arScope :: AuthorizationRequestParam -> Set Scope
arState :: AuthorizationRequestParam -> AuthorizeState
arClientId :: AuthorizationRequestParam -> ClientId
arRedirectUri :: AuthorizationRequestParam -> Maybe RedirectUri
arResponseType :: AuthorizationRequestParam -> ResponseType
arExtraParams :: AuthorizationRequestParam -> Map Text Text
arScope :: Set Scope
arState :: AuthorizeState
arClientId :: ClientId
arRedirectUri :: Maybe RedirectUri
arResponseType :: ResponseType
arExtraParams :: Map Text Text
..} =
[Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
[ ResponseType -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ResponseType
arResponseType
, Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
arScope
, ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ClientId
arClientId
, AuthorizeState -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizeState
arState
, Maybe RedirectUri -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Maybe RedirectUri
arRedirectUri
, Map Text Text
arExtraParams
]
class HasAuthorizeRequest a where
mkAuthorizationRequestParam :: a -> AuthorizationRequestParam
mkAuthorizationRequest :: HasAuthorizeRequest a => IdpApplication i a -> URI
mkAuthorizationRequest :: forall {k} a (i :: k).
HasAuthorizeRequest a =>
IdpApplication i a -> URI
mkAuthorizationRequest IdpApplication i a
idpApp =
let req :: AuthorizationRequestParam
req = a -> AuthorizationRequestParam
forall a. HasAuthorizeRequest a => a -> AuthorizationRequestParam
mkAuthorizationRequestParam (IdpApplication i a -> a
forall k (i :: k) a. IdpApplication i a -> a
application IdpApplication i a
idpApp)
allParams :: [(ByteString, ByteString)]
allParams =
((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString)
-> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> ByteString
tlToBS Text -> ByteString
tlToBS) ([(Text, Text)] -> [(ByteString, ByteString)])
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$
Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$
AuthorizationRequestParam -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizationRequestParam
req
in [(ByteString, ByteString)] -> URI -> URI
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
allParams (URI -> URI) -> URI -> URI
forall a b. (a -> b) -> a -> b
$
Idp i -> URI
forall k (i :: k). Idp i -> URI
idpAuthorizeEndpoint (IdpApplication i a -> Idp i
forall k (i :: k) a. IdpApplication i a -> Idp i
idp IdpApplication i a
idpApp)
class HasAuthorizeRequest a => HasPkceAuthorizeRequest a where
mkPkceAuthorizeRequestParam :: MonadIO m => a -> m (AuthorizationRequestParam, CodeVerifier)
mkPkceAuthorizeRequest ::
(MonadIO m, HasPkceAuthorizeRequest a) =>
IdpApplication i a ->
m (URI, CodeVerifier)
mkPkceAuthorizeRequest :: forall {k} (m :: * -> *) a (i :: k).
(MonadIO m, HasPkceAuthorizeRequest a) =>
IdpApplication i a -> m (URI, CodeVerifier)
mkPkceAuthorizeRequest IdpApplication {a
Idp i
application :: forall k (i :: k) a. IdpApplication i a -> a
idp :: forall k (i :: k) a. IdpApplication i a -> Idp i
idp :: Idp i
application :: a
..} = do
(AuthorizationRequestParam
req, CodeVerifier
codeVerifier) <- a -> m (AuthorizationRequestParam, CodeVerifier)
forall a (m :: * -> *).
(HasPkceAuthorizeRequest a, MonadIO m) =>
a -> m (AuthorizationRequestParam, CodeVerifier)
forall (m :: * -> *).
MonadIO m =>
a -> m (AuthorizationRequestParam, CodeVerifier)
mkPkceAuthorizeRequestParam a
application
let allParams :: [(ByteString, ByteString)]
allParams = ((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString)
-> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> ByteString
tlToBS Text -> ByteString
tlToBS) ([(Text, Text)] -> [(ByteString, ByteString)])
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ AuthorizationRequestParam -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizationRequestParam
req
let url :: URI
url =
[(ByteString, ByteString)] -> URI -> URI
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
allParams (URI -> URI) -> URI -> URI
forall a b. (a -> b) -> a -> b
$
Idp i -> URI
forall k (i :: k). Idp i -> URI
idpAuthorizeEndpoint Idp i
idp
(URI, CodeVerifier) -> m (URI, CodeVerifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI
url, CodeVerifier
codeVerifier)