{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 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 Wire.API.User.Auth
  ( -- * Login
    Login (..),
    LoginCode (..),
    LoginId (..),
    PendingLoginCode (..),
    SendLoginCode (..),
    LoginCodeTimeout (..),

    -- * Cookies
    CookieList (..),
    CookieId (..),
    CookieType (..),
    Cookie (..),
    CookieLabel (..),
    RemoveCookies (..),
    toUnitCookie,

    -- * Token
    AccessToken (..),
    bearerToken,
    TokenType (..),
    SomeUserToken (..),
    SomeAccessToken (..),
    UserTokenCookie (..),
    ProviderToken (..),
    ProviderTokenCookie (..),

    -- * Access
    AccessWithCookie (..),
    Access,
    SomeAccess,

    -- * Servant
    TokenResponse,
  )
where

import Cassandra
import Control.Applicative
import Control.Lens ((?~), (^.))
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Types qualified as A
import Data.Bifunctor
import Data.ByteString.Builder
import Data.ByteString.Conversion
import Data.ByteString.Lazy qualified as LBS
import Data.Code as Code
import Data.Functor.Alt
import Data.Handle (Handle)
import Data.Id
import Data.Json.Util
import Data.Misc (PlainTextPassword6)
import Data.OpenApi qualified as S
import Data.SOP
import Data.Schema
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy.Encoding qualified as LT
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Tuple.Extra hiding (first)
import Data.ZAuth.Token (header, time)
import Data.ZAuth.Token qualified as ZAuth
import Imports
import Servant
import Web.Cookie
import Wire.API.Routes.MultiVerb
import Wire.API.User.Identity (EmailAddress, Phone)
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

--------------------------------------------------------------------------------
-- LoginId

-- | The login ID for client API versions v0..v5
data LoginId
  = LoginByEmail EmailAddress
  | LoginByHandle Handle
  deriving stock (LoginId -> LoginId -> Bool
(LoginId -> LoginId -> Bool)
-> (LoginId -> LoginId -> Bool) -> Eq LoginId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoginId -> LoginId -> Bool
== :: LoginId -> LoginId -> Bool
$c/= :: LoginId -> LoginId -> Bool
/= :: LoginId -> LoginId -> Bool
Eq, Int -> LoginId -> ShowS
[LoginId] -> ShowS
LoginId -> String
(Int -> LoginId -> ShowS)
-> (LoginId -> String) -> ([LoginId] -> ShowS) -> Show LoginId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoginId -> ShowS
showsPrec :: Int -> LoginId -> ShowS
$cshow :: LoginId -> String
show :: LoginId -> String
$cshowList :: [LoginId] -> ShowS
showList :: [LoginId] -> ShowS
Show, (forall x. LoginId -> Rep LoginId x)
-> (forall x. Rep LoginId x -> LoginId) -> Generic LoginId
forall x. Rep LoginId x -> LoginId
forall x. LoginId -> Rep LoginId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoginId -> Rep LoginId x
from :: forall x. LoginId -> Rep LoginId x
$cto :: forall x. Rep LoginId x -> LoginId
to :: forall x. Rep LoginId x -> LoginId
Generic)
  deriving (Gen LoginId
Gen LoginId -> (LoginId -> [LoginId]) -> Arbitrary LoginId
LoginId -> [LoginId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LoginId
arbitrary :: Gen LoginId
$cshrink :: LoginId -> [LoginId]
shrink :: LoginId -> [LoginId]
Arbitrary) via (GenericUniform LoginId)
  deriving (Value -> Parser [LoginId]
Value -> Parser LoginId
(Value -> Parser LoginId)
-> (Value -> Parser [LoginId]) -> FromJSON LoginId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LoginId
parseJSON :: Value -> Parser LoginId
$cparseJSONList :: Value -> Parser [LoginId]
parseJSONList :: Value -> Parser [LoginId]
FromJSON, [LoginId] -> Value
[LoginId] -> Encoding
LoginId -> Value
LoginId -> Encoding
(LoginId -> Value)
-> (LoginId -> Encoding)
-> ([LoginId] -> Value)
-> ([LoginId] -> Encoding)
-> ToJSON LoginId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LoginId -> Value
toJSON :: LoginId -> Value
$ctoEncoding :: LoginId -> Encoding
toEncoding :: LoginId -> Encoding
$ctoJSONList :: [LoginId] -> Value
toJSONList :: [LoginId] -> Value
$ctoEncodingList :: [LoginId] -> Encoding
toEncodingList :: [LoginId] -> Encoding
ToJSON, Typeable LoginId
Typeable LoginId =>
(Proxy LoginId -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LoginId
Proxy LoginId -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LoginId -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LoginId -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema LoginId

-- NB. this should fail if (e.g.) the email is present but unparseable even if
-- the JSON contains a valid handle.
instance ToSchema LoginId where
  schema :: ValueSchema NamedSwaggerDoc LoginId
schema = Text
-> SchemaP SwaggerDoc Object [Pair] LoginId LoginId
-> ValueSchema NamedSwaggerDoc LoginId
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"LoginId" SchemaP SwaggerDoc Object [Pair] LoginId LoginId
loginObjectSchema

loginObjectSchema :: ObjectSchema SwaggerDoc LoginId
loginObjectSchema :: SchemaP SwaggerDoc Object [Pair] LoginId LoginId
loginObjectSchema =
  LoginId -> (Maybe EmailAddress, Maybe Handle)
fromLoginId (LoginId -> (Maybe EmailAddress, Maybe Handle))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe EmailAddress, Maybe Handle)
-> SchemaP
     SwaggerDoc Object [Pair] LoginId (Maybe EmailAddress, Maybe Handle)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Handle)
  (Maybe EmailAddress, Maybe Handle)
tupleSchema SchemaP
  SwaggerDoc Object [Pair] LoginId (Maybe EmailAddress, Maybe Handle)
-> ((Maybe EmailAddress, Maybe Handle) -> Parser LoginId)
-> SchemaP SwaggerDoc Object [Pair] LoginId LoginId
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
`withParser` (Maybe EmailAddress, Maybe Handle) -> Parser LoginId
validate
  where
    fromLoginId :: LoginId -> (Maybe EmailAddress, Maybe Handle)
    fromLoginId :: LoginId -> (Maybe EmailAddress, Maybe Handle)
fromLoginId = \case
      LoginByEmail EmailAddress
e -> (EmailAddress -> Maybe EmailAddress
forall a. a -> Maybe a
Just EmailAddress
e, Maybe Handle
forall a. Maybe a
Nothing)
      LoginByHandle Handle
h -> (Maybe EmailAddress
forall a. Maybe a
Nothing, Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h)
    tupleSchema :: ObjectSchema SwaggerDoc (Maybe EmailAddress, Maybe Handle)
    tupleSchema :: SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Handle)
  (Maybe EmailAddress, Maybe Handle)
tupleSchema =
      (,)
        (Maybe EmailAddress
 -> Maybe Handle -> (Maybe EmailAddress, Maybe Handle))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe Handle -> (Maybe EmailAddress, Maybe Handle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe EmailAddress, Maybe Handle) -> Maybe EmailAddress
forall a b. (a, b) -> a
fst ((Maybe EmailAddress, Maybe Handle) -> Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe EmailAddress)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress) (Maybe EmailAddress)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
-> SchemaP
     SwaggerDoc Object [Pair] EmailAddress (Maybe EmailAddress)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"email" SchemaP NamedSwaggerDoc Value Value EmailAddress EmailAddress
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Handle)
  (Maybe Handle -> (Maybe EmailAddress, Maybe Handle))
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe Handle)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe EmailAddress, Maybe Handle)
forall a b.
SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Maybe EmailAddress, Maybe Handle)
  (a -> b)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress, Maybe Handle) a
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe EmailAddress, Maybe Handle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe EmailAddress, Maybe Handle) -> Maybe Handle
forall a b. (a, b) -> b
snd ((Maybe EmailAddress, Maybe Handle) -> Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe EmailAddress, Maybe Handle)
     (Maybe Handle)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Handle) (Maybe Handle)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Handle Handle
-> SchemaP SwaggerDoc Object [Pair] Handle (Maybe Handle)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"handle" SchemaP NamedSwaggerDoc Value Value Handle Handle
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    validate :: (Maybe EmailAddress, Maybe Handle) -> A.Parser LoginId
    validate :: (Maybe EmailAddress, Maybe Handle) -> Parser LoginId
validate (Maybe EmailAddress
mEmail, Maybe Handle
mHandle) =
      Parser LoginId
-> (LoginId -> Parser LoginId) -> Maybe LoginId -> Parser LoginId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser LoginId
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'email' or 'handle' required") LoginId -> Parser LoginId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LoginId -> Parser LoginId)
-> Maybe LoginId -> Parser LoginId
forall a b. (a -> b) -> a -> b
$
        (EmailAddress -> LoginId
LoginByEmail (EmailAddress -> LoginId) -> Maybe EmailAddress -> Maybe LoginId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EmailAddress
mEmail) Maybe LoginId -> Maybe LoginId -> Maybe LoginId
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Handle -> LoginId
LoginByHandle (Handle -> LoginId) -> Maybe Handle -> Maybe LoginId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Handle
mHandle)

--------------------------------------------------------------------------------
-- LoginCode

-- | A single-use login code.
newtype LoginCode = LoginCode
  {LoginCode -> Text
fromLoginCode :: Text}
  deriving stock (LoginCode -> LoginCode -> Bool
(LoginCode -> LoginCode -> Bool)
-> (LoginCode -> LoginCode -> Bool) -> Eq LoginCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoginCode -> LoginCode -> Bool
== :: LoginCode -> LoginCode -> Bool
$c/= :: LoginCode -> LoginCode -> Bool
/= :: LoginCode -> LoginCode -> Bool
Eq, Int -> LoginCode -> ShowS
[LoginCode] -> ShowS
LoginCode -> String
(Int -> LoginCode -> ShowS)
-> (LoginCode -> String)
-> ([LoginCode] -> ShowS)
-> Show LoginCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoginCode -> ShowS
showsPrec :: Int -> LoginCode -> ShowS
$cshow :: LoginCode -> String
show :: LoginCode -> String
$cshowList :: [LoginCode] -> ShowS
showList :: [LoginCode] -> ShowS
Show)
  deriving newtype (Gen LoginCode
Gen LoginCode -> (LoginCode -> [LoginCode]) -> Arbitrary LoginCode
LoginCode -> [LoginCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LoginCode
arbitrary :: Gen LoginCode
$cshrink :: LoginCode -> [LoginCode]
shrink :: LoginCode -> [LoginCode]
Arbitrary)
  deriving (Value -> Parser [LoginCode]
Value -> Parser LoginCode
(Value -> Parser LoginCode)
-> (Value -> Parser [LoginCode]) -> FromJSON LoginCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LoginCode
parseJSON :: Value -> Parser LoginCode
$cparseJSONList :: Value -> Parser [LoginCode]
parseJSONList :: Value -> Parser [LoginCode]
FromJSON, [LoginCode] -> Value
[LoginCode] -> Encoding
LoginCode -> Value
LoginCode -> Encoding
(LoginCode -> Value)
-> (LoginCode -> Encoding)
-> ([LoginCode] -> Value)
-> ([LoginCode] -> Encoding)
-> ToJSON LoginCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LoginCode -> Value
toJSON :: LoginCode -> Value
$ctoEncoding :: LoginCode -> Encoding
toEncoding :: LoginCode -> Encoding
$ctoJSONList :: [LoginCode] -> Value
toJSONList :: [LoginCode] -> Value
$ctoEncodingList :: [LoginCode] -> Encoding
toEncodingList :: [LoginCode] -> Encoding
ToJSON, Typeable LoginCode
Typeable LoginCode =>
(Proxy LoginCode -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LoginCode
Proxy LoginCode -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LoginCode -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LoginCode -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema LoginCode

deriving instance Cql LoginCode

instance ToSchema LoginCode where
  schema :: ValueSchema NamedSwaggerDoc LoginCode
schema = Text -> LoginCode
LoginCode (Text -> LoginCode)
-> SchemaP NamedSwaggerDoc Value Value LoginCode Text
-> ValueSchema NamedSwaggerDoc LoginCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoginCode -> Text
fromLoginCode (LoginCode -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value LoginCode Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text -> SchemaP NamedSwaggerDoc Value Value Text Text
text Text
"LoginCode"

-- | Used for internal endpoint only.
data PendingLoginCode = PendingLoginCode
  { PendingLoginCode -> LoginCode
pendingLoginCode :: LoginCode,
    PendingLoginCode -> Timeout
pendingLoginTimeout :: Code.Timeout
  }
  deriving stock (PendingLoginCode -> PendingLoginCode -> Bool
(PendingLoginCode -> PendingLoginCode -> Bool)
-> (PendingLoginCode -> PendingLoginCode -> Bool)
-> Eq PendingLoginCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PendingLoginCode -> PendingLoginCode -> Bool
== :: PendingLoginCode -> PendingLoginCode -> Bool
$c/= :: PendingLoginCode -> PendingLoginCode -> Bool
/= :: PendingLoginCode -> PendingLoginCode -> Bool
Eq, Int -> PendingLoginCode -> ShowS
[PendingLoginCode] -> ShowS
PendingLoginCode -> String
(Int -> PendingLoginCode -> ShowS)
-> (PendingLoginCode -> String)
-> ([PendingLoginCode] -> ShowS)
-> Show PendingLoginCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PendingLoginCode -> ShowS
showsPrec :: Int -> PendingLoginCode -> ShowS
$cshow :: PendingLoginCode -> String
show :: PendingLoginCode -> String
$cshowList :: [PendingLoginCode] -> ShowS
showList :: [PendingLoginCode] -> ShowS
Show, (forall x. PendingLoginCode -> Rep PendingLoginCode x)
-> (forall x. Rep PendingLoginCode x -> PendingLoginCode)
-> Generic PendingLoginCode
forall x. Rep PendingLoginCode x -> PendingLoginCode
forall x. PendingLoginCode -> Rep PendingLoginCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PendingLoginCode -> Rep PendingLoginCode x
from :: forall x. PendingLoginCode -> Rep PendingLoginCode x
$cto :: forall x. Rep PendingLoginCode x -> PendingLoginCode
to :: forall x. Rep PendingLoginCode x -> PendingLoginCode
Generic)
  deriving (Gen PendingLoginCode
Gen PendingLoginCode
-> (PendingLoginCode -> [PendingLoginCode])
-> Arbitrary PendingLoginCode
PendingLoginCode -> [PendingLoginCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PendingLoginCode
arbitrary :: Gen PendingLoginCode
$cshrink :: PendingLoginCode -> [PendingLoginCode]
shrink :: PendingLoginCode -> [PendingLoginCode]
Arbitrary) via (GenericUniform PendingLoginCode)
  deriving (Value -> Parser [PendingLoginCode]
Value -> Parser PendingLoginCode
(Value -> Parser PendingLoginCode)
-> (Value -> Parser [PendingLoginCode])
-> FromJSON PendingLoginCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PendingLoginCode
parseJSON :: Value -> Parser PendingLoginCode
$cparseJSONList :: Value -> Parser [PendingLoginCode]
parseJSONList :: Value -> Parser [PendingLoginCode]
FromJSON, [PendingLoginCode] -> Value
[PendingLoginCode] -> Encoding
PendingLoginCode -> Value
PendingLoginCode -> Encoding
(PendingLoginCode -> Value)
-> (PendingLoginCode -> Encoding)
-> ([PendingLoginCode] -> Value)
-> ([PendingLoginCode] -> Encoding)
-> ToJSON PendingLoginCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PendingLoginCode -> Value
toJSON :: PendingLoginCode -> Value
$ctoEncoding :: PendingLoginCode -> Encoding
toEncoding :: PendingLoginCode -> Encoding
$ctoJSONList :: [PendingLoginCode] -> Value
toJSONList :: [PendingLoginCode] -> Value
$ctoEncodingList :: [PendingLoginCode] -> Encoding
toEncodingList :: [PendingLoginCode] -> Encoding
ToJSON, Typeable PendingLoginCode
Typeable PendingLoginCode =>
(Proxy PendingLoginCode
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PendingLoginCode
Proxy PendingLoginCode -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PendingLoginCode -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PendingLoginCode -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema PendingLoginCode

instance ToSchema PendingLoginCode where
  schema :: ValueSchema NamedSwaggerDoc PendingLoginCode
schema =
    Text
-> SchemaP
     SwaggerDoc Object [Pair] PendingLoginCode PendingLoginCode
-> ValueSchema NamedSwaggerDoc PendingLoginCode
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"PendingLoginCode" (SchemaP SwaggerDoc Object [Pair] PendingLoginCode PendingLoginCode
 -> ValueSchema NamedSwaggerDoc PendingLoginCode)
-> SchemaP
     SwaggerDoc Object [Pair] PendingLoginCode PendingLoginCode
-> ValueSchema NamedSwaggerDoc PendingLoginCode
forall a b. (a -> b) -> a -> b
$
      LoginCode -> Timeout -> PendingLoginCode
PendingLoginCode
        (LoginCode -> Timeout -> PendingLoginCode)
-> SchemaP SwaggerDoc Object [Pair] PendingLoginCode LoginCode
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PendingLoginCode
     (Timeout -> PendingLoginCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PendingLoginCode -> LoginCode
pendingLoginCode (PendingLoginCode -> LoginCode)
-> SchemaP SwaggerDoc Object [Pair] LoginCode LoginCode
-> SchemaP SwaggerDoc Object [Pair] PendingLoginCode LoginCode
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc LoginCode
-> SchemaP SwaggerDoc Object [Pair] LoginCode LoginCode
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"code" ValueSchema NamedSwaggerDoc LoginCode
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  PendingLoginCode
  (Timeout -> PendingLoginCode)
-> SchemaP SwaggerDoc Object [Pair] PendingLoginCode Timeout
-> SchemaP
     SwaggerDoc Object [Pair] PendingLoginCode PendingLoginCode
forall a b.
SchemaP SwaggerDoc Object [Pair] PendingLoginCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PendingLoginCode a
-> SchemaP SwaggerDoc Object [Pair] PendingLoginCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PendingLoginCode -> Timeout
pendingLoginTimeout (PendingLoginCode -> Timeout)
-> SchemaP SwaggerDoc Object [Pair] Timeout Timeout
-> SchemaP SwaggerDoc Object [Pair] PendingLoginCode Timeout
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Timeout Timeout
-> SchemaP SwaggerDoc Object [Pair] Timeout Timeout
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"expires_in" SchemaP NamedSwaggerDoc Value Value Timeout Timeout
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

--------------------------------------------------------------------------------
-- SendLoginCode

-- | A request for sending a 'LoginCode'
data SendLoginCode = SendLoginCode
  { SendLoginCode -> Phone
lcPhone :: Phone,
    SendLoginCode -> Bool
lcCall :: Bool,
    SendLoginCode -> Bool
lcForce :: Bool
  }
  deriving stock (SendLoginCode -> SendLoginCode -> Bool
(SendLoginCode -> SendLoginCode -> Bool)
-> (SendLoginCode -> SendLoginCode -> Bool) -> Eq SendLoginCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendLoginCode -> SendLoginCode -> Bool
== :: SendLoginCode -> SendLoginCode -> Bool
$c/= :: SendLoginCode -> SendLoginCode -> Bool
/= :: SendLoginCode -> SendLoginCode -> Bool
Eq, Int -> SendLoginCode -> ShowS
[SendLoginCode] -> ShowS
SendLoginCode -> String
(Int -> SendLoginCode -> ShowS)
-> (SendLoginCode -> String)
-> ([SendLoginCode] -> ShowS)
-> Show SendLoginCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SendLoginCode -> ShowS
showsPrec :: Int -> SendLoginCode -> ShowS
$cshow :: SendLoginCode -> String
show :: SendLoginCode -> String
$cshowList :: [SendLoginCode] -> ShowS
showList :: [SendLoginCode] -> ShowS
Show, (forall x. SendLoginCode -> Rep SendLoginCode x)
-> (forall x. Rep SendLoginCode x -> SendLoginCode)
-> Generic SendLoginCode
forall x. Rep SendLoginCode x -> SendLoginCode
forall x. SendLoginCode -> Rep SendLoginCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendLoginCode -> Rep SendLoginCode x
from :: forall x. SendLoginCode -> Rep SendLoginCode x
$cto :: forall x. Rep SendLoginCode x -> SendLoginCode
to :: forall x. Rep SendLoginCode x -> SendLoginCode
Generic)
  deriving (Gen SendLoginCode
Gen SendLoginCode
-> (SendLoginCode -> [SendLoginCode]) -> Arbitrary SendLoginCode
SendLoginCode -> [SendLoginCode]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SendLoginCode
arbitrary :: Gen SendLoginCode
$cshrink :: SendLoginCode -> [SendLoginCode]
shrink :: SendLoginCode -> [SendLoginCode]
Arbitrary) via (GenericUniform SendLoginCode)
  deriving (Value -> Parser [SendLoginCode]
Value -> Parser SendLoginCode
(Value -> Parser SendLoginCode)
-> (Value -> Parser [SendLoginCode]) -> FromJSON SendLoginCode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser SendLoginCode
parseJSON :: Value -> Parser SendLoginCode
$cparseJSONList :: Value -> Parser [SendLoginCode]
parseJSONList :: Value -> Parser [SendLoginCode]
FromJSON, [SendLoginCode] -> Value
[SendLoginCode] -> Encoding
SendLoginCode -> Value
SendLoginCode -> Encoding
(SendLoginCode -> Value)
-> (SendLoginCode -> Encoding)
-> ([SendLoginCode] -> Value)
-> ([SendLoginCode] -> Encoding)
-> ToJSON SendLoginCode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: SendLoginCode -> Value
toJSON :: SendLoginCode -> Value
$ctoEncoding :: SendLoginCode -> Encoding
toEncoding :: SendLoginCode -> Encoding
$ctoJSONList :: [SendLoginCode] -> Value
toJSONList :: [SendLoginCode] -> Value
$ctoEncodingList :: [SendLoginCode] -> Encoding
toEncodingList :: [SendLoginCode] -> Encoding
ToJSON, Typeable SendLoginCode
Typeable SendLoginCode =>
(Proxy SendLoginCode -> Declare (Definitions Schema) NamedSchema)
-> ToSchema SendLoginCode
Proxy SendLoginCode -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy SendLoginCode -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy SendLoginCode -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema SendLoginCode

instance ToSchema SendLoginCode where
  schema :: ValueSchema NamedSwaggerDoc SendLoginCode
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc SendLoginCode
-> ValueSchema NamedSwaggerDoc SendLoginCode
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"SendLoginCode"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Payload for requesting a login code to be sent")
      (ObjectSchema SwaggerDoc SendLoginCode
 -> ValueSchema NamedSwaggerDoc SendLoginCode)
-> ObjectSchema SwaggerDoc SendLoginCode
-> ValueSchema NamedSwaggerDoc SendLoginCode
forall a b. (a -> b) -> a -> b
$ Phone -> Bool -> Bool -> SendLoginCode
SendLoginCode
        (Phone -> Bool -> Bool -> SendLoginCode)
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode Phone
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     SendLoginCode
     (Bool -> Bool -> SendLoginCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SendLoginCode -> Phone
lcPhone
          (SendLoginCode -> Phone)
-> SchemaP SwaggerDoc Object [Pair] Phone Phone
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode Phone
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value Phone Phone
-> SchemaP SwaggerDoc Object [Pair] Phone Phone
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"phone"
            ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"E.164 phone number to send the code to")
            (SchemaP NamedSwaggerDoc Value Value Phone Phone
-> SchemaP SwaggerDoc Value Value Phone Phone
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value Phone Phone
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  SendLoginCode
  (Bool -> Bool -> SendLoginCode)
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode Bool
-> SchemaP
     SwaggerDoc Object [Pair] SendLoginCode (Bool -> SendLoginCode)
forall a b.
SchemaP SwaggerDoc Object [Pair] SendLoginCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode a
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SendLoginCode -> Bool
lcCall
          (SendLoginCode -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False)
            ( Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
                Text
"voice_call"
                ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Request the code with a call instead (default is SMS)")
                SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
            )
        SchemaP
  SwaggerDoc Object [Pair] SendLoginCode (Bool -> SendLoginCode)
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode Bool
-> ObjectSchema SwaggerDoc SendLoginCode
forall a b.
SchemaP SwaggerDoc Object [Pair] SendLoginCode (a -> b)
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode a
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SendLoginCode -> Bool
lcForce (SendLoginCode -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] SendLoginCode Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True) (Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"force" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- LoginCodeTimeout

-- | A timeout for a new or pending login code.
newtype LoginCodeTimeout = LoginCodeTimeout
  {LoginCodeTimeout -> Timeout
fromLoginCodeTimeout :: Code.Timeout}
  deriving stock (LoginCodeTimeout -> LoginCodeTimeout -> Bool
(LoginCodeTimeout -> LoginCodeTimeout -> Bool)
-> (LoginCodeTimeout -> LoginCodeTimeout -> Bool)
-> Eq LoginCodeTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoginCodeTimeout -> LoginCodeTimeout -> Bool
== :: LoginCodeTimeout -> LoginCodeTimeout -> Bool
$c/= :: LoginCodeTimeout -> LoginCodeTimeout -> Bool
/= :: LoginCodeTimeout -> LoginCodeTimeout -> Bool
Eq, Int -> LoginCodeTimeout -> ShowS
[LoginCodeTimeout] -> ShowS
LoginCodeTimeout -> String
(Int -> LoginCodeTimeout -> ShowS)
-> (LoginCodeTimeout -> String)
-> ([LoginCodeTimeout] -> ShowS)
-> Show LoginCodeTimeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoginCodeTimeout -> ShowS
showsPrec :: Int -> LoginCodeTimeout -> ShowS
$cshow :: LoginCodeTimeout -> String
show :: LoginCodeTimeout -> String
$cshowList :: [LoginCodeTimeout] -> ShowS
showList :: [LoginCodeTimeout] -> ShowS
Show)
  deriving newtype (Gen LoginCodeTimeout
Gen LoginCodeTimeout
-> (LoginCodeTimeout -> [LoginCodeTimeout])
-> Arbitrary LoginCodeTimeout
LoginCodeTimeout -> [LoginCodeTimeout]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen LoginCodeTimeout
arbitrary :: Gen LoginCodeTimeout
$cshrink :: LoginCodeTimeout -> [LoginCodeTimeout]
shrink :: LoginCodeTimeout -> [LoginCodeTimeout]
Arbitrary)
  deriving (Value -> Parser [LoginCodeTimeout]
Value -> Parser LoginCodeTimeout
(Value -> Parser LoginCodeTimeout)
-> (Value -> Parser [LoginCodeTimeout])
-> FromJSON LoginCodeTimeout
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LoginCodeTimeout
parseJSON :: Value -> Parser LoginCodeTimeout
$cparseJSONList :: Value -> Parser [LoginCodeTimeout]
parseJSONList :: Value -> Parser [LoginCodeTimeout]
FromJSON, [LoginCodeTimeout] -> Value
[LoginCodeTimeout] -> Encoding
LoginCodeTimeout -> Value
LoginCodeTimeout -> Encoding
(LoginCodeTimeout -> Value)
-> (LoginCodeTimeout -> Encoding)
-> ([LoginCodeTimeout] -> Value)
-> ([LoginCodeTimeout] -> Encoding)
-> ToJSON LoginCodeTimeout
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LoginCodeTimeout -> Value
toJSON :: LoginCodeTimeout -> Value
$ctoEncoding :: LoginCodeTimeout -> Encoding
toEncoding :: LoginCodeTimeout -> Encoding
$ctoJSONList :: [LoginCodeTimeout] -> Value
toJSONList :: [LoginCodeTimeout] -> Value
$ctoEncodingList :: [LoginCodeTimeout] -> Encoding
toEncodingList :: [LoginCodeTimeout] -> Encoding
ToJSON, Typeable LoginCodeTimeout
Typeable LoginCodeTimeout =>
(Proxy LoginCodeTimeout
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LoginCodeTimeout
Proxy LoginCodeTimeout -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LoginCodeTimeout -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LoginCodeTimeout -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema LoginCodeTimeout

instance ToSchema LoginCodeTimeout where
  schema :: ValueSchema NamedSwaggerDoc LoginCodeTimeout
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc LoginCodeTimeout
-> ValueSchema NamedSwaggerDoc LoginCodeTimeout
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"LoginCodeTimeout"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A response for a successfully sent login code")
      (ObjectSchema SwaggerDoc LoginCodeTimeout
 -> ValueSchema NamedSwaggerDoc LoginCodeTimeout)
-> ObjectSchema SwaggerDoc LoginCodeTimeout
-> ValueSchema NamedSwaggerDoc LoginCodeTimeout
forall a b. (a -> b) -> a -> b
$ Timeout -> LoginCodeTimeout
LoginCodeTimeout
        (Timeout -> LoginCodeTimeout)
-> SchemaP SwaggerDoc Object [Pair] LoginCodeTimeout Timeout
-> ObjectSchema SwaggerDoc LoginCodeTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoginCodeTimeout -> Timeout
fromLoginCodeTimeout
          (LoginCodeTimeout -> Timeout)
-> SchemaP SwaggerDoc Object [Pair] Timeout Timeout
-> SchemaP SwaggerDoc Object [Pair] LoginCodeTimeout Timeout
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value Timeout Timeout
-> SchemaP SwaggerDoc Object [Pair] Timeout Timeout
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"expires_in"
            ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Number of seconds before the login code expires")
            (SchemaP NamedSwaggerDoc Value Value Timeout Timeout
-> SchemaP SwaggerDoc Value Value Timeout Timeout
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed SchemaP NamedSwaggerDoc Value Value Timeout Timeout
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- Cookie

data CookieList = CookieList
  { CookieList -> [Cookie ()]
cookieList :: [Cookie ()]
  }
  deriving stock (CookieList -> CookieList -> Bool
(CookieList -> CookieList -> Bool)
-> (CookieList -> CookieList -> Bool) -> Eq CookieList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieList -> CookieList -> Bool
== :: CookieList -> CookieList -> Bool
$c/= :: CookieList -> CookieList -> Bool
/= :: CookieList -> CookieList -> Bool
Eq, Int -> CookieList -> ShowS
[CookieList] -> ShowS
CookieList -> String
(Int -> CookieList -> ShowS)
-> (CookieList -> String)
-> ([CookieList] -> ShowS)
-> Show CookieList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieList -> ShowS
showsPrec :: Int -> CookieList -> ShowS
$cshow :: CookieList -> String
show :: CookieList -> String
$cshowList :: [CookieList] -> ShowS
showList :: [CookieList] -> ShowS
Show, (forall x. CookieList -> Rep CookieList x)
-> (forall x. Rep CookieList x -> CookieList) -> Generic CookieList
forall x. Rep CookieList x -> CookieList
forall x. CookieList -> Rep CookieList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CookieList -> Rep CookieList x
from :: forall x. CookieList -> Rep CookieList x
$cto :: forall x. Rep CookieList x -> CookieList
to :: forall x. Rep CookieList x -> CookieList
Generic)
  deriving (Gen CookieList
Gen CookieList
-> (CookieList -> [CookieList]) -> Arbitrary CookieList
CookieList -> [CookieList]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CookieList
arbitrary :: Gen CookieList
$cshrink :: CookieList -> [CookieList]
shrink :: CookieList -> [CookieList]
Arbitrary) via (GenericUniform CookieList)
  deriving (Value -> Parser [CookieList]
Value -> Parser CookieList
(Value -> Parser CookieList)
-> (Value -> Parser [CookieList]) -> FromJSON CookieList
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CookieList
parseJSON :: Value -> Parser CookieList
$cparseJSONList :: Value -> Parser [CookieList]
parseJSONList :: Value -> Parser [CookieList]
FromJSON, [CookieList] -> Value
[CookieList] -> Encoding
CookieList -> Value
CookieList -> Encoding
(CookieList -> Value)
-> (CookieList -> Encoding)
-> ([CookieList] -> Value)
-> ([CookieList] -> Encoding)
-> ToJSON CookieList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CookieList -> Value
toJSON :: CookieList -> Value
$ctoEncoding :: CookieList -> Encoding
toEncoding :: CookieList -> Encoding
$ctoJSONList :: [CookieList] -> Value
toJSONList :: [CookieList] -> Value
$ctoEncodingList :: [CookieList] -> Encoding
toEncodingList :: [CookieList] -> Encoding
ToJSON, Typeable CookieList
Typeable CookieList =>
(Proxy CookieList -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CookieList
Proxy CookieList -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CookieList -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CookieList -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CookieList

instance ToSchema CookieList where
  schema :: ValueSchema NamedSwaggerDoc CookieList
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc CookieList
-> ValueSchema NamedSwaggerDoc CookieList
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"CookieList"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"List of cookie information")
      (ObjectSchema SwaggerDoc CookieList
 -> ValueSchema NamedSwaggerDoc CookieList)
-> ObjectSchema SwaggerDoc CookieList
-> ValueSchema NamedSwaggerDoc CookieList
forall a b. (a -> b) -> a -> b
$ [Cookie ()] -> CookieList
CookieList
        ([Cookie ()] -> CookieList)
-> SchemaP SwaggerDoc Object [Pair] CookieList [Cookie ()]
-> ObjectSchema SwaggerDoc CookieList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CookieList -> [Cookie ()]
cookieList (CookieList -> [Cookie ()])
-> SchemaP SwaggerDoc Object [Pair] [Cookie ()] [Cookie ()]
-> SchemaP SwaggerDoc Object [Pair] CookieList [Cookie ()]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [Cookie ()] [Cookie ()]
-> SchemaP SwaggerDoc Object [Pair] [Cookie ()] [Cookie ()]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"cookies" (ValueSchema NamedSwaggerDoc (Cookie ())
-> SchemaP SwaggerDoc Value Value [Cookie ()] [Cookie ()]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc (Cookie ())
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

-- | A (long-lived) cookie scoped to a specific user for obtaining new
-- 'AccessToken's.
data Cookie a = Cookie
  { forall a. Cookie a -> CookieId
cookieId :: CookieId,
    forall a. Cookie a -> CookieType
cookieType :: CookieType,
    forall a. Cookie a -> UTCTime
cookieCreated :: UTCTime,
    forall a. Cookie a -> UTCTime
cookieExpires :: UTCTime,
    forall a. Cookie a -> Maybe CookieLabel
cookieLabel :: Maybe CookieLabel,
    forall a. Cookie a -> Maybe CookieId
cookieSucc :: Maybe CookieId,
    forall a. Cookie a -> a
cookieValue :: a
  }
  deriving stock (Cookie a -> Cookie a -> Bool
(Cookie a -> Cookie a -> Bool)
-> (Cookie a -> Cookie a -> Bool) -> Eq (Cookie a)
forall a. Eq a => Cookie a -> Cookie a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Cookie a -> Cookie a -> Bool
== :: Cookie a -> Cookie a -> Bool
$c/= :: forall a. Eq a => Cookie a -> Cookie a -> Bool
/= :: Cookie a -> Cookie a -> Bool
Eq, Int -> Cookie a -> ShowS
[Cookie a] -> ShowS
Cookie a -> String
(Int -> Cookie a -> ShowS)
-> (Cookie a -> String) -> ([Cookie a] -> ShowS) -> Show (Cookie a)
forall a. Show a => Int -> Cookie a -> ShowS
forall a. Show a => [Cookie a] -> ShowS
forall a. Show a => Cookie a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Cookie a -> ShowS
showsPrec :: Int -> Cookie a -> ShowS
$cshow :: forall a. Show a => Cookie a -> String
show :: Cookie a -> String
$cshowList :: forall a. Show a => [Cookie a] -> ShowS
showList :: [Cookie a] -> ShowS
Show, (forall x. Cookie a -> Rep (Cookie a) x)
-> (forall x. Rep (Cookie a) x -> Cookie a) -> Generic (Cookie a)
forall x. Rep (Cookie a) x -> Cookie a
forall x. Cookie a -> Rep (Cookie a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Cookie a) x -> Cookie a
forall a x. Cookie a -> Rep (Cookie a) x
$cfrom :: forall a x. Cookie a -> Rep (Cookie a) x
from :: forall x. Cookie a -> Rep (Cookie a) x
$cto :: forall a x. Rep (Cookie a) x -> Cookie a
to :: forall x. Rep (Cookie a) x -> Cookie a
Generic)
  deriving (Gen (Cookie a)
Gen (Cookie a) -> (Cookie a -> [Cookie a]) -> Arbitrary (Cookie a)
Cookie a -> [Cookie a]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall a. Arbitrary a => Gen (Cookie a)
forall a. Arbitrary a => Cookie a -> [Cookie a]
$carbitrary :: forall a. Arbitrary a => Gen (Cookie a)
arbitrary :: Gen (Cookie a)
$cshrink :: forall a. Arbitrary a => Cookie a -> [Cookie a]
shrink :: Cookie a -> [Cookie a]
Arbitrary) via (GenericUniform (Cookie a))

instance ToSchema (Cookie ()) where
  schema :: ValueSchema NamedSwaggerDoc (Cookie ())
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Cookie ())
-> ValueSchema NamedSwaggerDoc (Cookie ())
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Cookie" (SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Cookie ())
 -> ValueSchema NamedSwaggerDoc (Cookie ()))
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Cookie ())
-> ValueSchema NamedSwaggerDoc (Cookie ())
forall a b. (a -> b) -> a -> b
$
      CookieId
-> CookieType
-> UTCTime
-> UTCTime
-> Maybe CookieLabel
-> Maybe CookieId
-> ()
-> Cookie ()
forall a.
CookieId
-> CookieType
-> UTCTime
-> UTCTime
-> Maybe CookieLabel
-> Maybe CookieId
-> a
-> Cookie a
Cookie
        (CookieId
 -> CookieType
 -> UTCTime
 -> UTCTime
 -> Maybe CookieLabel
 -> Maybe CookieId
 -> ()
 -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) CookieId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Cookie ())
     (CookieType
      -> UTCTime
      -> UTCTime
      -> Maybe CookieLabel
      -> Maybe CookieId
      -> ()
      -> Cookie ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cookie () -> CookieId
forall a. Cookie a -> CookieId
cookieId (Cookie () -> CookieId)
-> SchemaP SwaggerDoc Object [Pair] CookieId CookieId
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) CookieId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value CookieId CookieId
-> SchemaP SwaggerDoc Object [Pair] CookieId CookieId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" SchemaP NamedSwaggerDoc Value Value CookieId CookieId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Cookie ())
  (CookieType
   -> UTCTime
   -> UTCTime
   -> Maybe CookieLabel
   -> Maybe CookieId
   -> ()
   -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) CookieType
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Cookie ())
     (UTCTime
      -> UTCTime
      -> Maybe CookieLabel
      -> Maybe CookieId
      -> ()
      -> Cookie ())
forall a b.
SchemaP SwaggerDoc Object [Pair] (Cookie ()) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) a
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cookie () -> CookieType
forall a. Cookie a -> CookieType
cookieType (Cookie () -> CookieType)
-> SchemaP SwaggerDoc Object [Pair] CookieType CookieType
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) CookieType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value CookieType CookieType
-> SchemaP SwaggerDoc Object [Pair] CookieType CookieType
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"type" SchemaP NamedSwaggerDoc Value Value CookieType CookieType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Cookie ())
  (UTCTime
   -> UTCTime
   -> Maybe CookieLabel
   -> Maybe CookieId
   -> ()
   -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) UTCTime
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Cookie ())
     (UTCTime -> Maybe CookieLabel -> Maybe CookieId -> () -> Cookie ())
forall a b.
SchemaP SwaggerDoc Object [Pair] (Cookie ()) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) a
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cookie () -> UTCTime
forall a. Cookie a -> UTCTime
cookieCreated (Cookie () -> UTCTime)
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) UTCTime
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"created" SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
utcTimeSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Cookie ())
  (UTCTime -> Maybe CookieLabel -> Maybe CookieId -> () -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) UTCTime
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Cookie ())
     (Maybe CookieLabel -> Maybe CookieId -> () -> Cookie ())
forall a b.
SchemaP SwaggerDoc Object [Pair] (Cookie ()) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) a
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cookie () -> UTCTime
forall a. Cookie a -> UTCTime
cookieExpires (Cookie () -> UTCTime)
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) UTCTime
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
-> SchemaP SwaggerDoc Object [Pair] UTCTime UTCTime
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"expires" SchemaP NamedSwaggerDoc Value Value UTCTime UTCTime
utcTimeSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Cookie ())
  (Maybe CookieLabel -> Maybe CookieId -> () -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Maybe CookieLabel)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Cookie ())
     (Maybe CookieId -> () -> Cookie ())
forall a b.
SchemaP SwaggerDoc Object [Pair] (Cookie ()) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) a
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cookie () -> Maybe CookieLabel
forall a. Cookie a -> Maybe CookieLabel
cookieLabel (Cookie () -> Maybe CookieLabel)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieLabel) (Maybe CookieLabel)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Maybe CookieLabel)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe CookieLabel) CookieLabel
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieLabel) (Maybe CookieLabel)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"label" (Value
-> SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe CookieLabel) CookieLabel
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  (Cookie ())
  (Maybe CookieId -> () -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Maybe CookieId)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (() -> Cookie ())
forall a b.
SchemaP SwaggerDoc Object [Pair] (Cookie ()) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) a
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cookie () -> Maybe CookieId
forall a. Cookie a -> Maybe CookieId
cookieSucc (Cookie () -> Maybe CookieId)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieId) (Maybe CookieId)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Maybe CookieId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe CookieId) CookieId
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieId) (Maybe CookieId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"successor" (Value
-> SchemaP NamedSwaggerDoc Value Value CookieId CookieId
-> SchemaP NamedSwaggerDoc Value Value (Maybe CookieId) CookieId
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value CookieId CookieId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] (Cookie ()) (() -> Cookie ())
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) ()
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) (Cookie ())
forall a b.
SchemaP SwaggerDoc Object [Pair] (Cookie ()) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) a
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cookie () -> ()
forall a. Cookie a -> a
cookieValue (Cookie () -> ())
-> SchemaP SwaggerDoc Object [Pair] () ()
-> SchemaP SwaggerDoc Object [Pair] (Cookie ()) ()
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= () -> SchemaP SwaggerDoc Object [Pair] () ()
forall a. a -> SchemaP SwaggerDoc Object [Pair] () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

deriving via Schema (Cookie ()) instance FromJSON (Cookie ())

deriving via Schema (Cookie ()) instance ToJSON (Cookie ())

deriving via Schema (Cookie ()) instance S.ToSchema (Cookie ())

-- | A device-specific identifying label for one or more cookies.
-- Cookies can be listed and deleted based on their labels.
newtype CookieLabel = CookieLabel
  {CookieLabel -> Text
cookieLabelText :: Text}
  deriving stock (CookieLabel -> CookieLabel -> Bool
(CookieLabel -> CookieLabel -> Bool)
-> (CookieLabel -> CookieLabel -> Bool) -> Eq CookieLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieLabel -> CookieLabel -> Bool
== :: CookieLabel -> CookieLabel -> Bool
$c/= :: CookieLabel -> CookieLabel -> Bool
/= :: CookieLabel -> CookieLabel -> Bool
Eq, Eq CookieLabel
Eq CookieLabel =>
(CookieLabel -> CookieLabel -> Ordering)
-> (CookieLabel -> CookieLabel -> Bool)
-> (CookieLabel -> CookieLabel -> Bool)
-> (CookieLabel -> CookieLabel -> Bool)
-> (CookieLabel -> CookieLabel -> Bool)
-> (CookieLabel -> CookieLabel -> CookieLabel)
-> (CookieLabel -> CookieLabel -> CookieLabel)
-> Ord CookieLabel
CookieLabel -> CookieLabel -> Bool
CookieLabel -> CookieLabel -> Ordering
CookieLabel -> CookieLabel -> CookieLabel
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
$ccompare :: CookieLabel -> CookieLabel -> Ordering
compare :: CookieLabel -> CookieLabel -> Ordering
$c< :: CookieLabel -> CookieLabel -> Bool
< :: CookieLabel -> CookieLabel -> Bool
$c<= :: CookieLabel -> CookieLabel -> Bool
<= :: CookieLabel -> CookieLabel -> Bool
$c> :: CookieLabel -> CookieLabel -> Bool
> :: CookieLabel -> CookieLabel -> Bool
$c>= :: CookieLabel -> CookieLabel -> Bool
>= :: CookieLabel -> CookieLabel -> Bool
$cmax :: CookieLabel -> CookieLabel -> CookieLabel
max :: CookieLabel -> CookieLabel -> CookieLabel
$cmin :: CookieLabel -> CookieLabel -> CookieLabel
min :: CookieLabel -> CookieLabel -> CookieLabel
Ord, Int -> CookieLabel -> ShowS
[CookieLabel] -> ShowS
CookieLabel -> String
(Int -> CookieLabel -> ShowS)
-> (CookieLabel -> String)
-> ([CookieLabel] -> ShowS)
-> Show CookieLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieLabel -> ShowS
showsPrec :: Int -> CookieLabel -> ShowS
$cshow :: CookieLabel -> String
show :: CookieLabel -> String
$cshowList :: [CookieLabel] -> ShowS
showList :: [CookieLabel] -> ShowS
Show, (forall x. CookieLabel -> Rep CookieLabel x)
-> (forall x. Rep CookieLabel x -> CookieLabel)
-> Generic CookieLabel
forall x. Rep CookieLabel x -> CookieLabel
forall x. CookieLabel -> Rep CookieLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CookieLabel -> Rep CookieLabel x
from :: forall x. CookieLabel -> Rep CookieLabel x
$cto :: forall x. Rep CookieLabel x -> CookieLabel
to :: forall x. Rep CookieLabel x -> CookieLabel
Generic)
  deriving newtype
    ( Value -> Parser [CookieLabel]
Value -> Parser CookieLabel
(Value -> Parser CookieLabel)
-> (Value -> Parser [CookieLabel]) -> FromJSON CookieLabel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CookieLabel
parseJSON :: Value -> Parser CookieLabel
$cparseJSONList :: Value -> Parser [CookieLabel]
parseJSONList :: Value -> Parser [CookieLabel]
FromJSON,
      [CookieLabel] -> Value
[CookieLabel] -> Encoding
CookieLabel -> Value
CookieLabel -> Encoding
(CookieLabel -> Value)
-> (CookieLabel -> Encoding)
-> ([CookieLabel] -> Value)
-> ([CookieLabel] -> Encoding)
-> ToJSON CookieLabel
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CookieLabel -> Value
toJSON :: CookieLabel -> Value
$ctoEncoding :: CookieLabel -> Encoding
toEncoding :: CookieLabel -> Encoding
$ctoJSONList :: [CookieLabel] -> Value
toJSONList :: [CookieLabel] -> Value
$ctoEncodingList :: [CookieLabel] -> Encoding
toEncodingList :: [CookieLabel] -> Encoding
ToJSON,
      Parser CookieLabel
Parser CookieLabel -> FromByteString CookieLabel
forall a. Parser a -> FromByteString a
$cparser :: Parser CookieLabel
parser :: Parser CookieLabel
FromByteString,
      CookieLabel -> Builder
(CookieLabel -> Builder) -> ToByteString CookieLabel
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: CookieLabel -> Builder
builder :: CookieLabel -> Builder
ToByteString,
      String -> CookieLabel
(String -> CookieLabel) -> IsString CookieLabel
forall a. (String -> a) -> IsString a
$cfromString :: String -> CookieLabel
fromString :: String -> CookieLabel
IsString,
      Gen CookieLabel
Gen CookieLabel
-> (CookieLabel -> [CookieLabel]) -> Arbitrary CookieLabel
CookieLabel -> [CookieLabel]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CookieLabel
arbitrary :: Gen CookieLabel
$cshrink :: CookieLabel -> [CookieLabel]
shrink :: CookieLabel -> [CookieLabel]
Arbitrary,
      Typeable CookieLabel
Typeable CookieLabel =>
(Proxy CookieLabel -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CookieLabel
Proxy CookieLabel -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CookieLabel -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CookieLabel -> Declare (Definitions Schema) NamedSchema
S.ToSchema,
      SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
-> ToSchema CookieLabel
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
schema :: SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
ToSchema
    )

deriving instance Cql CookieLabel

newtype CookieId = CookieId
  {CookieId -> Word32
cookieIdNum :: Word32}
  deriving stock (CookieId -> CookieId -> Bool
(CookieId -> CookieId -> Bool)
-> (CookieId -> CookieId -> Bool) -> Eq CookieId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieId -> CookieId -> Bool
== :: CookieId -> CookieId -> Bool
$c/= :: CookieId -> CookieId -> Bool
/= :: CookieId -> CookieId -> Bool
Eq, Int -> CookieId -> ShowS
[CookieId] -> ShowS
CookieId -> String
(Int -> CookieId -> ShowS)
-> (CookieId -> String) -> ([CookieId] -> ShowS) -> Show CookieId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieId -> ShowS
showsPrec :: Int -> CookieId -> ShowS
$cshow :: CookieId -> String
show :: CookieId -> String
$cshowList :: [CookieId] -> ShowS
showList :: [CookieId] -> ShowS
Show, (forall x. CookieId -> Rep CookieId x)
-> (forall x. Rep CookieId x -> CookieId) -> Generic CookieId
forall x. Rep CookieId x -> CookieId
forall x. CookieId -> Rep CookieId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CookieId -> Rep CookieId x
from :: forall x. CookieId -> Rep CookieId x
$cto :: forall x. Rep CookieId x -> CookieId
to :: forall x. Rep CookieId x -> CookieId
Generic)
  deriving newtype (SchemaP NamedSwaggerDoc Value Value CookieId CookieId
SchemaP NamedSwaggerDoc Value Value CookieId CookieId
-> ToSchema CookieId
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: SchemaP NamedSwaggerDoc Value Value CookieId CookieId
schema :: SchemaP NamedSwaggerDoc Value Value CookieId CookieId
ToSchema, Value -> Parser [CookieId]
Value -> Parser CookieId
(Value -> Parser CookieId)
-> (Value -> Parser [CookieId]) -> FromJSON CookieId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CookieId
parseJSON :: Value -> Parser CookieId
$cparseJSONList :: Value -> Parser [CookieId]
parseJSONList :: Value -> Parser [CookieId]
FromJSON, [CookieId] -> Value
[CookieId] -> Encoding
CookieId -> Value
CookieId -> Encoding
(CookieId -> Value)
-> (CookieId -> Encoding)
-> ([CookieId] -> Value)
-> ([CookieId] -> Encoding)
-> ToJSON CookieId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CookieId -> Value
toJSON :: CookieId -> Value
$ctoEncoding :: CookieId -> Encoding
toEncoding :: CookieId -> Encoding
$ctoJSONList :: [CookieId] -> Value
toJSONList :: [CookieId] -> Value
$ctoEncodingList :: [CookieId] -> Encoding
toEncodingList :: [CookieId] -> Encoding
ToJSON, Gen CookieId
Gen CookieId -> (CookieId -> [CookieId]) -> Arbitrary CookieId
CookieId -> [CookieId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CookieId
arbitrary :: Gen CookieId
$cshrink :: CookieId -> [CookieId]
shrink :: CookieId -> [CookieId]
Arbitrary)

instance Cql CookieId where
  ctype :: Tagged CookieId ColumnType
ctype = ColumnType -> Tagged CookieId ColumnType
forall a b. b -> Tagged a b
Cassandra.Tagged ColumnType
BigIntColumn
  toCql :: CookieId -> Value
toCql = Int64 -> Value
CqlBigInt (Int64 -> Value) -> (CookieId -> Int64) -> CookieId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (CookieId -> Word32) -> CookieId -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookieId -> Word32
cookieIdNum

  fromCql :: Value -> Either String CookieId
fromCql (CqlBigInt Int64
i) = CookieId -> Either String CookieId
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> CookieId
CookieId (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i))
  fromCql Value
_ = String -> Either String CookieId
forall a b. a -> Either a b
Left String
"fromCql: invalid cookie id"

data CookieType
  = -- | A session cookie. These are mainly intended for clients
    -- that are web browsers. For other clients, session cookies
    -- behave like regular persistent cookies except for the fact
    -- that they are never renewed during a token refresh and that
    -- they have a shorter lifetime.
    SessionCookie
  | -- | A regular persistent cookie that expires at a specific date.
    -- These cookies are regularly renewed as part of an access token
    -- refresh.
    PersistentCookie
  deriving stock (CookieType -> CookieType -> Bool
(CookieType -> CookieType -> Bool)
-> (CookieType -> CookieType -> Bool) -> Eq CookieType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieType -> CookieType -> Bool
== :: CookieType -> CookieType -> Bool
$c/= :: CookieType -> CookieType -> Bool
/= :: CookieType -> CookieType -> Bool
Eq, Int -> CookieType -> ShowS
[CookieType] -> ShowS
CookieType -> String
(Int -> CookieType -> ShowS)
-> (CookieType -> String)
-> ([CookieType] -> ShowS)
-> Show CookieType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieType -> ShowS
showsPrec :: Int -> CookieType -> ShowS
$cshow :: CookieType -> String
show :: CookieType -> String
$cshowList :: [CookieType] -> ShowS
showList :: [CookieType] -> ShowS
Show, (forall x. CookieType -> Rep CookieType x)
-> (forall x. Rep CookieType x -> CookieType) -> Generic CookieType
forall x. Rep CookieType x -> CookieType
forall x. CookieType -> Rep CookieType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CookieType -> Rep CookieType x
from :: forall x. CookieType -> Rep CookieType x
$cto :: forall x. Rep CookieType x -> CookieType
to :: forall x. Rep CookieType x -> CookieType
Generic)
  deriving (Gen CookieType
Gen CookieType
-> (CookieType -> [CookieType]) -> Arbitrary CookieType
CookieType -> [CookieType]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen CookieType
arbitrary :: Gen CookieType
$cshrink :: CookieType -> [CookieType]
shrink :: CookieType -> [CookieType]
Arbitrary) via (GenericUniform CookieType)
  deriving (Value -> Parser [CookieType]
Value -> Parser CookieType
(Value -> Parser CookieType)
-> (Value -> Parser [CookieType]) -> FromJSON CookieType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CookieType
parseJSON :: Value -> Parser CookieType
$cparseJSONList :: Value -> Parser [CookieType]
parseJSONList :: Value -> Parser [CookieType]
FromJSON, [CookieType] -> Value
[CookieType] -> Encoding
CookieType -> Value
CookieType -> Encoding
(CookieType -> Value)
-> (CookieType -> Encoding)
-> ([CookieType] -> Value)
-> ([CookieType] -> Encoding)
-> ToJSON CookieType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CookieType -> Value
toJSON :: CookieType -> Value
$ctoEncoding :: CookieType -> Encoding
toEncoding :: CookieType -> Encoding
$ctoJSONList :: [CookieType] -> Value
toJSONList :: [CookieType] -> Value
$ctoEncodingList :: [CookieType] -> Encoding
toEncodingList :: [CookieType] -> Encoding
ToJSON, Typeable CookieType
Typeable CookieType =>
(Proxy CookieType -> Declare (Definitions Schema) NamedSchema)
-> ToSchema CookieType
Proxy CookieType -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy CookieType -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy CookieType -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema CookieType

instance Cql CookieType where
  ctype :: Tagged CookieType ColumnType
ctype = ColumnType -> Tagged CookieType ColumnType
forall a b. b -> Tagged a b
Cassandra.Tagged ColumnType
IntColumn

  toCql :: CookieType -> Value
toCql CookieType
SessionCookie = Int32 -> Value
CqlInt Int32
0
  toCql CookieType
PersistentCookie = Int32 -> Value
CqlInt Int32
1

  fromCql :: Value -> Either String CookieType
fromCql (CqlInt Int32
0) = CookieType -> Either String CookieType
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CookieType
SessionCookie
  fromCql (CqlInt Int32
1) = CookieType -> Either String CookieType
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CookieType
PersistentCookie
  fromCql Value
_ = String -> Either String CookieType
forall a b. a -> Either a b
Left String
"fromCql: invalid cookie type"

instance ToSchema CookieType where
  schema :: SchemaP NamedSwaggerDoc Value Value CookieType CookieType
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"CookieType" (SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
 -> SchemaP NamedSwaggerDoc Value Value CookieType CookieType)
-> SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
-> SchemaP NamedSwaggerDoc Value Value CookieType CookieType
forall a b. (a -> b) -> a -> b
$
      Text
-> CookieType
-> SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"session" CookieType
SessionCookie
        SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
-> SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
-> SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
forall a. Semigroup a => a -> a -> a
<> Text
-> CookieType
-> SchemaP [Value] Text (Alt Maybe Text) CookieType CookieType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"persistent" CookieType
PersistentCookie

toUnitCookie :: Cookie a -> Cookie ()
toUnitCookie :: forall a. Cookie a -> Cookie ()
toUnitCookie Cookie a
c = Cookie a
c {cookieValue = ()}

--------------------------------------------------------------------------------
-- Login

data Login = MkLogin
  { Login -> LoginId
lId :: LoginId,
    Login -> PlainTextPassword6
lPassword :: PlainTextPassword6,
    Login -> Maybe CookieLabel
lLabel :: Maybe CookieLabel,
    Login -> Maybe Value
lCode :: Maybe Code.Value
  }
  deriving stock (Login -> Login -> Bool
(Login -> Login -> Bool) -> (Login -> Login -> Bool) -> Eq Login
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Login -> Login -> Bool
== :: Login -> Login -> Bool
$c/= :: Login -> Login -> Bool
/= :: Login -> Login -> Bool
Eq, Int -> Login -> ShowS
[Login] -> ShowS
Login -> String
(Int -> Login -> ShowS)
-> (Login -> String) -> ([Login] -> ShowS) -> Show Login
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Login -> ShowS
showsPrec :: Int -> Login -> ShowS
$cshow :: Login -> String
show :: Login -> String
$cshowList :: [Login] -> ShowS
showList :: [Login] -> ShowS
Show, (forall x. Login -> Rep Login x)
-> (forall x. Rep Login x -> Login) -> Generic Login
forall x. Rep Login x -> Login
forall x. Login -> Rep Login x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Login -> Rep Login x
from :: forall x. Login -> Rep Login x
$cto :: forall x. Rep Login x -> Login
to :: forall x. Rep Login x -> Login
Generic)
  deriving (Gen Login
Gen Login -> (Login -> [Login]) -> Arbitrary Login
Login -> [Login]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Login
arbitrary :: Gen Login
$cshrink :: Login -> [Login]
shrink :: Login -> [Login]
Arbitrary) via (GenericUniform Login)
  deriving ([Login] -> Value
[Login] -> Encoding
Login -> Value
Login -> Encoding
(Login -> Value)
-> (Login -> Encoding)
-> ([Login] -> Value)
-> ([Login] -> Encoding)
-> ToJSON Login
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Login -> Value
toJSON :: Login -> Value
$ctoEncoding :: Login -> Encoding
toEncoding :: Login -> Encoding
$ctoJSONList :: [Login] -> Value
toJSONList :: [Login] -> Value
$ctoEncodingList :: [Login] -> Encoding
toEncodingList :: [Login] -> Encoding
ToJSON, Value -> Parser [Login]
Value -> Parser Login
(Value -> Parser Login)
-> (Value -> Parser [Login]) -> FromJSON Login
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Login
parseJSON :: Value -> Parser Login
$cparseJSONList :: Value -> Parser [Login]
parseJSONList :: Value -> Parser [Login]
FromJSON, Typeable Login
Typeable Login =>
(Proxy Login -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Login
Proxy Login -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Login -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Login -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Login)

instance ToSchema Login where
  schema :: ValueSchema NamedSwaggerDoc Login
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Login Login
-> ValueSchema NamedSwaggerDoc Login
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Login" (SchemaP SwaggerDoc Object [Pair] Login Login
 -> ValueSchema NamedSwaggerDoc Login)
-> SchemaP SwaggerDoc Object [Pair] Login Login
-> ValueSchema NamedSwaggerDoc Login
forall a b. (a -> b) -> a -> b
$
      LoginId
-> PlainTextPassword6 -> Maybe CookieLabel -> Maybe Value -> Login
MkLogin
        (LoginId
 -> PlainTextPassword6 -> Maybe CookieLabel -> Maybe Value -> Login)
-> SchemaP SwaggerDoc Object [Pair] Login LoginId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Login
     (PlainTextPassword6 -> Maybe CookieLabel -> Maybe Value -> Login)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Login -> LoginId
lId (Login -> LoginId)
-> SchemaP SwaggerDoc Object [Pair] LoginId LoginId
-> SchemaP SwaggerDoc Object [Pair] Login LoginId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] LoginId LoginId
loginObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Login
  (PlainTextPassword6 -> Maybe CookieLabel -> Maybe Value -> Login)
-> SchemaP SwaggerDoc Object [Pair] Login PlainTextPassword6
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Login
     (Maybe CookieLabel -> Maybe Value -> Login)
forall a b.
SchemaP SwaggerDoc Object [Pair] Login (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Login a
-> SchemaP SwaggerDoc Object [Pair] Login b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Login -> PlainTextPassword6
lPassword (Login -> PlainTextPassword6)
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword6 PlainTextPassword6
-> SchemaP SwaggerDoc Object [Pair] Login PlainTextPassword6
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword6 PlainTextPassword6
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Login
  (Maybe CookieLabel -> Maybe Value -> Login)
-> SchemaP SwaggerDoc Object [Pair] Login (Maybe CookieLabel)
-> SchemaP SwaggerDoc Object [Pair] Login (Maybe Value -> Login)
forall a b.
SchemaP SwaggerDoc Object [Pair] Login (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Login a
-> SchemaP SwaggerDoc Object [Pair] Login b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Login -> Maybe CookieLabel
lLabel (Login -> Maybe CookieLabel)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieLabel) (Maybe CookieLabel)
-> SchemaP SwaggerDoc Object [Pair] Login (Maybe CookieLabel)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe CookieLabel) CookieLabel
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe CookieLabel) (Maybe CookieLabel)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"label" (Value
-> SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
-> SchemaP
     NamedSwaggerDoc Value Value (Maybe CookieLabel) CookieLabel
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
        SchemaP SwaggerDoc Object [Pair] Login (Maybe Value -> Login)
-> SchemaP SwaggerDoc Object [Pair] Login (Maybe Value)
-> SchemaP SwaggerDoc Object [Pair] Login Login
forall a b.
SchemaP SwaggerDoc Object [Pair] Login (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Login a
-> SchemaP SwaggerDoc Object [Pair] Login b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Login -> Maybe Value
lCode (Login -> Maybe Value)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Value) (Maybe Value)
-> SchemaP SwaggerDoc Object [Pair] Login (Maybe Value)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe Value) Value
-> SchemaP SwaggerDoc Object [Pair] (Maybe Value) (Maybe Value)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"verification_code" (Value
-> SchemaP NamedSwaggerDoc Value Value Value Value
-> SchemaP NamedSwaggerDoc Value Value (Maybe Value) Value
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value Value Value
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- RemoveCookies

data RemoveCookies = RemoveCookies
  { RemoveCookies -> PlainTextPassword6
rmCookiesPassword :: PlainTextPassword6,
    RemoveCookies -> [CookieLabel]
rmCookiesLabels :: [CookieLabel],
    RemoveCookies -> [CookieId]
rmCookiesIdents :: [CookieId]
  }
  deriving stock (RemoveCookies -> RemoveCookies -> Bool
(RemoveCookies -> RemoveCookies -> Bool)
-> (RemoveCookies -> RemoveCookies -> Bool) -> Eq RemoveCookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoveCookies -> RemoveCookies -> Bool
== :: RemoveCookies -> RemoveCookies -> Bool
$c/= :: RemoveCookies -> RemoveCookies -> Bool
/= :: RemoveCookies -> RemoveCookies -> Bool
Eq, Int -> RemoveCookies -> ShowS
[RemoveCookies] -> ShowS
RemoveCookies -> String
(Int -> RemoveCookies -> ShowS)
-> (RemoveCookies -> String)
-> ([RemoveCookies] -> ShowS)
-> Show RemoveCookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveCookies -> ShowS
showsPrec :: Int -> RemoveCookies -> ShowS
$cshow :: RemoveCookies -> String
show :: RemoveCookies -> String
$cshowList :: [RemoveCookies] -> ShowS
showList :: [RemoveCookies] -> ShowS
Show, (forall x. RemoveCookies -> Rep RemoveCookies x)
-> (forall x. Rep RemoveCookies x -> RemoveCookies)
-> Generic RemoveCookies
forall x. Rep RemoveCookies x -> RemoveCookies
forall x. RemoveCookies -> Rep RemoveCookies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoveCookies -> Rep RemoveCookies x
from :: forall x. RemoveCookies -> Rep RemoveCookies x
$cto :: forall x. Rep RemoveCookies x -> RemoveCookies
to :: forall x. Rep RemoveCookies x -> RemoveCookies
Generic)
  deriving (Gen RemoveCookies
Gen RemoveCookies
-> (RemoveCookies -> [RemoveCookies]) -> Arbitrary RemoveCookies
RemoveCookies -> [RemoveCookies]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen RemoveCookies
arbitrary :: Gen RemoveCookies
$cshrink :: RemoveCookies -> [RemoveCookies]
shrink :: RemoveCookies -> [RemoveCookies]
Arbitrary) via (GenericUniform RemoveCookies)
  deriving (Value -> Parser [RemoveCookies]
Value -> Parser RemoveCookies
(Value -> Parser RemoveCookies)
-> (Value -> Parser [RemoveCookies]) -> FromJSON RemoveCookies
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RemoveCookies
parseJSON :: Value -> Parser RemoveCookies
$cparseJSONList :: Value -> Parser [RemoveCookies]
parseJSONList :: Value -> Parser [RemoveCookies]
FromJSON, [RemoveCookies] -> Value
[RemoveCookies] -> Encoding
RemoveCookies -> Value
RemoveCookies -> Encoding
(RemoveCookies -> Value)
-> (RemoveCookies -> Encoding)
-> ([RemoveCookies] -> Value)
-> ([RemoveCookies] -> Encoding)
-> ToJSON RemoveCookies
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RemoveCookies -> Value
toJSON :: RemoveCookies -> Value
$ctoEncoding :: RemoveCookies -> Encoding
toEncoding :: RemoveCookies -> Encoding
$ctoJSONList :: [RemoveCookies] -> Value
toJSONList :: [RemoveCookies] -> Value
$ctoEncodingList :: [RemoveCookies] -> Encoding
toEncodingList :: [RemoveCookies] -> Encoding
ToJSON, Typeable RemoveCookies
Typeable RemoveCookies =>
(Proxy RemoveCookies -> Declare (Definitions Schema) NamedSchema)
-> ToSchema RemoveCookies
Proxy RemoveCookies -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy RemoveCookies -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy RemoveCookies -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema RemoveCookies

instance ToSchema RemoveCookies where
  schema :: ValueSchema NamedSwaggerDoc RemoveCookies
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc RemoveCookies
-> ValueSchema NamedSwaggerDoc RemoveCookies
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"RemoveCookies"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Data required to remove cookies")
      (ObjectSchema SwaggerDoc RemoveCookies
 -> ValueSchema NamedSwaggerDoc RemoveCookies)
-> ObjectSchema SwaggerDoc RemoveCookies
-> ValueSchema NamedSwaggerDoc RemoveCookies
forall a b. (a -> b) -> a -> b
$ PlainTextPassword6 -> [CookieLabel] -> [CookieId] -> RemoveCookies
RemoveCookies
        (PlainTextPassword6
 -> [CookieLabel] -> [CookieId] -> RemoveCookies)
-> SchemaP
     SwaggerDoc Object [Pair] RemoveCookies PlainTextPassword6
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveCookies
     ([CookieLabel] -> [CookieId] -> RemoveCookies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoveCookies -> PlainTextPassword6
rmCookiesPassword
          (RemoveCookies -> PlainTextPassword6)
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc Object [Pair] RemoveCookies PlainTextPassword6
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc Object [Pair] PlainTextPassword6 PlainTextPassword6
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"password"
            ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The user's password")
            SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RemoveCookies
  ([CookieLabel] -> [CookieId] -> RemoveCookies)
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies [CookieLabel]
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     RemoveCookies
     ([CookieId] -> RemoveCookies)
forall a b.
SchemaP SwaggerDoc Object [Pair] RemoveCookies (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies a
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RemoveCookies -> [CookieLabel]
rmCookiesLabels
          (RemoveCookies -> [CookieLabel])
-> SchemaP SwaggerDoc Object [Pair] [CookieLabel] [CookieLabel]
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies [CookieLabel]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe [CookieLabel] -> [CookieLabel])
-> SchemaP
     SwaggerDoc Object [Pair] [CookieLabel] (Maybe [CookieLabel])
-> SchemaP SwaggerDoc Object [Pair] [CookieLabel] [CookieLabel]
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] [CookieLabel] a
-> SchemaP SwaggerDoc Object [Pair] [CookieLabel] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            Maybe [CookieLabel] -> [CookieLabel]
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            ( Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [CookieLabel] [CookieLabel]
-> SchemaP
     SwaggerDoc Object [Pair] [CookieLabel] (Maybe [CookieLabel])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
                Text
"labels"
                ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A list of cookie labels for which to revoke the cookies")
                (SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
-> SchemaP SwaggerDoc Value Value [CookieLabel] [CookieLabel]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP NamedSwaggerDoc Value Value CookieLabel CookieLabel
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
            )
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  RemoveCookies
  ([CookieId] -> RemoveCookies)
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies [CookieId]
-> ObjectSchema SwaggerDoc RemoveCookies
forall a b.
SchemaP SwaggerDoc Object [Pair] RemoveCookies (a -> b)
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies a
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RemoveCookies -> [CookieId]
rmCookiesIdents
          (RemoveCookies -> [CookieId])
-> SchemaP SwaggerDoc Object [Pair] [CookieId] [CookieId]
-> SchemaP SwaggerDoc Object [Pair] RemoveCookies [CookieId]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe [CookieId] -> [CookieId])
-> SchemaP SwaggerDoc Object [Pair] [CookieId] (Maybe [CookieId])
-> SchemaP SwaggerDoc Object [Pair] [CookieId] [CookieId]
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] [CookieId] a
-> SchemaP SwaggerDoc Object [Pair] [CookieId] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            Maybe [CookieId] -> [CookieId]
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            ( Text
-> (SwaggerDoc -> SwaggerDoc)
-> SchemaP SwaggerDoc Value Value [CookieId] [CookieId]
-> SchemaP SwaggerDoc Object [Pair] [CookieId] (Maybe [CookieId])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optFieldWithDocModifier
                Text
"ids"
                ((Maybe Text -> Identity (Maybe Text))
-> SwaggerDoc -> Identity SwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' SwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> SwaggerDoc -> Identity SwaggerDoc)
-> Text -> SwaggerDoc -> SwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"A list of cookie IDs to revoke")
                (SchemaP NamedSwaggerDoc Value Value CookieId CookieId
-> SchemaP SwaggerDoc Value Value [CookieId] [CookieId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array SchemaP NamedSwaggerDoc Value Value CookieId CookieId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
            )

--------------------------------------------------------------------------------
-- Cookies & Access Tokens

-- | A temporary API access token.
data AccessToken = AccessToken
  { AccessToken -> UserId
user :: UserId,
    -- | FUTUREWORK: must be valid UTF-8 (see ToJSON), encode that in the type!
    AccessToken -> LByteString
access :: LByteString,
    AccessToken -> TokenType
tokenType :: TokenType,
    AccessToken -> Integer
expiresIn :: Integer
  }
  deriving stock (AccessToken -> AccessToken -> Bool
(AccessToken -> AccessToken -> Bool)
-> (AccessToken -> AccessToken -> Bool) -> Eq AccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessToken -> AccessToken -> Bool
== :: AccessToken -> AccessToken -> Bool
$c/= :: AccessToken -> AccessToken -> Bool
/= :: AccessToken -> AccessToken -> Bool
Eq, Int -> AccessToken -> ShowS
[AccessToken] -> ShowS
AccessToken -> String
(Int -> AccessToken -> ShowS)
-> (AccessToken -> String)
-> ([AccessToken] -> ShowS)
-> Show AccessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessToken -> ShowS
showsPrec :: Int -> AccessToken -> ShowS
$cshow :: AccessToken -> String
show :: AccessToken -> String
$cshowList :: [AccessToken] -> ShowS
showList :: [AccessToken] -> ShowS
Show, (forall x. AccessToken -> Rep AccessToken x)
-> (forall x. Rep AccessToken x -> AccessToken)
-> Generic AccessToken
forall x. Rep AccessToken x -> AccessToken
forall x. AccessToken -> Rep AccessToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccessToken -> Rep AccessToken x
from :: forall x. AccessToken -> Rep AccessToken x
$cto :: forall x. Rep AccessToken x -> AccessToken
to :: forall x. Rep AccessToken x -> AccessToken
Generic)
  deriving (Value -> Parser [AccessToken]
Value -> Parser AccessToken
(Value -> Parser AccessToken)
-> (Value -> Parser [AccessToken]) -> FromJSON AccessToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser AccessToken
parseJSON :: Value -> Parser AccessToken
$cparseJSONList :: Value -> Parser [AccessToken]
parseJSONList :: Value -> Parser [AccessToken]
FromJSON, [AccessToken] -> Value
[AccessToken] -> Encoding
AccessToken -> Value
AccessToken -> Encoding
(AccessToken -> Value)
-> (AccessToken -> Encoding)
-> ([AccessToken] -> Value)
-> ([AccessToken] -> Encoding)
-> ToJSON AccessToken
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: AccessToken -> Value
toJSON :: AccessToken -> Value
$ctoEncoding :: AccessToken -> Encoding
toEncoding :: AccessToken -> Encoding
$ctoJSONList :: [AccessToken] -> Value
toJSONList :: [AccessToken] -> Value
$ctoEncodingList :: [AccessToken] -> Encoding
toEncodingList :: [AccessToken] -> Encoding
ToJSON, Typeable AccessToken
Typeable AccessToken =>
(Proxy AccessToken -> Declare (Definitions Schema) NamedSchema)
-> ToSchema AccessToken
Proxy AccessToken -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy AccessToken -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy AccessToken -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema AccessToken

instance ToSchema AccessToken where
  schema :: ValueSchema NamedSwaggerDoc AccessToken
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] AccessToken AccessToken
-> ValueSchema NamedSwaggerDoc AccessToken
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"AccessToken" (SchemaP SwaggerDoc Object [Pair] AccessToken AccessToken
 -> ValueSchema NamedSwaggerDoc AccessToken)
-> SchemaP SwaggerDoc Object [Pair] AccessToken AccessToken
-> ValueSchema NamedSwaggerDoc AccessToken
forall a b. (a -> b) -> a -> b
$
      UserId -> LByteString -> TokenType -> Integer -> AccessToken
AccessToken
        (UserId -> LByteString -> TokenType -> Integer -> AccessToken)
-> SchemaP SwaggerDoc Object [Pair] AccessToken UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AccessToken
     (LByteString -> TokenType -> Integer -> AccessToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccessToken -> UserId
user (AccessToken -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] AccessToken UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"user" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AccessToken
  (LByteString -> TokenType -> Integer -> AccessToken)
-> SchemaP SwaggerDoc Object [Pair] AccessToken LByteString
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     AccessToken
     (TokenType -> Integer -> AccessToken)
forall a b.
SchemaP SwaggerDoc Object [Pair] AccessToken (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AccessToken a
-> SchemaP SwaggerDoc Object [Pair] AccessToken b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        -- FUTUREWORK: if we assume it's valid UTF-8, why not make it 'Text'?
        AccessToken -> LByteString
access
          (AccessToken -> LByteString)
-> SchemaP SwaggerDoc Object [Pair] LByteString LByteString
-> SchemaP SwaggerDoc Object [Pair] AccessToken LByteString
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value LByteString LByteString
-> SchemaP SwaggerDoc Object [Pair] LByteString LByteString
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"access_token"
            ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The opaque access token string")
            ( ByteString -> LByteString
LBS.fromStrict (ByteString -> LByteString)
-> (Text -> ByteString) -> Text -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
                (Text -> LByteString)
-> SchemaP NamedSwaggerDoc Value Value LByteString Text
-> SchemaP NamedSwaggerDoc Value Value LByteString LByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (LByteString -> ByteString) -> LByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> ByteString
LBS.toStrict)
                  (LByteString -> Text)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP NamedSwaggerDoc Value Value LByteString Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
            )
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  AccessToken
  (TokenType -> Integer -> AccessToken)
-> SchemaP SwaggerDoc Object [Pair] AccessToken TokenType
-> SchemaP
     SwaggerDoc Object [Pair] AccessToken (Integer -> AccessToken)
forall a b.
SchemaP SwaggerDoc Object [Pair] AccessToken (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AccessToken a
-> SchemaP SwaggerDoc Object [Pair] AccessToken b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AccessToken -> TokenType
tokenType (AccessToken -> TokenType)
-> SchemaP SwaggerDoc Object [Pair] TokenType TokenType
-> SchemaP SwaggerDoc Object [Pair] AccessToken TokenType
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value TokenType TokenType
-> SchemaP SwaggerDoc Object [Pair] TokenType TokenType
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"token_type" SchemaP NamedSwaggerDoc Value Value TokenType TokenType
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] AccessToken (Integer -> AccessToken)
-> SchemaP SwaggerDoc Object [Pair] AccessToken Integer
-> SchemaP SwaggerDoc Object [Pair] AccessToken AccessToken
forall a b.
SchemaP SwaggerDoc Object [Pair] AccessToken (a -> b)
-> SchemaP SwaggerDoc Object [Pair] AccessToken a
-> SchemaP SwaggerDoc Object [Pair] AccessToken b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AccessToken -> Integer
expiresIn
          (AccessToken -> Integer)
-> SchemaP SwaggerDoc Object [Pair] Integer Integer
-> SchemaP SwaggerDoc Object [Pair] AccessToken Integer
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> SchemaP NamedSwaggerDoc Value Value Integer Integer
-> SchemaP SwaggerDoc Object [Pair] Integer Integer
forall doc' doc a b.
HasField doc' doc =>
Text
-> (doc' -> doc')
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a b
fieldWithDocModifier
            Text
"expires_in"
            ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"The number of seconds this token is valid")
            SchemaP NamedSwaggerDoc Value Value Integer Integer
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

bearerToken :: UserId -> LByteString -> Integer -> AccessToken
bearerToken :: UserId -> LByteString -> Integer -> AccessToken
bearerToken UserId
u LByteString
a = UserId -> LByteString -> TokenType -> Integer -> AccessToken
AccessToken UserId
u LByteString
a TokenType
Bearer

instance Arbitrary AccessToken where
  arbitrary :: Gen AccessToken
arbitrary =
    UserId -> LByteString -> TokenType -> Integer -> AccessToken
AccessToken
      (UserId -> LByteString -> TokenType -> Integer -> AccessToken)
-> Gen UserId
-> Gen (LByteString -> TokenType -> Integer -> AccessToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UserId
forall a. Arbitrary a => Gen a
arbitrary
      Gen (LByteString -> TokenType -> Integer -> AccessToken)
-> Gen LByteString -> Gen (TokenType -> Integer -> AccessToken)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> LByteString
LT.encodeUtf8 (Text -> LByteString) -> Gen Text -> Gen LByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary)
      Gen (TokenType -> Integer -> AccessToken)
-> Gen TokenType -> Gen (Integer -> AccessToken)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TokenType
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Integer -> AccessToken) -> Gen Integer -> Gen AccessToken
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

data TokenType = Bearer
  deriving stock (TokenType -> TokenType -> Bool
(TokenType -> TokenType -> Bool)
-> (TokenType -> TokenType -> Bool) -> Eq TokenType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenType -> TokenType -> Bool
== :: TokenType -> TokenType -> Bool
$c/= :: TokenType -> TokenType -> Bool
/= :: TokenType -> TokenType -> Bool
Eq, Int -> TokenType -> ShowS
[TokenType] -> ShowS
TokenType -> String
(Int -> TokenType -> ShowS)
-> (TokenType -> String)
-> ([TokenType] -> ShowS)
-> Show TokenType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenType -> ShowS
showsPrec :: Int -> TokenType -> ShowS
$cshow :: TokenType -> String
show :: TokenType -> String
$cshowList :: [TokenType] -> ShowS
showList :: [TokenType] -> ShowS
Show, (forall x. TokenType -> Rep TokenType x)
-> (forall x. Rep TokenType x -> TokenType) -> Generic TokenType
forall x. Rep TokenType x -> TokenType
forall x. TokenType -> Rep TokenType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TokenType -> Rep TokenType x
from :: forall x. TokenType -> Rep TokenType x
$cto :: forall x. Rep TokenType x -> TokenType
to :: forall x. Rep TokenType x -> TokenType
Generic)
  deriving (Gen TokenType
Gen TokenType -> (TokenType -> [TokenType]) -> Arbitrary TokenType
TokenType -> [TokenType]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen TokenType
arbitrary :: Gen TokenType
$cshrink :: TokenType -> [TokenType]
shrink :: TokenType -> [TokenType]
Arbitrary) via (GenericUniform TokenType)
  deriving (Value -> Parser [TokenType]
Value -> Parser TokenType
(Value -> Parser TokenType)
-> (Value -> Parser [TokenType]) -> FromJSON TokenType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser TokenType
parseJSON :: Value -> Parser TokenType
$cparseJSONList :: Value -> Parser [TokenType]
parseJSONList :: Value -> Parser [TokenType]
FromJSON, [TokenType] -> Value
[TokenType] -> Encoding
TokenType -> Value
TokenType -> Encoding
(TokenType -> Value)
-> (TokenType -> Encoding)
-> ([TokenType] -> Value)
-> ([TokenType] -> Encoding)
-> ToJSON TokenType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: TokenType -> Value
toJSON :: TokenType -> Value
$ctoEncoding :: TokenType -> Encoding
toEncoding :: TokenType -> Encoding
$ctoJSONList :: [TokenType] -> Value
toJSONList :: [TokenType] -> Value
$ctoEncodingList :: [TokenType] -> Encoding
toEncodingList :: [TokenType] -> Encoding
ToJSON, Typeable TokenType
Typeable TokenType =>
(Proxy TokenType -> Declare (Definitions Schema) NamedSchema)
-> ToSchema TokenType
Proxy TokenType -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy TokenType -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy TokenType -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema TokenType

instance ToSchema TokenType where
  schema :: SchemaP NamedSwaggerDoc Value Value TokenType TokenType
schema = forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"TokenType" (SchemaP [Value] Text (Alt Maybe Text) TokenType TokenType
 -> SchemaP NamedSwaggerDoc Value Value TokenType TokenType)
-> SchemaP [Value] Text (Alt Maybe Text) TokenType TokenType
-> SchemaP NamedSwaggerDoc Value Value TokenType TokenType
forall a b. (a -> b) -> a -> b
$ Text
-> TokenType
-> SchemaP [Value] Text (Alt Maybe Text) TokenType TokenType
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"Bearer" TokenType
Bearer

--------------------------------------------------------------------------------
-- Access

-- summary of types involved:
--
-- user tokens     SomeUserToken = Token User + Token LHUser
-- access tokens   SomeAccessToken = Token Access + Token LHAccess

-- session: Cookie (Token u) (used in DB)

-- cookie: UserTokenCookie

data AccessWithCookie c = Access
  { forall c. AccessWithCookie c -> AccessToken
accessToken :: !AccessToken,
    forall c. AccessWithCookie c -> Maybe c
accessCookie :: !(Maybe c)
  }
  deriving ((forall a b. (a -> b) -> AccessWithCookie a -> AccessWithCookie b)
-> (forall a b. a -> AccessWithCookie b -> AccessWithCookie a)
-> Functor AccessWithCookie
forall a b. a -> AccessWithCookie b -> AccessWithCookie a
forall a b. (a -> b) -> AccessWithCookie a -> AccessWithCookie b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AccessWithCookie a -> AccessWithCookie b
fmap :: forall a b. (a -> b) -> AccessWithCookie a -> AccessWithCookie b
$c<$ :: forall a b. a -> AccessWithCookie b -> AccessWithCookie a
<$ :: forall a b. a -> AccessWithCookie b -> AccessWithCookie a
Functor, (forall m. Monoid m => AccessWithCookie m -> m)
-> (forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m)
-> (forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m)
-> (forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b)
-> (forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b)
-> (forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b)
-> (forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b)
-> (forall a. (a -> a -> a) -> AccessWithCookie a -> a)
-> (forall a. (a -> a -> a) -> AccessWithCookie a -> a)
-> (forall a. AccessWithCookie a -> [a])
-> (forall a. AccessWithCookie a -> Bool)
-> (forall a. AccessWithCookie a -> Int)
-> (forall a. Eq a => a -> AccessWithCookie a -> Bool)
-> (forall a. Ord a => AccessWithCookie a -> a)
-> (forall a. Ord a => AccessWithCookie a -> a)
-> (forall a. Num a => AccessWithCookie a -> a)
-> (forall a. Num a => AccessWithCookie a -> a)
-> Foldable AccessWithCookie
forall a. Eq a => a -> AccessWithCookie a -> Bool
forall a. Num a => AccessWithCookie a -> a
forall a. Ord a => AccessWithCookie a -> a
forall m. Monoid m => AccessWithCookie m -> m
forall a. AccessWithCookie a -> Bool
forall a. AccessWithCookie a -> Int
forall a. AccessWithCookie a -> [a]
forall a. (a -> a -> a) -> AccessWithCookie a -> a
forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m
forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b
forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => AccessWithCookie m -> m
fold :: forall m. Monoid m => AccessWithCookie m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> AccessWithCookie a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AccessWithCookie a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> AccessWithCookie a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> AccessWithCookie a -> a
foldr1 :: forall a. (a -> a -> a) -> AccessWithCookie a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AccessWithCookie a -> a
foldl1 :: forall a. (a -> a -> a) -> AccessWithCookie a -> a
$ctoList :: forall a. AccessWithCookie a -> [a]
toList :: forall a. AccessWithCookie a -> [a]
$cnull :: forall a. AccessWithCookie a -> Bool
null :: forall a. AccessWithCookie a -> Bool
$clength :: forall a. AccessWithCookie a -> Int
length :: forall a. AccessWithCookie a -> Int
$celem :: forall a. Eq a => a -> AccessWithCookie a -> Bool
elem :: forall a. Eq a => a -> AccessWithCookie a -> Bool
$cmaximum :: forall a. Ord a => AccessWithCookie a -> a
maximum :: forall a. Ord a => AccessWithCookie a -> a
$cminimum :: forall a. Ord a => AccessWithCookie a -> a
minimum :: forall a. Ord a => AccessWithCookie a -> a
$csum :: forall a. Num a => AccessWithCookie a -> a
sum :: forall a. Num a => AccessWithCookie a -> a
$cproduct :: forall a. Num a => AccessWithCookie a -> a
product :: forall a. Num a => AccessWithCookie a -> a
Foldable, Functor AccessWithCookie
Foldable AccessWithCookie
(Functor AccessWithCookie, Foldable AccessWithCookie) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> AccessWithCookie a -> f (AccessWithCookie b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    AccessWithCookie (f a) -> f (AccessWithCookie a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AccessWithCookie a -> m (AccessWithCookie b))
-> (forall (m :: * -> *) a.
    Monad m =>
    AccessWithCookie (m a) -> m (AccessWithCookie a))
-> Traversable AccessWithCookie
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AccessWithCookie (m a) -> m (AccessWithCookie a)
forall (f :: * -> *) a.
Applicative f =>
AccessWithCookie (f a) -> f (AccessWithCookie a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AccessWithCookie a -> m (AccessWithCookie b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AccessWithCookie a -> f (AccessWithCookie b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AccessWithCookie a -> f (AccessWithCookie b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AccessWithCookie a -> f (AccessWithCookie b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
AccessWithCookie (f a) -> f (AccessWithCookie a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AccessWithCookie (f a) -> f (AccessWithCookie a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AccessWithCookie a -> m (AccessWithCookie b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AccessWithCookie a -> m (AccessWithCookie b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
AccessWithCookie (m a) -> m (AccessWithCookie a)
sequence :: forall (m :: * -> *) a.
Monad m =>
AccessWithCookie (m a) -> m (AccessWithCookie a)
Traversable)

type Access u = AccessWithCookie (Cookie (ZAuth.Token u))

type SomeAccess = AccessWithCookie UserTokenCookie

instance AsHeaders '[Maybe UserTokenCookie] AccessToken SomeAccess where
  toHeaders :: SomeAccess -> (NP I '[Maybe UserTokenCookie], AccessToken)
toHeaders (Access AccessToken
at Maybe UserTokenCookie
c) = (Maybe UserTokenCookie -> I (Maybe UserTokenCookie)
forall a. a -> I a
I Maybe UserTokenCookie
c I (Maybe UserTokenCookie)
-> NP I '[] -> NP I '[Maybe UserTokenCookie]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil, AccessToken
at)
  fromHeaders :: (NP I '[Maybe UserTokenCookie], AccessToken) -> SomeAccess
fromHeaders (I x
c :* NP I xs
Nil, AccessToken
at) = AccessToken -> Maybe UserTokenCookie -> SomeAccess
forall c. AccessToken -> Maybe c -> AccessWithCookie c
Access AccessToken
at x
Maybe UserTokenCookie
c

--------------------------------------------------------------------------------
-- Token sum types

data SomeUserToken
  = PlainUserToken (ZAuth.Token ZAuth.User)
  | LHUserToken (ZAuth.Token ZAuth.LegalHoldUser)
  deriving (Int -> SomeUserToken -> ShowS
[SomeUserToken] -> ShowS
SomeUserToken -> String
(Int -> SomeUserToken -> ShowS)
-> (SomeUserToken -> String)
-> ([SomeUserToken] -> ShowS)
-> Show SomeUserToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SomeUserToken -> ShowS
showsPrec :: Int -> SomeUserToken -> ShowS
$cshow :: SomeUserToken -> String
show :: SomeUserToken -> String
$cshowList :: [SomeUserToken] -> ShowS
showList :: [SomeUserToken] -> ShowS
Show)

instance FromHttpApiData SomeUserToken where
  parseHeader :: ByteString -> Either Text SomeUserToken
parseHeader ByteString
h =
    (String -> Text)
-> Either String SomeUserToken -> Either Text SomeUserToken
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String SomeUserToken -> Either Text SomeUserToken)
-> Either String SomeUserToken -> Either Text SomeUserToken
forall a b. (a -> b) -> a -> b
$
      (Token User -> SomeUserToken)
-> Either String (Token User) -> Either String SomeUserToken
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token User -> SomeUserToken
PlainUserToken (Parser (Token User) -> ByteString -> Either String (Token User)
forall a. Parser a -> ByteString -> Either String a
runParser Parser (Token User)
forall a. FromByteString a => Parser a
parser ByteString
h)
        Either String SomeUserToken
-> Either String SomeUserToken -> Either String SomeUserToken
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (Token LegalHoldUser -> SomeUserToken)
-> Either String (Token LegalHoldUser)
-> Either String SomeUserToken
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token LegalHoldUser -> SomeUserToken
LHUserToken (Parser (Token LegalHoldUser)
-> ByteString -> Either String (Token LegalHoldUser)
forall a. Parser a -> ByteString -> Either String a
runParser Parser (Token LegalHoldUser)
forall a. FromByteString a => Parser a
parser ByteString
h)
  parseUrlPiece :: Text -> Either Text SomeUserToken
parseUrlPiece = ByteString -> Either Text SomeUserToken
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text SomeUserToken)
-> (Text -> ByteString) -> Text -> Either Text SomeUserToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance FromByteString SomeUserToken where
  parser :: Parser SomeUserToken
parser =
    Token User -> SomeUserToken
PlainUserToken (Token User -> SomeUserToken)
-> Parser (Token User) -> Parser SomeUserToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Token User)
forall a. FromByteString a => Parser a
parser
      Parser SomeUserToken
-> Parser SomeUserToken -> Parser SomeUserToken
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token LegalHoldUser -> SomeUserToken
LHUserToken (Token LegalHoldUser -> SomeUserToken)
-> Parser (Token LegalHoldUser) -> Parser SomeUserToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Token LegalHoldUser)
forall a. FromByteString a => Parser a
parser

instance ToByteString SomeUserToken where
  builder :: SomeUserToken -> Builder
builder (PlainUserToken Token User
t) = Token User -> Builder
forall a. ToByteString a => a -> Builder
builder Token User
t
  builder (LHUserToken Token LegalHoldUser
t) = Token LegalHoldUser -> Builder
forall a. ToByteString a => a -> Builder
builder Token LegalHoldUser
t

data SomeAccessToken
  = PlainAccessToken (ZAuth.Token ZAuth.Access)
  | LHAccessToken (ZAuth.Token ZAuth.LegalHoldAccess)
  deriving (Int -> SomeAccessToken -> ShowS
[SomeAccessToken] -> ShowS
SomeAccessToken -> String
(Int -> SomeAccessToken -> ShowS)
-> (SomeAccessToken -> String)
-> ([SomeAccessToken] -> ShowS)
-> Show SomeAccessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SomeAccessToken -> ShowS
showsPrec :: Int -> SomeAccessToken -> ShowS
$cshow :: SomeAccessToken -> String
show :: SomeAccessToken -> String
$cshowList :: [SomeAccessToken] -> ShowS
showList :: [SomeAccessToken] -> ShowS
Show)

instance FromHttpApiData SomeAccessToken where
  parseHeader :: ByteString -> Either Text SomeAccessToken
parseHeader ByteString
h =
    (String -> Text)
-> Either String SomeAccessToken -> Either Text SomeAccessToken
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String SomeAccessToken -> Either Text SomeAccessToken)
-> Either String SomeAccessToken -> Either Text SomeAccessToken
forall a b. (a -> b) -> a -> b
$
      (Token Access -> SomeAccessToken)
-> Either String (Token Access) -> Either String SomeAccessToken
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token Access -> SomeAccessToken
PlainAccessToken (Parser (Token Access) -> ByteString -> Either String (Token Access)
forall a. Parser a -> ByteString -> Either String a
runParser Parser (Token Access)
forall a. FromByteString a => Parser a
parser ByteString
h)
        Either String SomeAccessToken
-> Either String SomeAccessToken -> Either String SomeAccessToken
forall a. Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (Token LegalHoldAccess -> SomeAccessToken)
-> Either String (Token LegalHoldAccess)
-> Either String SomeAccessToken
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token LegalHoldAccess -> SomeAccessToken
LHAccessToken (Parser (Token LegalHoldAccess)
-> ByteString -> Either String (Token LegalHoldAccess)
forall a. Parser a -> ByteString -> Either String a
runParser Parser (Token LegalHoldAccess)
forall a. FromByteString a => Parser a
parser ByteString
h)
  parseUrlPiece :: Text -> Either Text SomeAccessToken
parseUrlPiece = ByteString -> Either Text SomeAccessToken
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text SomeAccessToken)
-> (Text -> ByteString) -> Text -> Either Text SomeAccessToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | Data that is returned to the client in the form of a cookie containing a
-- user token.
data UserTokenCookie = UserTokenCookie
  { UserTokenCookie -> Maybe UTCTime
utcExpires :: Maybe UTCTime,
    UserTokenCookie -> SomeUserToken
utcToken :: SomeUserToken,
    UserTokenCookie -> Bool
utcSecure :: Bool
  }

utcFromSetCookie :: SetCookie -> Either Text UserTokenCookie
utcFromSetCookie :: SetCookie -> Either Text UserTokenCookie
utcFromSetCookie SetCookie
c = do
  SomeUserToken
v <- (String -> Text)
-> Either String SomeUserToken -> Either Text SomeUserToken
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String SomeUserToken -> Either Text SomeUserToken)
-> Either String SomeUserToken -> Either Text SomeUserToken
forall a b. (a -> b) -> a -> b
$ Parser SomeUserToken -> ByteString -> Either String SomeUserToken
forall a. Parser a -> ByteString -> Either String a
runParser Parser SomeUserToken
forall a. FromByteString a => Parser a
parser (SetCookie -> ByteString
setCookieValue SetCookie
c)
  UserTokenCookie -> Either Text UserTokenCookie
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    UserTokenCookie
      { $sel:utcToken:UserTokenCookie :: SomeUserToken
utcToken = SomeUserToken
v,
        $sel:utcExpires:UserTokenCookie :: Maybe UTCTime
utcExpires = SetCookie -> Maybe UTCTime
setCookieExpires SetCookie
c,
        $sel:utcSecure:UserTokenCookie :: Bool
utcSecure = SetCookie -> Bool
setCookieSecure SetCookie
c
      }

utcToSetCookie :: UserTokenCookie -> SetCookie
utcToSetCookie :: UserTokenCookie -> SetCookie
utcToSetCookie UserTokenCookie
c =
  SetCookie
forall a. Default a => a
def
    { setCookieName = "zuid",
      setCookieValue = toByteString' (utcToken c),
      setCookiePath = Just "/access",
      setCookieExpires = utcExpires c,
      setCookieSecure = utcSecure c,
      setCookieHttpOnly = True
    }

instance S.ToParamSchema UserTokenCookie where
  toParamSchema :: Proxy UserTokenCookie -> Schema
toParamSchema Proxy UserTokenCookie
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString

instance FromHttpApiData UserTokenCookie where
  parseHeader :: ByteString -> Either Text UserTokenCookie
parseHeader = SetCookie -> Either Text UserTokenCookie
utcFromSetCookie (SetCookie -> Either Text UserTokenCookie)
-> (ByteString -> SetCookie)
-> ByteString
-> Either Text UserTokenCookie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SetCookie
parseSetCookie
  parseUrlPiece :: Text -> Either Text UserTokenCookie
parseUrlPiece = ByteString -> Either Text UserTokenCookie
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text UserTokenCookie)
-> (Text -> ByteString) -> Text -> Either Text UserTokenCookie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance ToHttpApiData UserTokenCookie where
  toHeader :: UserTokenCookie -> ByteString
toHeader =
    LByteString -> ByteString
LBS.toStrict
      (LByteString -> ByteString)
-> (UserTokenCookie -> LByteString)
-> UserTokenCookie
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LByteString
toLazyByteString
      (Builder -> LByteString)
-> (UserTokenCookie -> Builder) -> UserTokenCookie -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetCookie -> Builder
renderSetCookie
      (SetCookie -> Builder)
-> (UserTokenCookie -> SetCookie) -> UserTokenCookie -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserTokenCookie -> SetCookie
utcToSetCookie
  toUrlPiece :: UserTokenCookie -> Text
toUrlPiece = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (UserTokenCookie -> ByteString) -> UserTokenCookie -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserTokenCookie -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader

--------------------------------------------------------------------------------
-- Provider

data ProviderToken = ProviderToken (ZAuth.Token ZAuth.Provider)
  deriving (Int -> ProviderToken -> ShowS
[ProviderToken] -> ShowS
ProviderToken -> String
(Int -> ProviderToken -> ShowS)
-> (ProviderToken -> String)
-> ([ProviderToken] -> ShowS)
-> Show ProviderToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProviderToken -> ShowS
showsPrec :: Int -> ProviderToken -> ShowS
$cshow :: ProviderToken -> String
show :: ProviderToken -> String
$cshowList :: [ProviderToken] -> ShowS
showList :: [ProviderToken] -> ShowS
Show)

instance FromByteString ProviderToken where
  parser :: Parser ProviderToken
parser = Token Provider -> ProviderToken
ProviderToken (Token Provider -> ProviderToken)
-> Parser ByteString (Token Provider) -> Parser ProviderToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Token Provider)
forall a. FromByteString a => Parser a
parser

data ProviderTokenCookie = ProviderTokenCookie
  { ProviderTokenCookie -> ProviderToken
ptcToken :: ProviderToken,
    ProviderTokenCookie -> Bool
ptcSecure :: Bool
  }

instance FromHttpApiData ProviderTokenCookie where
  parseHeader :: ByteString -> Either Text ProviderTokenCookie
parseHeader = SetCookie -> Either Text ProviderTokenCookie
ptcFromSetCookie (SetCookie -> Either Text ProviderTokenCookie)
-> (ByteString -> SetCookie)
-> ByteString
-> Either Text ProviderTokenCookie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SetCookie
parseSetCookie
  parseUrlPiece :: Text -> Either Text ProviderTokenCookie
parseUrlPiece = ByteString -> Either Text ProviderTokenCookie
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text ProviderTokenCookie)
-> (Text -> ByteString) -> Text -> Either Text ProviderTokenCookie
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

ptcFromSetCookie :: SetCookie -> Either Text ProviderTokenCookie
ptcFromSetCookie :: SetCookie -> Either Text ProviderTokenCookie
ptcFromSetCookie SetCookie
c = do
  ProviderToken
v <- (String -> Text)
-> Either String ProviderToken -> Either Text ProviderToken
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String ProviderToken -> Either Text ProviderToken)
-> Either String ProviderToken -> Either Text ProviderToken
forall a b. (a -> b) -> a -> b
$ Parser ProviderToken -> ByteString -> Either String ProviderToken
forall a. Parser a -> ByteString -> Either String a
runParser Parser ProviderToken
forall a. FromByteString a => Parser a
parser (SetCookie -> ByteString
setCookieValue SetCookie
c)
  ProviderTokenCookie -> Either Text ProviderTokenCookie
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ProviderTokenCookie
      { $sel:ptcToken:ProviderTokenCookie :: ProviderToken
ptcToken = ProviderToken
v,
        $sel:ptcSecure:ProviderTokenCookie :: Bool
ptcSecure = SetCookie -> Bool
setCookieSecure SetCookie
c
      }

instance ToHttpApiData ProviderTokenCookie where
  toHeader :: ProviderTokenCookie -> ByteString
toHeader =
    LByteString -> ByteString
LBS.toStrict
      (LByteString -> ByteString)
-> (ProviderTokenCookie -> LByteString)
-> ProviderTokenCookie
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LByteString
toLazyByteString
      (Builder -> LByteString)
-> (ProviderTokenCookie -> Builder)
-> ProviderTokenCookie
-> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetCookie -> Builder
renderSetCookie
      (SetCookie -> Builder)
-> (ProviderTokenCookie -> SetCookie)
-> ProviderTokenCookie
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProviderTokenCookie -> SetCookie
ptcToSetCookie
  toUrlPiece :: ProviderTokenCookie -> Text
toUrlPiece = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ProviderTokenCookie -> ByteString)
-> ProviderTokenCookie
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProviderTokenCookie -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toHeader

ptcToSetCookie :: ProviderTokenCookie -> SetCookie
ptcToSetCookie :: ProviderTokenCookie -> SetCookie
ptcToSetCookie ProviderTokenCookie
c =
  SetCookie
forall a. Default a => a
def
    { setCookieName = "zprovider",
      setCookieValue = toByteString' (providerToken (ptcToken c)),
      setCookiePath = Just "/provider",
      setCookieExpires = Just (tokenExpiresUTC (providerToken (ptcToken c))),
      setCookieSecure = ptcSecure c,
      setCookieHttpOnly = True
    }
  where
    providerToken :: ProviderToken -> ZAuth.Token ZAuth.Provider
    providerToken :: ProviderToken -> Token Provider
providerToken (ProviderToken Token Provider
t) = Token Provider
t

    tokenExpiresUTC :: ZAuth.Token a -> UTCTime
    tokenExpiresUTC :: forall a. Token a -> UTCTime
tokenExpiresUTC Token a
t = POSIXTime -> UTCTime
posixSecondsToUTCTime (Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Token a
t Token a -> Getting Integer (Token a) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. (Header -> Const Integer Header)
-> Token a -> Const Integer (Token a)
forall a (f :: * -> *).
(Contravariant f, Functor f) =>
(Header -> f Header) -> Token a -> f (Token a)
header ((Header -> Const Integer Header)
 -> Token a -> Const Integer (Token a))
-> ((Integer -> Const Integer Integer)
    -> Header -> Const Integer Header)
-> Getting Integer (Token a) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const Integer Integer)
-> Header -> Const Integer Header
Lens' Header Integer
time))

instance S.ToParamSchema ProviderTokenCookie where
  toParamSchema :: Proxy ProviderTokenCookie -> Schema
toParamSchema Proxy ProviderTokenCookie
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString

--------------------------------------------------------------------------------
-- Servant

type TokenResponse =
  WithHeaders
    '[OptHeader (Header "Set-Cookie" UserTokenCookie)]
    SomeAccess
    (Respond 200 "OK" AccessToken)