module Servant.Auth.Server.Internal.ConfigTypes
  ( module Servant.Auth.Server.Internal.ConfigTypes
  , Servant.API.IsSecure(..)
  ) where

import           Crypto.JOSE        as Jose
import           Crypto.JWT         as Jose
import qualified Data.ByteString    as BS
import           Data.Default.Class
import           Data.Time
import           GHC.Generics       (Generic)
import           Servant.API        (IsSecure(..))

data IsMatch = Matches | DoesNotMatch
  deriving (IsMatch -> IsMatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsMatch -> IsMatch -> Bool
$c/= :: IsMatch -> IsMatch -> Bool
== :: IsMatch -> IsMatch -> Bool
$c== :: IsMatch -> IsMatch -> Bool
Eq, Int -> IsMatch -> ShowS
[IsMatch] -> ShowS
IsMatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsMatch] -> ShowS
$cshowList :: [IsMatch] -> ShowS
show :: IsMatch -> String
$cshow :: IsMatch -> String
showsPrec :: Int -> IsMatch -> ShowS
$cshowsPrec :: Int -> IsMatch -> ShowS
Show, ReadPrec [IsMatch]
ReadPrec IsMatch
Int -> ReadS IsMatch
ReadS [IsMatch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IsMatch]
$creadListPrec :: ReadPrec [IsMatch]
readPrec :: ReadPrec IsMatch
$creadPrec :: ReadPrec IsMatch
readList :: ReadS [IsMatch]
$creadList :: ReadS [IsMatch]
readsPrec :: Int -> ReadS IsMatch
$creadsPrec :: Int -> ReadS IsMatch
Read, forall x. Rep IsMatch x -> IsMatch
forall x. IsMatch -> Rep IsMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsMatch x -> IsMatch
$cfrom :: forall x. IsMatch -> Rep IsMatch x
Generic, Eq IsMatch
IsMatch -> IsMatch -> Bool
IsMatch -> IsMatch -> Ordering
IsMatch -> IsMatch -> IsMatch
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 :: IsMatch -> IsMatch -> IsMatch
$cmin :: IsMatch -> IsMatch -> IsMatch
max :: IsMatch -> IsMatch -> IsMatch
$cmax :: IsMatch -> IsMatch -> IsMatch
>= :: IsMatch -> IsMatch -> Bool
$c>= :: IsMatch -> IsMatch -> Bool
> :: IsMatch -> IsMatch -> Bool
$c> :: IsMatch -> IsMatch -> Bool
<= :: IsMatch -> IsMatch -> Bool
$c<= :: IsMatch -> IsMatch -> Bool
< :: IsMatch -> IsMatch -> Bool
$c< :: IsMatch -> IsMatch -> Bool
compare :: IsMatch -> IsMatch -> Ordering
$ccompare :: IsMatch -> IsMatch -> Ordering
Ord)

data IsPasswordCorrect = PasswordCorrect | PasswordIncorrect
  deriving (IsPasswordCorrect -> IsPasswordCorrect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
$c/= :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
== :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
$c== :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
Eq, Int -> IsPasswordCorrect -> ShowS
[IsPasswordCorrect] -> ShowS
IsPasswordCorrect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsPasswordCorrect] -> ShowS
$cshowList :: [IsPasswordCorrect] -> ShowS
show :: IsPasswordCorrect -> String
$cshow :: IsPasswordCorrect -> String
showsPrec :: Int -> IsPasswordCorrect -> ShowS
$cshowsPrec :: Int -> IsPasswordCorrect -> ShowS
Show, ReadPrec [IsPasswordCorrect]
ReadPrec IsPasswordCorrect
Int -> ReadS IsPasswordCorrect
ReadS [IsPasswordCorrect]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IsPasswordCorrect]
$creadListPrec :: ReadPrec [IsPasswordCorrect]
readPrec :: ReadPrec IsPasswordCorrect
$creadPrec :: ReadPrec IsPasswordCorrect
readList :: ReadS [IsPasswordCorrect]
$creadList :: ReadS [IsPasswordCorrect]
readsPrec :: Int -> ReadS IsPasswordCorrect
$creadsPrec :: Int -> ReadS IsPasswordCorrect
Read, forall x. Rep IsPasswordCorrect x -> IsPasswordCorrect
forall x. IsPasswordCorrect -> Rep IsPasswordCorrect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsPasswordCorrect x -> IsPasswordCorrect
$cfrom :: forall x. IsPasswordCorrect -> Rep IsPasswordCorrect x
Generic, Eq IsPasswordCorrect
IsPasswordCorrect -> IsPasswordCorrect -> Bool
IsPasswordCorrect -> IsPasswordCorrect -> Ordering
IsPasswordCorrect -> IsPasswordCorrect -> IsPasswordCorrect
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 :: IsPasswordCorrect -> IsPasswordCorrect -> IsPasswordCorrect
$cmin :: IsPasswordCorrect -> IsPasswordCorrect -> IsPasswordCorrect
max :: IsPasswordCorrect -> IsPasswordCorrect -> IsPasswordCorrect
$cmax :: IsPasswordCorrect -> IsPasswordCorrect -> IsPasswordCorrect
>= :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
$c>= :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
> :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
$c> :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
<= :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
$c<= :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
< :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
$c< :: IsPasswordCorrect -> IsPasswordCorrect -> Bool
compare :: IsPasswordCorrect -> IsPasswordCorrect -> Ordering
$ccompare :: IsPasswordCorrect -> IsPasswordCorrect -> Ordering
Ord)

-- The @SameSite@ attribute of cookies determines whether cookies will be sent
-- on cross-origin requests.
--
-- See <https://tools.ietf.org/html/draft-west-first-party-cookies-07 this document>
-- for more information.
data SameSite = AnySite | SameSiteStrict | SameSiteLax
  deriving (SameSite -> SameSite -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SameSite -> SameSite -> Bool
$c/= :: SameSite -> SameSite -> Bool
== :: SameSite -> SameSite -> Bool
$c== :: SameSite -> SameSite -> Bool
Eq, Int -> SameSite -> ShowS
[SameSite] -> ShowS
SameSite -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SameSite] -> ShowS
$cshowList :: [SameSite] -> ShowS
show :: SameSite -> String
$cshow :: SameSite -> String
showsPrec :: Int -> SameSite -> ShowS
$cshowsPrec :: Int -> SameSite -> ShowS
Show, ReadPrec [SameSite]
ReadPrec SameSite
Int -> ReadS SameSite
ReadS [SameSite]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SameSite]
$creadListPrec :: ReadPrec [SameSite]
readPrec :: ReadPrec SameSite
$creadPrec :: ReadPrec SameSite
readList :: ReadS [SameSite]
$creadList :: ReadS [SameSite]
readsPrec :: Int -> ReadS SameSite
$creadsPrec :: Int -> ReadS SameSite
Read, forall x. Rep SameSite x -> SameSite
forall x. SameSite -> Rep SameSite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SameSite x -> SameSite
$cfrom :: forall x. SameSite -> Rep SameSite x
Generic, Eq SameSite
SameSite -> SameSite -> Bool
SameSite -> SameSite -> Ordering
SameSite -> SameSite -> SameSite
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 :: SameSite -> SameSite -> SameSite
$cmin :: SameSite -> SameSite -> SameSite
max :: SameSite -> SameSite -> SameSite
$cmax :: SameSite -> SameSite -> SameSite
>= :: SameSite -> SameSite -> Bool
$c>= :: SameSite -> SameSite -> Bool
> :: SameSite -> SameSite -> Bool
$c> :: SameSite -> SameSite -> Bool
<= :: SameSite -> SameSite -> Bool
$c<= :: SameSite -> SameSite -> Bool
< :: SameSite -> SameSite -> Bool
$c< :: SameSite -> SameSite -> Bool
compare :: SameSite -> SameSite -> Ordering
$ccompare :: SameSite -> SameSite -> Ordering
Ord)

-- | @JWTSettings@ are used to generate cookies, and to verify JWTs.
data JWTSettings = JWTSettings
  {
  -- | Key used to sign JWT.
    JWTSettings -> JWK
signingKey      :: Jose.JWK
  -- | Algorithm used to sign JWT.
  , JWTSettings -> Maybe Alg
jwtAlg          :: Maybe Jose.Alg
  -- | Keys used to validate JWT.
  , JWTSettings -> IO JWKSet
validationKeys  :: IO Jose.JWKSet
  -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
  -- intended recipient of the JWT.
  , JWTSettings -> StringOrURI -> IsMatch
audienceMatches :: Jose.StringOrURI -> IsMatch
  } deriving (forall x. Rep JWTSettings x -> JWTSettings
forall x. JWTSettings -> Rep JWTSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JWTSettings x -> JWTSettings
$cfrom :: forall x. JWTSettings -> Rep JWTSettings x
Generic)

-- | A @JWTSettings@ where the audience always matches.
defaultJWTSettings :: Jose.JWK -> JWTSettings
defaultJWTSettings :: JWK -> JWTSettings
defaultJWTSettings JWK
k = JWTSettings
   { signingKey :: JWK
signingKey = JWK
k
   , jwtAlg :: Maybe Alg
jwtAlg = forall a. Maybe a
Nothing
   , validationKeys :: IO JWKSet
validationKeys = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [JWK] -> JWKSet
Jose.JWKSet [JWK
k]
   , audienceMatches :: StringOrURI -> IsMatch
audienceMatches = forall a b. a -> b -> a
const IsMatch
Matches }

-- | The policies to use when generating cookies.
--
-- If *both* 'cookieMaxAge' and 'cookieExpires' are @Nothing@, browsers will
-- treat the cookie as a *session cookie*. These will be deleted when the
-- browser is closed.
--
-- Note that having the setting @Secure@ may cause testing failures if you are
-- not testing over HTTPS.
data CookieSettings = CookieSettings
  {
  -- | 'Secure' means browsers will only send cookies over HTTPS. Default:
  -- @Secure@.
    CookieSettings -> IsSecure
cookieIsSecure    :: !IsSecure
  -- | How long from now until the cookie expires. Default: @Nothing@.
  , CookieSettings -> Maybe DiffTime
cookieMaxAge      :: !(Maybe DiffTime)
  -- | At what time the cookie expires. Default: @Nothing@.
  , CookieSettings -> Maybe UTCTime
cookieExpires     :: !(Maybe UTCTime)
  -- | The URL path and sub-paths for which this cookie is used. Default: @Just "/"@.
  , CookieSettings -> Maybe ByteString
cookiePath        :: !(Maybe BS.ByteString)
  -- | Domain name, if set cookie also allows subdomains. Default: @Nothing@.
  , CookieSettings -> Maybe ByteString
cookieDomain      :: !(Maybe BS.ByteString)
  -- | 'SameSite' settings. Default: @SameSiteLax@.
  , CookieSettings -> SameSite
cookieSameSite    :: !SameSite
  -- | What name to use for the cookie used for the session.
  , CookieSettings -> ByteString
sessionCookieName :: !BS.ByteString
  -- | The optional settings to use for XSRF protection. Default: @Just def@.
  , CookieSettings -> Maybe XsrfCookieSettings
cookieXsrfSetting :: !(Maybe XsrfCookieSettings)
  } deriving (CookieSettings -> CookieSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieSettings -> CookieSettings -> Bool
$c/= :: CookieSettings -> CookieSettings -> Bool
== :: CookieSettings -> CookieSettings -> Bool
$c== :: CookieSettings -> CookieSettings -> Bool
Eq, Int -> CookieSettings -> ShowS
[CookieSettings] -> ShowS
CookieSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieSettings] -> ShowS
$cshowList :: [CookieSettings] -> ShowS
show :: CookieSettings -> String
$cshow :: CookieSettings -> String
showsPrec :: Int -> CookieSettings -> ShowS
$cshowsPrec :: Int -> CookieSettings -> ShowS
Show, forall x. Rep CookieSettings x -> CookieSettings
forall x. CookieSettings -> Rep CookieSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CookieSettings x -> CookieSettings
$cfrom :: forall x. CookieSettings -> Rep CookieSettings x
Generic)

instance Default CookieSettings where
  def :: CookieSettings
def = CookieSettings
defaultCookieSettings

defaultCookieSettings :: CookieSettings
defaultCookieSettings :: CookieSettings
defaultCookieSettings = CookieSettings
    { cookieIsSecure :: IsSecure
cookieIsSecure    = IsSecure
Secure
    , cookieMaxAge :: Maybe DiffTime
cookieMaxAge      = forall a. Maybe a
Nothing
    , cookieExpires :: Maybe UTCTime
cookieExpires     = forall a. Maybe a
Nothing
    , cookiePath :: Maybe ByteString
cookiePath        = forall a. a -> Maybe a
Just ByteString
"/"
    , cookieDomain :: Maybe ByteString
cookieDomain      = forall a. Maybe a
Nothing
    , cookieSameSite :: SameSite
cookieSameSite    = SameSite
SameSiteLax
    , sessionCookieName :: ByteString
sessionCookieName = ByteString
"JWT-Cookie"
    , cookieXsrfSetting :: Maybe XsrfCookieSettings
cookieXsrfSetting = forall a. a -> Maybe a
Just forall a. Default a => a
def
    }

-- | The policies to use when generating and verifying XSRF cookies
data XsrfCookieSettings = XsrfCookieSettings
  {
  -- | What name to use for the cookie used for XSRF protection.
    XsrfCookieSettings -> ByteString
xsrfCookieName :: !BS.ByteString
  -- | What path to use for the cookie used for XSRF protection. Default @Just "/"@.
  , XsrfCookieSettings -> Maybe ByteString
xsrfCookiePath :: !(Maybe BS.ByteString)
  -- | What name to use for the header used for XSRF protection.
  , XsrfCookieSettings -> ByteString
xsrfHeaderName :: !BS.ByteString
  -- | Exclude GET request method from XSRF protection.
  , XsrfCookieSettings -> Bool
xsrfExcludeGet :: !Bool
  } deriving (XsrfCookieSettings -> XsrfCookieSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XsrfCookieSettings -> XsrfCookieSettings -> Bool
$c/= :: XsrfCookieSettings -> XsrfCookieSettings -> Bool
== :: XsrfCookieSettings -> XsrfCookieSettings -> Bool
$c== :: XsrfCookieSettings -> XsrfCookieSettings -> Bool
Eq, Int -> XsrfCookieSettings -> ShowS
[XsrfCookieSettings] -> ShowS
XsrfCookieSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XsrfCookieSettings] -> ShowS
$cshowList :: [XsrfCookieSettings] -> ShowS
show :: XsrfCookieSettings -> String
$cshow :: XsrfCookieSettings -> String
showsPrec :: Int -> XsrfCookieSettings -> ShowS
$cshowsPrec :: Int -> XsrfCookieSettings -> ShowS
Show, forall x. Rep XsrfCookieSettings x -> XsrfCookieSettings
forall x. XsrfCookieSettings -> Rep XsrfCookieSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XsrfCookieSettings x -> XsrfCookieSettings
$cfrom :: forall x. XsrfCookieSettings -> Rep XsrfCookieSettings x
Generic)

instance Default XsrfCookieSettings where
  def :: XsrfCookieSettings
def = XsrfCookieSettings
defaultXsrfCookieSettings

defaultXsrfCookieSettings :: XsrfCookieSettings
defaultXsrfCookieSettings :: XsrfCookieSettings
defaultXsrfCookieSettings = XsrfCookieSettings
  { xsrfCookieName :: ByteString
xsrfCookieName = ByteString
"XSRF-TOKEN"
  , xsrfCookiePath :: Maybe ByteString
xsrfCookiePath = forall a. a -> Maybe a
Just ByteString
"/"
  , xsrfHeaderName :: ByteString
xsrfHeaderName = ByteString
"X-XSRF-TOKEN"
  , xsrfExcludeGet :: Bool
xsrfExcludeGet = Bool
False
  }

------------------------------------------------------------------------------
-- Internal {{{

jwtSettingsToJwtValidationSettings :: JWTSettings -> Jose.JWTValidationSettings
jwtSettingsToJwtValidationSettings :: JWTSettings -> JWTValidationSettings
jwtSettingsToJwtValidationSettings JWTSettings
s
  = (StringOrURI -> Bool) -> JWTValidationSettings
defaultJWTValidationSettings (IsMatch -> Bool
toBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JWTSettings -> StringOrURI -> IsMatch
audienceMatches JWTSettings
s)
  where
    toBool :: IsMatch -> Bool
toBool IsMatch
Matches      = Bool
True
    toBool IsMatch
DoesNotMatch = Bool
False
-- }}}