{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}

module Network.OAuth2.Experiment.Types where

import Data.Default (Default (def))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String
import Data.Text.Lazy (Text)
import Data.Text.Lazy qualified as TL
import Network.OAuth.OAuth2 hiding (RefreshToken)
import Network.OAuth.OAuth2 qualified as OAuth2
import Network.OAuth2.Experiment.Pkce
import Network.OAuth2.Experiment.Utils
import URI.ByteString (URI, serializeURIRef')

-------------------------------------------------------------------------------

-- * Idp App

-------------------------------------------------------------------------------

-- TODO: Distinct type per endpoint
-- Because I made mistake at passing to Authorize and Token Request

-- | @Idp i@ consists various endpoints endpoints.
--
-- The @i@ is actually phantom type for information only (Idp name) at this moment.
-- And it is PolyKinds.
--
-- Hence whenever @Idp i@ or @IdpApplication i a@ is used as function parameter,
-- PolyKinds need to be enabled.
data Idp (i :: k) = Idp
  { forall k (i :: k). Idp i -> URI
idpUserInfoEndpoint :: URI
  -- ^ Userinfo Endpoint
  , forall k (i :: k). Idp i -> URI
idpAuthorizeEndpoint :: URI
  -- ^ Authorization Endpoint
  , forall k (i :: k). Idp i -> URI
idpTokenEndpoint :: URI
  -- ^ Token Endpoint
  , forall k (i :: k). Idp i -> Maybe URI
idpDeviceAuthorizationEndpoint :: Maybe URI
  -- ^ Apparently not all IdP support device code flow
  }

-- | An OAuth2 Application "a" of IdP "i".
-- "a" can be one of following type:
--
-- * `Network.OAuth2.Experiment.AuthorizationCodeApplication`
-- * `Network.OAuth2.Experiment.DeviceAuthorizationApplication`
-- * `Network.OAuth2.Experiment.ClientCredentialsApplication`
-- * `Network.OAuth2.Experiment.ResourceOwnerPasswordApplication`
-- * `Network.OAuth2.Experiment.JwtBearerApplication`
data IdpApplication (i :: k) a = IdpApplication
  { forall k (i :: k) a. IdpApplication i a -> Idp i
idp :: Idp i
  , forall k (i :: k) a. IdpApplication i a -> a
application :: a
  }

-------------------------------------------------------------------------------

-- * Scope

-------------------------------------------------------------------------------

-- TODO: What's best type for Scope?
-- Use 'Text' isn't super type safe. All cannot specify some standard scopes like openid, email etc.
-- But Following data type is not ideal as Idp would have lots of 'Custom Text'
--
-- @
-- data Scope = OPENID | PROFILE | EMAIL | OFFLINE_ACCESS | Custom Text
-- @
--
-- Would be nice to define Enum for standard Scope, plus allow user to define their own define (per Idp) and plugin somehow.
newtype Scope = Scope {Scope -> Text
unScope :: Text}
  deriving (Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq, Eq Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c< :: Scope -> Scope -> Bool
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
Ord)

instance IsString Scope where
  fromString :: String -> Scope
  fromString :: String -> Scope
fromString = Text -> Scope
Scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack

-------------------------------------------------------------------------------

-- * Grant Type value

-------------------------------------------------------------------------------

-- | Grant type query parameter has association with different GrantType flows but not completely strict.
--
-- e.g. Both AuthorizationCode and ResourceOwnerPassword flow could support refresh token flow.
data GrantTypeValue
  = GTAuthorizationCode
  | GTPassword
  | GTClientCredentials
  | GTRefreshToken
  | GTJwtBearer
  | GTDeviceCode
  deriving (GrantTypeValue -> GrantTypeValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrantTypeValue -> GrantTypeValue -> Bool
$c/= :: GrantTypeValue -> GrantTypeValue -> Bool
== :: GrantTypeValue -> GrantTypeValue -> Bool
$c== :: GrantTypeValue -> GrantTypeValue -> Bool
Eq, Int -> GrantTypeValue -> ShowS
[GrantTypeValue] -> ShowS
GrantTypeValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrantTypeValue] -> ShowS
$cshowList :: [GrantTypeValue] -> ShowS
show :: GrantTypeValue -> String
$cshow :: GrantTypeValue -> String
showsPrec :: Int -> GrantTypeValue -> ShowS
$cshowsPrec :: Int -> GrantTypeValue -> ShowS
Show)

-------------------------------------------------------------------------------
--                               Response Type                               --
-------------------------------------------------------------------------------
data ResponseType = Code

-------------------------------------------------------------------------------

-- * Credentials

-------------------------------------------------------------------------------
newtype ClientId = ClientId {ClientId -> Text
unClientId :: Text}
  deriving (Int -> ClientId -> ShowS
[ClientId] -> ShowS
ClientId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientId] -> ShowS
$cshowList :: [ClientId] -> ShowS
show :: ClientId -> String
$cshow :: ClientId -> String
showsPrec :: Int -> ClientId -> ShowS
$cshowsPrec :: Int -> ClientId -> ShowS
Show, ClientId -> ClientId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c== :: ClientId -> ClientId -> Bool
Eq, String -> ClientId
forall a. (String -> a) -> IsString a
fromString :: String -> ClientId
$cfromString :: String -> ClientId
IsString)

-- | Can be either "Client Secret" or JWT base on client authentication method
newtype ClientSecret = ClientSecret {ClientSecret -> Text
unClientSecret :: Text}
  deriving (ClientSecret -> ClientSecret -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientSecret -> ClientSecret -> Bool
$c/= :: ClientSecret -> ClientSecret -> Bool
== :: ClientSecret -> ClientSecret -> Bool
$c== :: ClientSecret -> ClientSecret -> Bool
Eq, String -> ClientSecret
forall a. (String -> a) -> IsString a
fromString :: String -> ClientSecret
$cfromString :: String -> ClientSecret
IsString)

-- | In order to reuse some methods from legacy "Network.OAuth.OAuth2".
-- Will be removed when Experiment module becomes default.
toOAuth2Key :: ClientId -> ClientSecret -> OAuth2
toOAuth2Key :: ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
cid ClientSecret
csecret =
  forall a. Default a => a
def
    { oauth2ClientId :: Text
oauth2ClientId = Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ClientId -> Text
unClientId ClientId
cid
    , oauth2ClientSecret :: Text
oauth2ClientSecret = Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ClientSecret -> Text
unClientSecret ClientSecret
csecret
    }

newtype RedirectUri = RedirectUri {RedirectUri -> URI
unRedirectUri :: URI}
  deriving (RedirectUri -> RedirectUri -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedirectUri -> RedirectUri -> Bool
$c/= :: RedirectUri -> RedirectUri -> Bool
== :: RedirectUri -> RedirectUri -> Bool
$c== :: RedirectUri -> RedirectUri -> Bool
Eq)

newtype AuthorizeState = AuthorizeState {AuthorizeState -> Text
unAuthorizeState :: Text}
  deriving (AuthorizeState -> AuthorizeState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeState -> AuthorizeState -> Bool
$c/= :: AuthorizeState -> AuthorizeState -> Bool
== :: AuthorizeState -> AuthorizeState -> Bool
$c== :: AuthorizeState -> AuthorizeState -> Bool
Eq)

instance IsString AuthorizeState where
  fromString :: String -> AuthorizeState
  fromString :: String -> AuthorizeState
fromString = Text -> AuthorizeState
AuthorizeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack

newtype Username = Username {Username -> Text
unUsername :: Text}
  deriving (Username -> Username -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Username -> Username -> Bool
$c/= :: Username -> Username -> Bool
== :: Username -> Username -> Bool
$c== :: Username -> Username -> Bool
Eq)

instance IsString Username where
  fromString :: String -> Username
  fromString :: String -> Username
fromString = Text -> Username
Username forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack

newtype Password = Password {Password -> Text
unPassword :: Text}
  deriving (Password -> Password -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c== :: Password -> Password -> Bool
Eq)

instance IsString Password where
  fromString :: String -> Password
  fromString :: String -> Password
fromString = Text -> Password
Password forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack

-------------------------------------------------------------------------------

-- * Query parameters

-------------------------------------------------------------------------------
class ToQueryParam a where
  toQueryParam :: a -> Map Text Text

instance ToQueryParam a => ToQueryParam (Maybe a) where
  toQueryParam :: ToQueryParam a => Maybe a -> Map Text Text
  toQueryParam :: ToQueryParam a => Maybe a -> Map Text Text
toQueryParam Maybe a
Nothing = forall k a. Map k a
Map.empty
  toQueryParam (Just a
a) = forall a. ToQueryParam a => a -> Map Text Text
toQueryParam a
a

instance ToQueryParam GrantTypeValue where
  toQueryParam :: GrantTypeValue -> Map Text Text
  toQueryParam :: GrantTypeValue -> Map Text Text
toQueryParam GrantTypeValue
x = forall k a. k -> a -> Map k a
Map.singleton Text
"grant_type" (GrantTypeValue -> Text
val GrantTypeValue
x)
    where
      val :: GrantTypeValue -> Text
      val :: GrantTypeValue -> Text
val GrantTypeValue
GTAuthorizationCode = Text
"authorization_code"
      val GrantTypeValue
GTPassword = Text
"password"
      val GrantTypeValue
GTClientCredentials = Text
"client_credentials"
      val GrantTypeValue
GTRefreshToken = Text
"refresh_token"
      val GrantTypeValue
GTJwtBearer = Text
"urn:ietf:params:oauth:grant-type:jwt-bearer"
      val GrantTypeValue
GTDeviceCode = Text
"urn:ietf:params:oauth:grant-type:device_code"

instance ToQueryParam ClientId where
  toQueryParam :: ClientId -> Map Text Text
  toQueryParam :: ClientId -> Map Text Text
toQueryParam (ClientId Text
i) = forall k a. k -> a -> Map k a
Map.singleton Text
"client_id" Text
i

instance ToQueryParam ClientSecret where
  toQueryParam :: ClientSecret -> Map Text Text
  toQueryParam :: ClientSecret -> Map Text Text
toQueryParam (ClientSecret Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"client_secret" Text
x

instance ToQueryParam Username where
  toQueryParam :: Username -> Map Text Text
  toQueryParam :: Username -> Map Text Text
toQueryParam (Username Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"username" Text
x

instance ToQueryParam Password where
  toQueryParam :: Password -> Map Text Text
  toQueryParam :: Password -> Map Text Text
toQueryParam (Password Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"password" Text
x

instance ToQueryParam AuthorizeState where
  toQueryParam :: AuthorizeState -> Map Text Text
  toQueryParam :: AuthorizeState -> Map Text Text
toQueryParam (AuthorizeState Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"state" Text
x

instance ToQueryParam RedirectUri where
  toQueryParam :: RedirectUri -> Map Text Text
toQueryParam (RedirectUri URI
uri) = forall k a. k -> a -> Map k a
Map.singleton Text
"redirect_uri" (ByteString -> Text
bs8ToLazyText forall a b. (a -> b) -> a -> b
$ forall a. URIRef a -> ByteString
serializeURIRef' URI
uri)

instance ToQueryParam (Set Scope) where
  toQueryParam :: Set Scope -> Map Text Text
  toQueryParam :: Set Scope -> Map Text Text
toQueryParam = forall a. IsString a => Set Text -> Map a Text
toScopeParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Scope -> Text
unScope
    where
      toScopeParam :: IsString a => Set Text -> Map a Text
      toScopeParam :: forall a. IsString a => Set Text -> Map a Text
toScopeParam Set Text
scope = forall k a. k -> a -> Map k a
Map.singleton a
"scope" (Text -> [Text] -> Text
TL.intercalate Text
" " forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Text
scope)

instance ToQueryParam CodeVerifier where
  toQueryParam :: CodeVerifier -> Map Text Text
  toQueryParam :: CodeVerifier -> Map Text Text
toQueryParam (CodeVerifier Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"code_verifier" (Text -> Text
TL.fromStrict Text
x)

instance ToQueryParam CodeChallenge where
  toQueryParam :: CodeChallenge -> Map Text Text
  toQueryParam :: CodeChallenge -> Map Text Text
toQueryParam (CodeChallenge Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"code_challenge" (Text -> Text
TL.fromStrict Text
x)

instance ToQueryParam CodeChallengeMethod where
  toQueryParam :: CodeChallengeMethod -> Map Text Text
  toQueryParam :: CodeChallengeMethod -> Map Text Text
toQueryParam CodeChallengeMethod
x = forall k a. k -> a -> Map k a
Map.singleton Text
"code_challenge_method" (String -> Text
TL.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CodeChallengeMethod
x)

instance ToQueryParam ExchangeToken where
  toQueryParam :: ExchangeToken -> Map Text Text
  toQueryParam :: ExchangeToken -> Map Text Text
toQueryParam (ExchangeToken Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"code" (Text -> Text
TL.fromStrict Text
x)

instance ToQueryParam OAuth2.RefreshToken where
  toQueryParam :: OAuth2.RefreshToken -> Map Text Text
  toQueryParam :: RefreshToken -> Map Text Text
toQueryParam (OAuth2.RefreshToken Text
x) = forall k a. k -> a -> Map k a
Map.singleton Text
"refresh_token" (Text -> Text
TL.fromStrict Text
x)

instance ToQueryParam ResponseType where
  toQueryParam :: ResponseType -> Map Text Text
  toQueryParam :: ResponseType -> Map Text Text
toQueryParam ResponseType
Code = forall k a. k -> a -> Map k a
Map.singleton Text
"response_type" Text
"code"

-------------------------------------------------------------------------------
--                                HasOAuth2Key                               --
--                                                                           --
-- Find a way to reuse some methods from old implementation                  --
-- Probably will be removed when Experiment module becomes default           --
-------------------------------------------------------------------------------

class HasOAuth2Key a where
  mkOAuth2Key :: a -> OAuth2