{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

module OryKratos.Types
  ( CompleteSelfServiceLoginFlowWithPasswordMethod (..),
    CompleteSelfServiceRecoveryFlowWithLinkMethod (..),
    CompleteSelfServiceSettingsFlowWithPasswordMethod (..),
    CompleteSelfServiceVerificationFlowWithLinkMethod (..),
    CreateIdentity (..),
    CreateRecoveryLink (..),
    ErrorContainer (..),
    FormField (..),
    GenericError (..),
    GenericErrorPayload (..),
    HealthNotReadyStatus (..),
    HealthStatus (..),
    Identity (..),
    LoginFlow (..),
    LoginFlowMethod (..),
    LoginFlowMethodConfig (..),
    LoginViaApiResponse (..),
    Message (..),
    RecoveryAddress (..),
    RecoveryFlow (..),
    RecoveryFlowMethod (..),
    RecoveryFlowMethodConfig (..),
    RecoveryLink (..),
    RegistrationFlow (..),
    RegistrationFlowMethod (..),
    RegistrationFlowMethodConfig (..),
    RegistrationViaApiResponse (..),
    RevokeSession (..),
    Session (..),
    SettingsFlow (..),
    SettingsFlowMethod (..),
    SettingsFlowMethodConfig (..),
    SettingsViaApiResponse (..),
    UpdateIdentity (..),
    VerifiableAddress (..),
    VerificationFlow (..),
    VerificationFlowMethod (..),
    VerificationFlowMethodConfig (..),
    Version (..),
  )
where

import Data.Aeson (FromJSON (..), ToJSON (..), Value, genericParseJSON, genericToEncoding, genericToJSON)
import Data.Aeson.Types (Options (..), defaultOptions)
import qualified Data.Char as Char
import Data.Data (Data)
import Data.Function ((&))
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Swagger (ToSchema, declareNamedSchema)
import qualified Data.Swagger as Swagger
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import Data.UUID (UUID)
import GHC.Generics (Generic)

typeFieldRename :: String -> String
typeFieldRename :: String -> String
typeFieldRename String
"_type" = String
"type"
typeFieldRename String
x = String
x

-- |
data CompleteSelfServiceLoginFlowWithPasswordMethod = CompleteSelfServiceLoginFlowWithPasswordMethod
  { -- | Sending the anti-csrf token is only required for browser login flows.
    CompleteSelfServiceLoginFlowWithPasswordMethod -> Maybe Text
csrf_token :: Maybe Text,
    -- | Identifier is the email or username of the user trying to log in.
    CompleteSelfServiceLoginFlowWithPasswordMethod -> Maybe Text
identifier :: Maybe Text,
    -- | The user's password.
    CompleteSelfServiceLoginFlowWithPasswordMethod -> Maybe Text
password :: Maybe Text
  }
  deriving stock (Int
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> String
-> String
[CompleteSelfServiceLoginFlowWithPasswordMethod]
-> String -> String
CompleteSelfServiceLoginFlowWithPasswordMethod -> String
(Int
 -> CompleteSelfServiceLoginFlowWithPasswordMethod
 -> String
 -> String)
-> (CompleteSelfServiceLoginFlowWithPasswordMethod -> String)
-> ([CompleteSelfServiceLoginFlowWithPasswordMethod]
    -> String -> String)
-> Show CompleteSelfServiceLoginFlowWithPasswordMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CompleteSelfServiceLoginFlowWithPasswordMethod]
-> String -> String
$cshowList :: [CompleteSelfServiceLoginFlowWithPasswordMethod]
-> String -> String
show :: CompleteSelfServiceLoginFlowWithPasswordMethod -> String
$cshow :: CompleteSelfServiceLoginFlowWithPasswordMethod -> String
showsPrec :: Int
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> String
-> String
$cshowsPrec :: Int
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> String
-> String
Show, CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool
(CompleteSelfServiceLoginFlowWithPasswordMethod
 -> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool)
-> (CompleteSelfServiceLoginFlowWithPasswordMethod
    -> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool)
-> Eq CompleteSelfServiceLoginFlowWithPasswordMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool
$c/= :: CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool
== :: CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool
$c== :: CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> Bool
Eq, (forall x.
 CompleteSelfServiceLoginFlowWithPasswordMethod
 -> Rep CompleteSelfServiceLoginFlowWithPasswordMethod x)
-> (forall x.
    Rep CompleteSelfServiceLoginFlowWithPasswordMethod x
    -> CompleteSelfServiceLoginFlowWithPasswordMethod)
-> Generic CompleteSelfServiceLoginFlowWithPasswordMethod
forall x.
Rep CompleteSelfServiceLoginFlowWithPasswordMethod x
-> CompleteSelfServiceLoginFlowWithPasswordMethod
forall x.
CompleteSelfServiceLoginFlowWithPasswordMethod
-> Rep CompleteSelfServiceLoginFlowWithPasswordMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CompleteSelfServiceLoginFlowWithPasswordMethod x
-> CompleteSelfServiceLoginFlowWithPasswordMethod
$cfrom :: forall x.
CompleteSelfServiceLoginFlowWithPasswordMethod
-> Rep CompleteSelfServiceLoginFlowWithPasswordMethod x
Generic, Typeable CompleteSelfServiceLoginFlowWithPasswordMethod
DataType
Constr
Typeable CompleteSelfServiceLoginFlowWithPasswordMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> c CompleteSelfServiceLoginFlowWithPasswordMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CompleteSelfServiceLoginFlowWithPasswordMethod)
-> (CompleteSelfServiceLoginFlowWithPasswordMethod -> Constr)
-> (CompleteSelfServiceLoginFlowWithPasswordMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod))
-> ((forall b. Data b => b -> b)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> CompleteSelfServiceLoginFlowWithPasswordMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> m CompleteSelfServiceLoginFlowWithPasswordMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> m CompleteSelfServiceLoginFlowWithPasswordMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> m CompleteSelfServiceLoginFlowWithPasswordMethod)
-> Data CompleteSelfServiceLoginFlowWithPasswordMethod
CompleteSelfServiceLoginFlowWithPasswordMethod -> DataType
CompleteSelfServiceLoginFlowWithPasswordMethod -> Constr
(forall b. Data b => b -> b)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> u
forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod)
$cCompleteSelfServiceLoginFlowWithPasswordMethod :: Constr
$tCompleteSelfServiceLoginFlowWithPasswordMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
gmapMp :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
gmapM :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m CompleteSelfServiceLoginFlowWithPasswordMethod
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> u
gmapQ :: (forall d. Data d => d -> u)
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod
$cgmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> CompleteSelfServiceLoginFlowWithPasswordMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceLoginFlowWithPasswordMethod)
dataTypeOf :: CompleteSelfServiceLoginFlowWithPasswordMethod -> DataType
$cdataTypeOf :: CompleteSelfServiceLoginFlowWithPasswordMethod -> DataType
toConstr :: CompleteSelfServiceLoginFlowWithPasswordMethod -> Constr
$ctoConstr :: CompleteSelfServiceLoginFlowWithPasswordMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> c CompleteSelfServiceLoginFlowWithPasswordMethod
$cp1Data :: Typeable CompleteSelfServiceLoginFlowWithPasswordMethod
Data)

instance FromJSON CompleteSelfServiceLoginFlowWithPasswordMethod

instance ToJSON CompleteSelfServiceLoginFlowWithPasswordMethod where
  toEncoding :: CompleteSelfServiceLoginFlowWithPasswordMethod -> Encoding
toEncoding = Options
-> CompleteSelfServiceLoginFlowWithPasswordMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data CompleteSelfServiceRecoveryFlowWithLinkMethod = CompleteSelfServiceRecoveryFlowWithLinkMethod
  { -- | Sending the anti-csrf token is only required for browser login flows.
    CompleteSelfServiceRecoveryFlowWithLinkMethod -> Maybe Text
csrf_token :: Maybe Text,
    -- | Email to Recover  Needs to be set when initiating the flow. If the email is a registered recovery email, a recovery link will be sent. If the email is not known, a email with details on what happened will be sent instead.  format: email in: body
    CompleteSelfServiceRecoveryFlowWithLinkMethod -> Maybe Text
email :: Maybe Text
  }
  deriving stock (Int
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> String
-> String
[CompleteSelfServiceRecoveryFlowWithLinkMethod] -> String -> String
CompleteSelfServiceRecoveryFlowWithLinkMethod -> String
(Int
 -> CompleteSelfServiceRecoveryFlowWithLinkMethod
 -> String
 -> String)
-> (CompleteSelfServiceRecoveryFlowWithLinkMethod -> String)
-> ([CompleteSelfServiceRecoveryFlowWithLinkMethod]
    -> String -> String)
-> Show CompleteSelfServiceRecoveryFlowWithLinkMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CompleteSelfServiceRecoveryFlowWithLinkMethod] -> String -> String
$cshowList :: [CompleteSelfServiceRecoveryFlowWithLinkMethod] -> String -> String
show :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> String
$cshow :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> String
showsPrec :: Int
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> String
-> String
$cshowsPrec :: Int
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> String
-> String
Show, CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool
(CompleteSelfServiceRecoveryFlowWithLinkMethod
 -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool)
-> (CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool)
-> Eq CompleteSelfServiceRecoveryFlowWithLinkMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool
$c/= :: CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool
== :: CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool
$c== :: CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Bool
Eq, (forall x.
 CompleteSelfServiceRecoveryFlowWithLinkMethod
 -> Rep CompleteSelfServiceRecoveryFlowWithLinkMethod x)
-> (forall x.
    Rep CompleteSelfServiceRecoveryFlowWithLinkMethod x
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> Generic CompleteSelfServiceRecoveryFlowWithLinkMethod
forall x.
Rep CompleteSelfServiceRecoveryFlowWithLinkMethod x
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
forall x.
CompleteSelfServiceRecoveryFlowWithLinkMethod
-> Rep CompleteSelfServiceRecoveryFlowWithLinkMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CompleteSelfServiceRecoveryFlowWithLinkMethod x
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
$cfrom :: forall x.
CompleteSelfServiceRecoveryFlowWithLinkMethod
-> Rep CompleteSelfServiceRecoveryFlowWithLinkMethod x
Generic, Typeable CompleteSelfServiceRecoveryFlowWithLinkMethod
DataType
Constr
Typeable CompleteSelfServiceRecoveryFlowWithLinkMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> c CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> (CompleteSelfServiceRecoveryFlowWithLinkMethod -> Constr)
-> (CompleteSelfServiceRecoveryFlowWithLinkMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod))
-> ((forall b. Data b => b -> b)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> m CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> m CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> m CompleteSelfServiceRecoveryFlowWithLinkMethod)
-> Data CompleteSelfServiceRecoveryFlowWithLinkMethod
CompleteSelfServiceRecoveryFlowWithLinkMethod -> DataType
CompleteSelfServiceRecoveryFlowWithLinkMethod -> Constr
(forall b. Data b => b -> b)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> u
forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod)
$cCompleteSelfServiceRecoveryFlowWithLinkMethod :: Constr
$tCompleteSelfServiceRecoveryFlowWithLinkMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
gmapMp :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
gmapM :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m CompleteSelfServiceRecoveryFlowWithLinkMethod
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> u
gmapQ :: (forall d. Data d => d -> u)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
$cgmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceRecoveryFlowWithLinkMethod)
dataTypeOf :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> DataType
$cdataTypeOf :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> DataType
toConstr :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> Constr
$ctoConstr :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> c CompleteSelfServiceRecoveryFlowWithLinkMethod
$cp1Data :: Typeable CompleteSelfServiceRecoveryFlowWithLinkMethod
Data)

instance FromJSON CompleteSelfServiceRecoveryFlowWithLinkMethod

instance ToJSON CompleteSelfServiceRecoveryFlowWithLinkMethod where
  toEncoding :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> Encoding
toEncoding = Options
-> CompleteSelfServiceRecoveryFlowWithLinkMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data CompleteSelfServiceSettingsFlowWithPasswordMethod = CompleteSelfServiceSettingsFlowWithPasswordMethod
  { -- | CSRFToken is the anti-CSRF token  type: string
    CompleteSelfServiceSettingsFlowWithPasswordMethod -> Maybe Text
csrf_token :: Maybe Text,
    -- | Password is the updated password  type: string
    CompleteSelfServiceSettingsFlowWithPasswordMethod -> Text
password :: Text
  }
  deriving stock (Int
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> String
-> String
[CompleteSelfServiceSettingsFlowWithPasswordMethod]
-> String -> String
CompleteSelfServiceSettingsFlowWithPasswordMethod -> String
(Int
 -> CompleteSelfServiceSettingsFlowWithPasswordMethod
 -> String
 -> String)
-> (CompleteSelfServiceSettingsFlowWithPasswordMethod -> String)
-> ([CompleteSelfServiceSettingsFlowWithPasswordMethod]
    -> String -> String)
-> Show CompleteSelfServiceSettingsFlowWithPasswordMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CompleteSelfServiceSettingsFlowWithPasswordMethod]
-> String -> String
$cshowList :: [CompleteSelfServiceSettingsFlowWithPasswordMethod]
-> String -> String
show :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> String
$cshow :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> String
showsPrec :: Int
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> String
-> String
$cshowsPrec :: Int
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> String
-> String
Show, CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool
(CompleteSelfServiceSettingsFlowWithPasswordMethod
 -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool)
-> (CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool)
-> Eq CompleteSelfServiceSettingsFlowWithPasswordMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool
$c/= :: CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool
== :: CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool
$c== :: CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Bool
Eq, (forall x.
 CompleteSelfServiceSettingsFlowWithPasswordMethod
 -> Rep CompleteSelfServiceSettingsFlowWithPasswordMethod x)
-> (forall x.
    Rep CompleteSelfServiceSettingsFlowWithPasswordMethod x
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> Generic CompleteSelfServiceSettingsFlowWithPasswordMethod
forall x.
Rep CompleteSelfServiceSettingsFlowWithPasswordMethod x
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
forall x.
CompleteSelfServiceSettingsFlowWithPasswordMethod
-> Rep CompleteSelfServiceSettingsFlowWithPasswordMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CompleteSelfServiceSettingsFlowWithPasswordMethod x
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
$cfrom :: forall x.
CompleteSelfServiceSettingsFlowWithPasswordMethod
-> Rep CompleteSelfServiceSettingsFlowWithPasswordMethod x
Generic, Typeable CompleteSelfServiceSettingsFlowWithPasswordMethod
DataType
Constr
Typeable CompleteSelfServiceSettingsFlowWithPasswordMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> c CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> (CompleteSelfServiceSettingsFlowWithPasswordMethod -> Constr)
-> (CompleteSelfServiceSettingsFlowWithPasswordMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod))
-> ((forall b. Data b => b -> b)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> m CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> m CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> m CompleteSelfServiceSettingsFlowWithPasswordMethod)
-> Data CompleteSelfServiceSettingsFlowWithPasswordMethod
CompleteSelfServiceSettingsFlowWithPasswordMethod -> DataType
CompleteSelfServiceSettingsFlowWithPasswordMethod -> Constr
(forall b. Data b => b -> b)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> u
forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod)
$cCompleteSelfServiceSettingsFlowWithPasswordMethod :: Constr
$tCompleteSelfServiceSettingsFlowWithPasswordMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
gmapMp :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
gmapM :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m CompleteSelfServiceSettingsFlowWithPasswordMethod
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> u
gmapQ :: (forall d. Data d => d -> u)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
$cgmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceSettingsFlowWithPasswordMethod)
dataTypeOf :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> DataType
$cdataTypeOf :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> DataType
toConstr :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> Constr
$ctoConstr :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> c CompleteSelfServiceSettingsFlowWithPasswordMethod
$cp1Data :: Typeable CompleteSelfServiceSettingsFlowWithPasswordMethod
Data)

instance FromJSON CompleteSelfServiceSettingsFlowWithPasswordMethod

instance ToJSON CompleteSelfServiceSettingsFlowWithPasswordMethod where
  toEncoding :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> Encoding
toEncoding = Options
-> CompleteSelfServiceSettingsFlowWithPasswordMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data CompleteSelfServiceVerificationFlowWithLinkMethod = CompleteSelfServiceVerificationFlowWithLinkMethod
  { -- | Sending the anti-csrf token is only required for browser login flows.
    CompleteSelfServiceVerificationFlowWithLinkMethod -> Maybe Text
csrf_token :: Maybe Text,
    -- | Email to Verify  Needs to be set when initiating the flow. If the email is a registered verification email, a verification link will be sent. If the email is not known, a email with details on what happened will be sent instead.  format: email in: body
    CompleteSelfServiceVerificationFlowWithLinkMethod -> Maybe Text
email :: Maybe Text
  }
  deriving stock (Int
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> String
-> String
[CompleteSelfServiceVerificationFlowWithLinkMethod]
-> String -> String
CompleteSelfServiceVerificationFlowWithLinkMethod -> String
(Int
 -> CompleteSelfServiceVerificationFlowWithLinkMethod
 -> String
 -> String)
-> (CompleteSelfServiceVerificationFlowWithLinkMethod -> String)
-> ([CompleteSelfServiceVerificationFlowWithLinkMethod]
    -> String -> String)
-> Show CompleteSelfServiceVerificationFlowWithLinkMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CompleteSelfServiceVerificationFlowWithLinkMethod]
-> String -> String
$cshowList :: [CompleteSelfServiceVerificationFlowWithLinkMethod]
-> String -> String
show :: CompleteSelfServiceVerificationFlowWithLinkMethod -> String
$cshow :: CompleteSelfServiceVerificationFlowWithLinkMethod -> String
showsPrec :: Int
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> String
-> String
$cshowsPrec :: Int
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> String
-> String
Show, CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool
(CompleteSelfServiceVerificationFlowWithLinkMethod
 -> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool)
-> (CompleteSelfServiceVerificationFlowWithLinkMethod
    -> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool)
-> Eq CompleteSelfServiceVerificationFlowWithLinkMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool
$c/= :: CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool
== :: CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool
$c== :: CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> Bool
Eq, (forall x.
 CompleteSelfServiceVerificationFlowWithLinkMethod
 -> Rep CompleteSelfServiceVerificationFlowWithLinkMethod x)
-> (forall x.
    Rep CompleteSelfServiceVerificationFlowWithLinkMethod x
    -> CompleteSelfServiceVerificationFlowWithLinkMethod)
-> Generic CompleteSelfServiceVerificationFlowWithLinkMethod
forall x.
Rep CompleteSelfServiceVerificationFlowWithLinkMethod x
-> CompleteSelfServiceVerificationFlowWithLinkMethod
forall x.
CompleteSelfServiceVerificationFlowWithLinkMethod
-> Rep CompleteSelfServiceVerificationFlowWithLinkMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CompleteSelfServiceVerificationFlowWithLinkMethod x
-> CompleteSelfServiceVerificationFlowWithLinkMethod
$cfrom :: forall x.
CompleteSelfServiceVerificationFlowWithLinkMethod
-> Rep CompleteSelfServiceVerificationFlowWithLinkMethod x
Generic, Typeable CompleteSelfServiceVerificationFlowWithLinkMethod
DataType
Constr
Typeable CompleteSelfServiceVerificationFlowWithLinkMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> c CompleteSelfServiceVerificationFlowWithLinkMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c CompleteSelfServiceVerificationFlowWithLinkMethod)
-> (CompleteSelfServiceVerificationFlowWithLinkMethod -> Constr)
-> (CompleteSelfServiceVerificationFlowWithLinkMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod))
-> ((forall b. Data b => b -> b)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> CompleteSelfServiceVerificationFlowWithLinkMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> m CompleteSelfServiceVerificationFlowWithLinkMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> m CompleteSelfServiceVerificationFlowWithLinkMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> m CompleteSelfServiceVerificationFlowWithLinkMethod)
-> Data CompleteSelfServiceVerificationFlowWithLinkMethod
CompleteSelfServiceVerificationFlowWithLinkMethod -> DataType
CompleteSelfServiceVerificationFlowWithLinkMethod -> Constr
(forall b. Data b => b -> b)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> u
forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod)
$cCompleteSelfServiceVerificationFlowWithLinkMethod :: Constr
$tCompleteSelfServiceVerificationFlowWithLinkMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
gmapMp :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
gmapM :: (forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m CompleteSelfServiceVerificationFlowWithLinkMethod
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> u
gmapQ :: (forall d. Data d => d -> u)
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod
$cgmapT :: (forall b. Data b => b -> b)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> CompleteSelfServiceVerificationFlowWithLinkMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c CompleteSelfServiceVerificationFlowWithLinkMethod)
dataTypeOf :: CompleteSelfServiceVerificationFlowWithLinkMethod -> DataType
$cdataTypeOf :: CompleteSelfServiceVerificationFlowWithLinkMethod -> DataType
toConstr :: CompleteSelfServiceVerificationFlowWithLinkMethod -> Constr
$ctoConstr :: CompleteSelfServiceVerificationFlowWithLinkMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> c CompleteSelfServiceVerificationFlowWithLinkMethod
$cp1Data :: Typeable CompleteSelfServiceVerificationFlowWithLinkMethod
Data)

instance FromJSON CompleteSelfServiceVerificationFlowWithLinkMethod

instance ToJSON CompleteSelfServiceVerificationFlowWithLinkMethod where
  toEncoding :: CompleteSelfServiceVerificationFlowWithLinkMethod -> Encoding
toEncoding = Options
-> CompleteSelfServiceVerificationFlowWithLinkMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data CreateIdentity = CreateIdentity
  { -- | SchemaID is the ID of the JSON Schema to be used for validating the identity's traits.
    CreateIdentity -> Text
schema_id :: Text,
    -- | Traits represent an identity's traits. The identity is able to create, modify, and delete traits in a self-service manner. The input will always be validated against the JSON Schema defined in `schema_url`.
    CreateIdentity -> Value
traits :: Value
  }
  deriving stock (Int -> CreateIdentity -> String -> String
[CreateIdentity] -> String -> String
CreateIdentity -> String
(Int -> CreateIdentity -> String -> String)
-> (CreateIdentity -> String)
-> ([CreateIdentity] -> String -> String)
-> Show CreateIdentity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CreateIdentity] -> String -> String
$cshowList :: [CreateIdentity] -> String -> String
show :: CreateIdentity -> String
$cshow :: CreateIdentity -> String
showsPrec :: Int -> CreateIdentity -> String -> String
$cshowsPrec :: Int -> CreateIdentity -> String -> String
Show, CreateIdentity -> CreateIdentity -> Bool
(CreateIdentity -> CreateIdentity -> Bool)
-> (CreateIdentity -> CreateIdentity -> Bool) -> Eq CreateIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIdentity -> CreateIdentity -> Bool
$c/= :: CreateIdentity -> CreateIdentity -> Bool
== :: CreateIdentity -> CreateIdentity -> Bool
$c== :: CreateIdentity -> CreateIdentity -> Bool
Eq, (forall x. CreateIdentity -> Rep CreateIdentity x)
-> (forall x. Rep CreateIdentity x -> CreateIdentity)
-> Generic CreateIdentity
forall x. Rep CreateIdentity x -> CreateIdentity
forall x. CreateIdentity -> Rep CreateIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIdentity x -> CreateIdentity
$cfrom :: forall x. CreateIdentity -> Rep CreateIdentity x
Generic, Typeable CreateIdentity
DataType
Constr
Typeable CreateIdentity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CreateIdentity -> c CreateIdentity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateIdentity)
-> (CreateIdentity -> Constr)
-> (CreateIdentity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateIdentity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateIdentity))
-> ((forall b. Data b => b -> b)
    -> CreateIdentity -> CreateIdentity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateIdentity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateIdentity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateIdentity -> m CreateIdentity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateIdentity -> m CreateIdentity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateIdentity -> m CreateIdentity)
-> Data CreateIdentity
CreateIdentity -> DataType
CreateIdentity -> Constr
(forall b. Data b => b -> b) -> CreateIdentity -> CreateIdentity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateIdentity -> c CreateIdentity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateIdentity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateIdentity -> u
forall u. (forall d. Data d => d -> u) -> CreateIdentity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateIdentity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateIdentity -> c CreateIdentity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateIdentity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateIdentity)
$cCreateIdentity :: Constr
$tCreateIdentity :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
gmapMp :: (forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
gmapM :: (forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateIdentity -> m CreateIdentity
gmapQi :: Int -> (forall d. Data d => d -> u) -> CreateIdentity -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateIdentity -> u
gmapQ :: (forall d. Data d => d -> u) -> CreateIdentity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CreateIdentity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateIdentity -> r
gmapT :: (forall b. Data b => b -> b) -> CreateIdentity -> CreateIdentity
$cgmapT :: (forall b. Data b => b -> b) -> CreateIdentity -> CreateIdentity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateIdentity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateIdentity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CreateIdentity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateIdentity)
dataTypeOf :: CreateIdentity -> DataType
$cdataTypeOf :: CreateIdentity -> DataType
toConstr :: CreateIdentity -> Constr
$ctoConstr :: CreateIdentity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateIdentity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateIdentity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateIdentity -> c CreateIdentity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateIdentity -> c CreateIdentity
$cp1Data :: Typeable CreateIdentity
Data)

instance FromJSON CreateIdentity

instance ToJSON CreateIdentity where
  toEncoding :: CreateIdentity -> Encoding
toEncoding = Options -> CreateIdentity -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data CreateRecoveryLink = CreateRecoveryLink
  { -- | Link Expires In  The recovery link will expire at that point in time. Defaults to the configuration value of `selfservice.flows.recovery.request_lifespan`.
    CreateRecoveryLink -> Maybe Text
expires_in :: Maybe Text,
    -- |
    CreateRecoveryLink -> Text
identity_id :: Text
  }
  deriving stock (Int -> CreateRecoveryLink -> String -> String
[CreateRecoveryLink] -> String -> String
CreateRecoveryLink -> String
(Int -> CreateRecoveryLink -> String -> String)
-> (CreateRecoveryLink -> String)
-> ([CreateRecoveryLink] -> String -> String)
-> Show CreateRecoveryLink
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CreateRecoveryLink] -> String -> String
$cshowList :: [CreateRecoveryLink] -> String -> String
show :: CreateRecoveryLink -> String
$cshow :: CreateRecoveryLink -> String
showsPrec :: Int -> CreateRecoveryLink -> String -> String
$cshowsPrec :: Int -> CreateRecoveryLink -> String -> String
Show, CreateRecoveryLink -> CreateRecoveryLink -> Bool
(CreateRecoveryLink -> CreateRecoveryLink -> Bool)
-> (CreateRecoveryLink -> CreateRecoveryLink -> Bool)
-> Eq CreateRecoveryLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRecoveryLink -> CreateRecoveryLink -> Bool
$c/= :: CreateRecoveryLink -> CreateRecoveryLink -> Bool
== :: CreateRecoveryLink -> CreateRecoveryLink -> Bool
$c== :: CreateRecoveryLink -> CreateRecoveryLink -> Bool
Eq, (forall x. CreateRecoveryLink -> Rep CreateRecoveryLink x)
-> (forall x. Rep CreateRecoveryLink x -> CreateRecoveryLink)
-> Generic CreateRecoveryLink
forall x. Rep CreateRecoveryLink x -> CreateRecoveryLink
forall x. CreateRecoveryLink -> Rep CreateRecoveryLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRecoveryLink x -> CreateRecoveryLink
$cfrom :: forall x. CreateRecoveryLink -> Rep CreateRecoveryLink x
Generic, Typeable CreateRecoveryLink
DataType
Constr
Typeable CreateRecoveryLink
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> CreateRecoveryLink
    -> c CreateRecoveryLink)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateRecoveryLink)
-> (CreateRecoveryLink -> Constr)
-> (CreateRecoveryLink -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateRecoveryLink))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateRecoveryLink))
-> ((forall b. Data b => b -> b)
    -> CreateRecoveryLink -> CreateRecoveryLink)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> CreateRecoveryLink -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateRecoveryLink -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> CreateRecoveryLink -> m CreateRecoveryLink)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateRecoveryLink -> m CreateRecoveryLink)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> CreateRecoveryLink -> m CreateRecoveryLink)
-> Data CreateRecoveryLink
CreateRecoveryLink -> DataType
CreateRecoveryLink -> Constr
(forall b. Data b => b -> b)
-> CreateRecoveryLink -> CreateRecoveryLink
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateRecoveryLink
-> c CreateRecoveryLink
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRecoveryLink
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CreateRecoveryLink -> u
forall u. (forall d. Data d => d -> u) -> CreateRecoveryLink -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRecoveryLink
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateRecoveryLink
-> c CreateRecoveryLink
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateRecoveryLink)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateRecoveryLink)
$cCreateRecoveryLink :: Constr
$tCreateRecoveryLink :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
gmapMp :: (forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
gmapM :: (forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CreateRecoveryLink -> m CreateRecoveryLink
gmapQi :: Int -> (forall d. Data d => d -> u) -> CreateRecoveryLink -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CreateRecoveryLink -> u
gmapQ :: (forall d. Data d => d -> u) -> CreateRecoveryLink -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CreateRecoveryLink -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateRecoveryLink -> r
gmapT :: (forall b. Data b => b -> b)
-> CreateRecoveryLink -> CreateRecoveryLink
$cgmapT :: (forall b. Data b => b -> b)
-> CreateRecoveryLink -> CreateRecoveryLink
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateRecoveryLink)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CreateRecoveryLink)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CreateRecoveryLink)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateRecoveryLink)
dataTypeOf :: CreateRecoveryLink -> DataType
$cdataTypeOf :: CreateRecoveryLink -> DataType
toConstr :: CreateRecoveryLink -> Constr
$ctoConstr :: CreateRecoveryLink -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRecoveryLink
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateRecoveryLink
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateRecoveryLink
-> c CreateRecoveryLink
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> CreateRecoveryLink
-> c CreateRecoveryLink
$cp1Data :: Typeable CreateRecoveryLink
Data)

instance FromJSON CreateRecoveryLink

instance ToJSON CreateRecoveryLink where
  toEncoding :: CreateRecoveryLink -> Encoding
toEncoding = Options -> CreateRecoveryLink -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data ErrorContainer = ErrorContainer
  { -- | Errors in the container
    ErrorContainer -> Value
errors :: Value,
    -- |
    ErrorContainer -> Text
id :: Text
  }
  deriving stock (Int -> ErrorContainer -> String -> String
[ErrorContainer] -> String -> String
ErrorContainer -> String
(Int -> ErrorContainer -> String -> String)
-> (ErrorContainer -> String)
-> ([ErrorContainer] -> String -> String)
-> Show ErrorContainer
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ErrorContainer] -> String -> String
$cshowList :: [ErrorContainer] -> String -> String
show :: ErrorContainer -> String
$cshow :: ErrorContainer -> String
showsPrec :: Int -> ErrorContainer -> String -> String
$cshowsPrec :: Int -> ErrorContainer -> String -> String
Show, ErrorContainer -> ErrorContainer -> Bool
(ErrorContainer -> ErrorContainer -> Bool)
-> (ErrorContainer -> ErrorContainer -> Bool) -> Eq ErrorContainer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorContainer -> ErrorContainer -> Bool
$c/= :: ErrorContainer -> ErrorContainer -> Bool
== :: ErrorContainer -> ErrorContainer -> Bool
$c== :: ErrorContainer -> ErrorContainer -> Bool
Eq, (forall x. ErrorContainer -> Rep ErrorContainer x)
-> (forall x. Rep ErrorContainer x -> ErrorContainer)
-> Generic ErrorContainer
forall x. Rep ErrorContainer x -> ErrorContainer
forall x. ErrorContainer -> Rep ErrorContainer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorContainer x -> ErrorContainer
$cfrom :: forall x. ErrorContainer -> Rep ErrorContainer x
Generic, Typeable ErrorContainer
DataType
Constr
Typeable ErrorContainer
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ErrorContainer -> c ErrorContainer)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ErrorContainer)
-> (ErrorContainer -> Constr)
-> (ErrorContainer -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ErrorContainer))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ErrorContainer))
-> ((forall b. Data b => b -> b)
    -> ErrorContainer -> ErrorContainer)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ErrorContainer -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ErrorContainer -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ErrorContainer -> m ErrorContainer)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ErrorContainer -> m ErrorContainer)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ErrorContainer -> m ErrorContainer)
-> Data ErrorContainer
ErrorContainer -> DataType
ErrorContainer -> Constr
(forall b. Data b => b -> b) -> ErrorContainer -> ErrorContainer
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorContainer -> c ErrorContainer
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorContainer
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ErrorContainer -> u
forall u. (forall d. Data d => d -> u) -> ErrorContainer -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorContainer
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorContainer -> c ErrorContainer
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorContainer)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErrorContainer)
$cErrorContainer :: Constr
$tErrorContainer :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
gmapMp :: (forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
gmapM :: (forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ErrorContainer -> m ErrorContainer
gmapQi :: Int -> (forall d. Data d => d -> u) -> ErrorContainer -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ErrorContainer -> u
gmapQ :: (forall d. Data d => d -> u) -> ErrorContainer -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErrorContainer -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErrorContainer -> r
gmapT :: (forall b. Data b => b -> b) -> ErrorContainer -> ErrorContainer
$cgmapT :: (forall b. Data b => b -> b) -> ErrorContainer -> ErrorContainer
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErrorContainer)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErrorContainer)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ErrorContainer)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErrorContainer)
dataTypeOf :: ErrorContainer -> DataType
$cdataTypeOf :: ErrorContainer -> DataType
toConstr :: ErrorContainer -> Constr
$ctoConstr :: ErrorContainer -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorContainer
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErrorContainer
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorContainer -> c ErrorContainer
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErrorContainer -> c ErrorContainer
$cp1Data :: Typeable ErrorContainer
Data)

instance FromJSON ErrorContainer

instance ToJSON ErrorContainer where
  toEncoding :: ErrorContainer -> Encoding
toEncoding = Options -> ErrorContainer -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | Field represents a HTML Form Field
data FormField = FormField
  { -- | Disabled is the equivalent of `<input {{if .Disabled}}disabled{{end}}\">`
    FormField -> Maybe Bool
disabled :: Maybe Bool,
    -- |
    FormField -> Maybe [Message]
messages :: Maybe [Message],
    -- | Name is the equivalent of `<input name=\"{{.Name}}\">`
    FormField -> Text
name :: Text,
    -- | Pattern is the equivalent of `<input pattern=\"{{.Pattern}}\">`
    FormField -> Maybe Text
pattern :: Maybe Text,
    -- | Required is the equivalent of `<input required=\"{{.Required}}\">`
    FormField -> Maybe Bool
required :: Maybe Bool,
    -- | Type is the equivalent of `<input type=\"{{.Type}}\">`
    FormField -> Text
_type :: Text,
    -- | Value is the equivalent of `<input value=\"{{.Value}}\">`
    FormField -> Maybe Value
value :: Maybe Value
  }
  deriving stock (Int -> FormField -> String -> String
[FormField] -> String -> String
FormField -> String
(Int -> FormField -> String -> String)
-> (FormField -> String)
-> ([FormField] -> String -> String)
-> Show FormField
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FormField] -> String -> String
$cshowList :: [FormField] -> String -> String
show :: FormField -> String
$cshow :: FormField -> String
showsPrec :: Int -> FormField -> String -> String
$cshowsPrec :: Int -> FormField -> String -> String
Show, FormField -> FormField -> Bool
(FormField -> FormField -> Bool)
-> (FormField -> FormField -> Bool) -> Eq FormField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormField -> FormField -> Bool
$c/= :: FormField -> FormField -> Bool
== :: FormField -> FormField -> Bool
$c== :: FormField -> FormField -> Bool
Eq, (forall x. FormField -> Rep FormField x)
-> (forall x. Rep FormField x -> FormField) -> Generic FormField
forall x. Rep FormField x -> FormField
forall x. FormField -> Rep FormField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormField x -> FormField
$cfrom :: forall x. FormField -> Rep FormField x
Generic, Typeable FormField
DataType
Constr
Typeable FormField
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FormField -> c FormField)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FormField)
-> (FormField -> Constr)
-> (FormField -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FormField))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FormField))
-> ((forall b. Data b => b -> b) -> FormField -> FormField)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FormField -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FormField -> r)
-> (forall u. (forall d. Data d => d -> u) -> FormField -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FormField -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FormField -> m FormField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FormField -> m FormField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FormField -> m FormField)
-> Data FormField
FormField -> DataType
FormField -> Constr
(forall b. Data b => b -> b) -> FormField -> FormField
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FormField -> c FormField
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FormField
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FormField -> u
forall u. (forall d. Data d => d -> u) -> FormField -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FormField -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FormField -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FormField -> m FormField
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FormField -> m FormField
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FormField
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FormField -> c FormField
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FormField)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FormField)
$cFormField :: Constr
$tFormField :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FormField -> m FormField
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FormField -> m FormField
gmapMp :: (forall d. Data d => d -> m d) -> FormField -> m FormField
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FormField -> m FormField
gmapM :: (forall d. Data d => d -> m d) -> FormField -> m FormField
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FormField -> m FormField
gmapQi :: Int -> (forall d. Data d => d -> u) -> FormField -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FormField -> u
gmapQ :: (forall d. Data d => d -> u) -> FormField -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FormField -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FormField -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FormField -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FormField -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FormField -> r
gmapT :: (forall b. Data b => b -> b) -> FormField -> FormField
$cgmapT :: (forall b. Data b => b -> b) -> FormField -> FormField
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FormField)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FormField)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FormField)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FormField)
dataTypeOf :: FormField -> DataType
$cdataTypeOf :: FormField -> DataType
toConstr :: FormField -> Constr
$ctoConstr :: FormField -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FormField
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FormField
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FormField -> c FormField
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FormField -> c FormField
$cp1Data :: Typeable FormField
Data)

instance FromJSON FormField where
  parseJSON :: Value -> Parser FormField
parseJSON =
    Options -> Value -> Parser FormField
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON FormField where
  toEncoding :: FormField -> Encoding
toEncoding =
    Options -> FormField -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- | Error responses are sent when an error (e.g. unauthorized, bad request, ...) occurred.
data GenericError = GenericError
  { -- |
    GenericError -> Maybe GenericErrorPayload
error :: Maybe GenericErrorPayload
  }
  deriving stock (Int -> GenericError -> String -> String
[GenericError] -> String -> String
GenericError -> String
(Int -> GenericError -> String -> String)
-> (GenericError -> String)
-> ([GenericError] -> String -> String)
-> Show GenericError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GenericError] -> String -> String
$cshowList :: [GenericError] -> String -> String
show :: GenericError -> String
$cshow :: GenericError -> String
showsPrec :: Int -> GenericError -> String -> String
$cshowsPrec :: Int -> GenericError -> String -> String
Show, GenericError -> GenericError -> Bool
(GenericError -> GenericError -> Bool)
-> (GenericError -> GenericError -> Bool) -> Eq GenericError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericError -> GenericError -> Bool
$c/= :: GenericError -> GenericError -> Bool
== :: GenericError -> GenericError -> Bool
$c== :: GenericError -> GenericError -> Bool
Eq, (forall x. GenericError -> Rep GenericError x)
-> (forall x. Rep GenericError x -> GenericError)
-> Generic GenericError
forall x. Rep GenericError x -> GenericError
forall x. GenericError -> Rep GenericError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenericError x -> GenericError
$cfrom :: forall x. GenericError -> Rep GenericError x
Generic, Typeable GenericError
DataType
Constr
Typeable GenericError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> GenericError -> c GenericError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GenericError)
-> (GenericError -> Constr)
-> (GenericError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GenericError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GenericError))
-> ((forall b. Data b => b -> b) -> GenericError -> GenericError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GenericError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GenericError -> r)
-> (forall u. (forall d. Data d => d -> u) -> GenericError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GenericError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GenericError -> m GenericError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GenericError -> m GenericError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GenericError -> m GenericError)
-> Data GenericError
GenericError -> DataType
GenericError -> Constr
(forall b. Data b => b -> b) -> GenericError -> GenericError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericError -> c GenericError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GenericError -> u
forall u. (forall d. Data d => d -> u) -> GenericError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenericError -> m GenericError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenericError -> m GenericError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericError -> c GenericError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenericError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericError)
$cGenericError :: Constr
$tGenericError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GenericError -> m GenericError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenericError -> m GenericError
gmapMp :: (forall d. Data d => d -> m d) -> GenericError -> m GenericError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenericError -> m GenericError
gmapM :: (forall d. Data d => d -> m d) -> GenericError -> m GenericError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenericError -> m GenericError
gmapQi :: Int -> (forall d. Data d => d -> u) -> GenericError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GenericError -> u
gmapQ :: (forall d. Data d => d -> u) -> GenericError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GenericError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericError -> r
gmapT :: (forall b. Data b => b -> b) -> GenericError -> GenericError
$cgmapT :: (forall b. Data b => b -> b) -> GenericError -> GenericError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GenericError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenericError)
dataTypeOf :: GenericError -> DataType
$cdataTypeOf :: GenericError -> DataType
toConstr :: GenericError -> Constr
$ctoConstr :: GenericError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericError -> c GenericError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericError -> c GenericError
$cp1Data :: Typeable GenericError
Data)

instance FromJSON GenericError

instance ToJSON GenericError where
  toEncoding :: GenericError -> Encoding
toEncoding = Options -> GenericError -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data GenericErrorPayload = GenericErrorPayload
  { -- | Code represents the error status code (404, 403, 401, ...).
    GenericErrorPayload -> Maybe Integer
code :: Maybe Integer,
    -- | Debug contains debug information. This is usually not available and has to be enabled.
    GenericErrorPayload -> Maybe Text
debug :: Maybe Text,
    -- |
    GenericErrorPayload -> Maybe Value
details :: Maybe Value,
    -- |
    GenericErrorPayload -> Maybe Text
message :: Maybe Text,
    -- |
    GenericErrorPayload -> Maybe Text
reason :: Maybe Text,
    -- |
    GenericErrorPayload -> Maybe Text
request :: Maybe Text,
    -- |
    GenericErrorPayload -> Maybe Text
status :: Maybe Text
  }
  deriving stock (Int -> GenericErrorPayload -> String -> String
[GenericErrorPayload] -> String -> String
GenericErrorPayload -> String
(Int -> GenericErrorPayload -> String -> String)
-> (GenericErrorPayload -> String)
-> ([GenericErrorPayload] -> String -> String)
-> Show GenericErrorPayload
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GenericErrorPayload] -> String -> String
$cshowList :: [GenericErrorPayload] -> String -> String
show :: GenericErrorPayload -> String
$cshow :: GenericErrorPayload -> String
showsPrec :: Int -> GenericErrorPayload -> String -> String
$cshowsPrec :: Int -> GenericErrorPayload -> String -> String
Show, GenericErrorPayload -> GenericErrorPayload -> Bool
(GenericErrorPayload -> GenericErrorPayload -> Bool)
-> (GenericErrorPayload -> GenericErrorPayload -> Bool)
-> Eq GenericErrorPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericErrorPayload -> GenericErrorPayload -> Bool
$c/= :: GenericErrorPayload -> GenericErrorPayload -> Bool
== :: GenericErrorPayload -> GenericErrorPayload -> Bool
$c== :: GenericErrorPayload -> GenericErrorPayload -> Bool
Eq, (forall x. GenericErrorPayload -> Rep GenericErrorPayload x)
-> (forall x. Rep GenericErrorPayload x -> GenericErrorPayload)
-> Generic GenericErrorPayload
forall x. Rep GenericErrorPayload x -> GenericErrorPayload
forall x. GenericErrorPayload -> Rep GenericErrorPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenericErrorPayload x -> GenericErrorPayload
$cfrom :: forall x. GenericErrorPayload -> Rep GenericErrorPayload x
Generic, Typeable GenericErrorPayload
DataType
Constr
Typeable GenericErrorPayload
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> GenericErrorPayload
    -> c GenericErrorPayload)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GenericErrorPayload)
-> (GenericErrorPayload -> Constr)
-> (GenericErrorPayload -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GenericErrorPayload))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GenericErrorPayload))
-> ((forall b. Data b => b -> b)
    -> GenericErrorPayload -> GenericErrorPayload)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> GenericErrorPayload -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GenericErrorPayload -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GenericErrorPayload -> m GenericErrorPayload)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GenericErrorPayload -> m GenericErrorPayload)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GenericErrorPayload -> m GenericErrorPayload)
-> Data GenericErrorPayload
GenericErrorPayload -> DataType
GenericErrorPayload -> Constr
(forall b. Data b => b -> b)
-> GenericErrorPayload -> GenericErrorPayload
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericErrorPayload
-> c GenericErrorPayload
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericErrorPayload
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> GenericErrorPayload -> u
forall u.
(forall d. Data d => d -> u) -> GenericErrorPayload -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericErrorPayload
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericErrorPayload
-> c GenericErrorPayload
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenericErrorPayload)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericErrorPayload)
$cGenericErrorPayload :: Constr
$tGenericErrorPayload :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
gmapMp :: (forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
gmapM :: (forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericErrorPayload -> m GenericErrorPayload
gmapQi :: Int -> (forall d. Data d => d -> u) -> GenericErrorPayload -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GenericErrorPayload -> u
gmapQ :: (forall d. Data d => d -> u) -> GenericErrorPayload -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> GenericErrorPayload -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericErrorPayload -> r
gmapT :: (forall b. Data b => b -> b)
-> GenericErrorPayload -> GenericErrorPayload
$cgmapT :: (forall b. Data b => b -> b)
-> GenericErrorPayload -> GenericErrorPayload
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericErrorPayload)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericErrorPayload)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GenericErrorPayload)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenericErrorPayload)
dataTypeOf :: GenericErrorPayload -> DataType
$cdataTypeOf :: GenericErrorPayload -> DataType
toConstr :: GenericErrorPayload -> Constr
$ctoConstr :: GenericErrorPayload -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericErrorPayload
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericErrorPayload
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericErrorPayload
-> c GenericErrorPayload
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> GenericErrorPayload
-> c GenericErrorPayload
$cp1Data :: Typeable GenericErrorPayload
Data)

instance FromJSON GenericErrorPayload

instance ToJSON GenericErrorPayload where
  toEncoding :: GenericErrorPayload -> Encoding
toEncoding = Options -> GenericErrorPayload -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data HealthNotReadyStatus = HealthNotReadyStatus
  { -- | Errors contains a list of errors that caused the not ready status.
    HealthNotReadyStatus -> Maybe (Map String Text)
errors :: Maybe (Map.Map String Text)
  }
  deriving stock (Int -> HealthNotReadyStatus -> String -> String
[HealthNotReadyStatus] -> String -> String
HealthNotReadyStatus -> String
(Int -> HealthNotReadyStatus -> String -> String)
-> (HealthNotReadyStatus -> String)
-> ([HealthNotReadyStatus] -> String -> String)
-> Show HealthNotReadyStatus
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HealthNotReadyStatus] -> String -> String
$cshowList :: [HealthNotReadyStatus] -> String -> String
show :: HealthNotReadyStatus -> String
$cshow :: HealthNotReadyStatus -> String
showsPrec :: Int -> HealthNotReadyStatus -> String -> String
$cshowsPrec :: Int -> HealthNotReadyStatus -> String -> String
Show, HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
(HealthNotReadyStatus -> HealthNotReadyStatus -> Bool)
-> (HealthNotReadyStatus -> HealthNotReadyStatus -> Bool)
-> Eq HealthNotReadyStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
$c/= :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
== :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
$c== :: HealthNotReadyStatus -> HealthNotReadyStatus -> Bool
Eq, (forall x. HealthNotReadyStatus -> Rep HealthNotReadyStatus x)
-> (forall x. Rep HealthNotReadyStatus x -> HealthNotReadyStatus)
-> Generic HealthNotReadyStatus
forall x. Rep HealthNotReadyStatus x -> HealthNotReadyStatus
forall x. HealthNotReadyStatus -> Rep HealthNotReadyStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HealthNotReadyStatus x -> HealthNotReadyStatus
$cfrom :: forall x. HealthNotReadyStatus -> Rep HealthNotReadyStatus x
Generic, Typeable HealthNotReadyStatus
DataType
Constr
Typeable HealthNotReadyStatus
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> HealthNotReadyStatus
    -> c HealthNotReadyStatus)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c HealthNotReadyStatus)
-> (HealthNotReadyStatus -> Constr)
-> (HealthNotReadyStatus -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c HealthNotReadyStatus))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c HealthNotReadyStatus))
-> ((forall b. Data b => b -> b)
    -> HealthNotReadyStatus -> HealthNotReadyStatus)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> HealthNotReadyStatus -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HealthNotReadyStatus -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> HealthNotReadyStatus -> m HealthNotReadyStatus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HealthNotReadyStatus -> m HealthNotReadyStatus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> HealthNotReadyStatus -> m HealthNotReadyStatus)
-> Data HealthNotReadyStatus
HealthNotReadyStatus -> DataType
HealthNotReadyStatus -> Constr
(forall b. Data b => b -> b)
-> HealthNotReadyStatus -> HealthNotReadyStatus
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HealthNotReadyStatus
-> c HealthNotReadyStatus
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthNotReadyStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HealthNotReadyStatus -> u
forall u.
(forall d. Data d => d -> u) -> HealthNotReadyStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthNotReadyStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HealthNotReadyStatus
-> c HealthNotReadyStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HealthNotReadyStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HealthNotReadyStatus)
$cHealthNotReadyStatus :: Constr
$tHealthNotReadyStatus :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
gmapMp :: (forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
gmapM :: (forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HealthNotReadyStatus -> m HealthNotReadyStatus
gmapQi :: Int -> (forall d. Data d => d -> u) -> HealthNotReadyStatus -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HealthNotReadyStatus -> u
gmapQ :: (forall d. Data d => d -> u) -> HealthNotReadyStatus -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HealthNotReadyStatus -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HealthNotReadyStatus -> r
gmapT :: (forall b. Data b => b -> b)
-> HealthNotReadyStatus -> HealthNotReadyStatus
$cgmapT :: (forall b. Data b => b -> b)
-> HealthNotReadyStatus -> HealthNotReadyStatus
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HealthNotReadyStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HealthNotReadyStatus)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c HealthNotReadyStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HealthNotReadyStatus)
dataTypeOf :: HealthNotReadyStatus -> DataType
$cdataTypeOf :: HealthNotReadyStatus -> DataType
toConstr :: HealthNotReadyStatus -> Constr
$ctoConstr :: HealthNotReadyStatus -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthNotReadyStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthNotReadyStatus
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HealthNotReadyStatus
-> c HealthNotReadyStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HealthNotReadyStatus
-> c HealthNotReadyStatus
$cp1Data :: Typeable HealthNotReadyStatus
Data)

instance FromJSON HealthNotReadyStatus

instance ToJSON HealthNotReadyStatus where
  toEncoding :: HealthNotReadyStatus -> Encoding
toEncoding = Options -> HealthNotReadyStatus -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data HealthStatus = HealthStatus
  { -- | Status always contains \"ok\".
    HealthStatus -> Maybe Text
status :: Maybe Text
  }
  deriving stock (Int -> HealthStatus -> String -> String
[HealthStatus] -> String -> String
HealthStatus -> String
(Int -> HealthStatus -> String -> String)
-> (HealthStatus -> String)
-> ([HealthStatus] -> String -> String)
-> Show HealthStatus
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HealthStatus] -> String -> String
$cshowList :: [HealthStatus] -> String -> String
show :: HealthStatus -> String
$cshow :: HealthStatus -> String
showsPrec :: Int -> HealthStatus -> String -> String
$cshowsPrec :: Int -> HealthStatus -> String -> String
Show, HealthStatus -> HealthStatus -> Bool
(HealthStatus -> HealthStatus -> Bool)
-> (HealthStatus -> HealthStatus -> Bool) -> Eq HealthStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthStatus -> HealthStatus -> Bool
$c/= :: HealthStatus -> HealthStatus -> Bool
== :: HealthStatus -> HealthStatus -> Bool
$c== :: HealthStatus -> HealthStatus -> Bool
Eq, (forall x. HealthStatus -> Rep HealthStatus x)
-> (forall x. Rep HealthStatus x -> HealthStatus)
-> Generic HealthStatus
forall x. Rep HealthStatus x -> HealthStatus
forall x. HealthStatus -> Rep HealthStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HealthStatus x -> HealthStatus
$cfrom :: forall x. HealthStatus -> Rep HealthStatus x
Generic, Typeable HealthStatus
DataType
Constr
Typeable HealthStatus
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> HealthStatus -> c HealthStatus)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c HealthStatus)
-> (HealthStatus -> Constr)
-> (HealthStatus -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c HealthStatus))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c HealthStatus))
-> ((forall b. Data b => b -> b) -> HealthStatus -> HealthStatus)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HealthStatus -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HealthStatus -> r)
-> (forall u. (forall d. Data d => d -> u) -> HealthStatus -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HealthStatus -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus)
-> Data HealthStatus
HealthStatus -> DataType
HealthStatus -> Constr
(forall b. Data b => b -> b) -> HealthStatus -> HealthStatus
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HealthStatus -> c HealthStatus
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HealthStatus -> u
forall u. (forall d. Data d => d -> u) -> HealthStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HealthStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HealthStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HealthStatus -> c HealthStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HealthStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HealthStatus)
$cHealthStatus :: Constr
$tHealthStatus :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
gmapMp :: (forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
gmapM :: (forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HealthStatus -> m HealthStatus
gmapQi :: Int -> (forall d. Data d => d -> u) -> HealthStatus -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HealthStatus -> u
gmapQ :: (forall d. Data d => d -> u) -> HealthStatus -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HealthStatus -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HealthStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HealthStatus -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HealthStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HealthStatus -> r
gmapT :: (forall b. Data b => b -> b) -> HealthStatus -> HealthStatus
$cgmapT :: (forall b. Data b => b -> b) -> HealthStatus -> HealthStatus
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HealthStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HealthStatus)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c HealthStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HealthStatus)
dataTypeOf :: HealthStatus -> DataType
$cdataTypeOf :: HealthStatus -> DataType
toConstr :: HealthStatus -> Constr
$ctoConstr :: HealthStatus -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HealthStatus
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HealthStatus -> c HealthStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HealthStatus -> c HealthStatus
$cp1Data :: Typeable HealthStatus
Data)

instance FromJSON HealthStatus

instance ToJSON HealthStatus where
  toEncoding :: HealthStatus -> Encoding
toEncoding = Options -> HealthStatus -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data Identity = Identity
  { -- |
    Identity -> Text
id :: Text,
    -- | RecoveryAddresses contains all the addresses that can be used to recover an identity.
    Identity -> Maybe [RecoveryAddress]
recovery_addresses :: Maybe [RecoveryAddress],
    -- | SchemaID is the ID of the JSON Schema to be used for validating the identity's traits.
    Identity -> Text
schema_id :: Text,
    -- | SchemaURL is the URL of the endpoint where the identity's traits schema can be fetched from.  format: url
    Identity -> Text
schema_url :: Text,
    -- |
    Identity -> Value
traits :: Value,
    -- | VerifiableAddresses contains all the addresses that can be verified by the user.
    Identity -> Maybe [VerifiableAddress]
verifiable_addresses :: Maybe [VerifiableAddress]
  }
  deriving stock (Int -> Identity -> String -> String
[Identity] -> String -> String
Identity -> String
(Int -> Identity -> String -> String)
-> (Identity -> String)
-> ([Identity] -> String -> String)
-> Show Identity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Identity] -> String -> String
$cshowList :: [Identity] -> String -> String
show :: Identity -> String
$cshow :: Identity -> String
showsPrec :: Int -> Identity -> String -> String
$cshowsPrec :: Int -> Identity -> String -> String
Show, Identity -> Identity -> Bool
(Identity -> Identity -> Bool)
-> (Identity -> Identity -> Bool) -> Eq Identity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identity -> Identity -> Bool
$c/= :: Identity -> Identity -> Bool
== :: Identity -> Identity -> Bool
$c== :: Identity -> Identity -> Bool
Eq, (forall x. Identity -> Rep Identity x)
-> (forall x. Rep Identity x -> Identity) -> Generic Identity
forall x. Rep Identity x -> Identity
forall x. Identity -> Rep Identity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identity x -> Identity
$cfrom :: forall x. Identity -> Rep Identity x
Generic, Typeable Identity
DataType
Constr
Typeable Identity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Identity -> c Identity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Identity)
-> (Identity -> Constr)
-> (Identity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Identity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identity))
-> ((forall b. Data b => b -> b) -> Identity -> Identity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Identity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Identity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Identity -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Identity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Identity -> m Identity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Identity -> m Identity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Identity -> m Identity)
-> Data Identity
Identity -> DataType
Identity -> Constr
(forall b. Data b => b -> b) -> Identity -> Identity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identity -> c Identity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Identity -> u
forall u. (forall d. Data d => d -> u) -> Identity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Identity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Identity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Identity -> m Identity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identity -> m Identity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identity -> c Identity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Identity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identity)
$cIdentity :: Constr
$tIdentity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Identity -> m Identity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identity -> m Identity
gmapMp :: (forall d. Data d => d -> m d) -> Identity -> m Identity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Identity -> m Identity
gmapM :: (forall d. Data d => d -> m d) -> Identity -> m Identity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Identity -> m Identity
gmapQi :: Int -> (forall d. Data d => d -> u) -> Identity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Identity -> u
gmapQ :: (forall d. Data d => d -> u) -> Identity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Identity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Identity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Identity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Identity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Identity -> r
gmapT :: (forall b. Data b => b -> b) -> Identity -> Identity
$cgmapT :: (forall b. Data b => b -> b) -> Identity -> Identity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Identity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Identity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Identity)
dataTypeOf :: Identity -> DataType
$cdataTypeOf :: Identity -> DataType
toConstr :: Identity -> Constr
$ctoConstr :: Identity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Identity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identity -> c Identity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Identity -> c Identity
$cp1Data :: Typeable Identity
Data)

instance FromJSON Identity

instance ToJSON Identity where
  toEncoding :: Identity -> Encoding
toEncoding = Options -> Identity -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | This object represents a login flow. A login flow is initiated at the \&quot;Initiate Login API / Browser Flow\&quot; endpoint by a client.  Once a login flow is completed successfully, a session cookie or session token will be issued.
data LoginFlow = LoginFlow
  { -- | and so on.
    LoginFlow -> Maybe Text
active :: Maybe Text,
    -- | ExpiresAt is the time (UTC) when the flow expires. If the user still wishes to log in, a new flow has to be initiated.
    LoginFlow -> UTCTime
expires_at :: UTCTime,
    -- | Forced stores whether this login flow should enforce re-authentication.
    LoginFlow -> Maybe Bool
forced :: Maybe Bool,
    -- |
    LoginFlow -> Text
id :: Text,
    -- | IssuedAt is the time (UTC) when the flow started.
    LoginFlow -> UTCTime
issued_at :: UTCTime,
    -- |
    LoginFlow -> Maybe [Message]
messages :: Maybe [Message],
    -- | List of login methods  This is the list of available login methods with their required form fields, such as `identifier` and `password` for the password login method. This will also contain error messages such as \"password can not be empty\".
    LoginFlow -> Map String LoginFlowMethod
methods :: Map.Map String LoginFlowMethod,
    -- | RequestURL is the initial URL that was requested from ORY Kratos. It can be used to forward information contained in the URL's path or query for example.
    LoginFlow -> Text
request_url :: Text,
    -- | The flow type can either be `api` or `browser`.
    LoginFlow -> Maybe Text
_type :: Maybe Text
  }
  deriving stock (Int -> LoginFlow -> String -> String
[LoginFlow] -> String -> String
LoginFlow -> String
(Int -> LoginFlow -> String -> String)
-> (LoginFlow -> String)
-> ([LoginFlow] -> String -> String)
-> Show LoginFlow
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoginFlow] -> String -> String
$cshowList :: [LoginFlow] -> String -> String
show :: LoginFlow -> String
$cshow :: LoginFlow -> String
showsPrec :: Int -> LoginFlow -> String -> String
$cshowsPrec :: Int -> LoginFlow -> String -> String
Show, LoginFlow -> LoginFlow -> Bool
(LoginFlow -> LoginFlow -> Bool)
-> (LoginFlow -> LoginFlow -> Bool) -> Eq LoginFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginFlow -> LoginFlow -> Bool
$c/= :: LoginFlow -> LoginFlow -> Bool
== :: LoginFlow -> LoginFlow -> Bool
$c== :: LoginFlow -> LoginFlow -> Bool
Eq, (forall x. LoginFlow -> Rep LoginFlow x)
-> (forall x. Rep LoginFlow x -> LoginFlow) -> Generic LoginFlow
forall x. Rep LoginFlow x -> LoginFlow
forall x. LoginFlow -> Rep LoginFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoginFlow x -> LoginFlow
$cfrom :: forall x. LoginFlow -> Rep LoginFlow x
Generic, Typeable LoginFlow
DataType
Constr
Typeable LoginFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LoginFlow -> c LoginFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LoginFlow)
-> (LoginFlow -> Constr)
-> (LoginFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LoginFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LoginFlow))
-> ((forall b. Data b => b -> b) -> LoginFlow -> LoginFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LoginFlow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LoginFlow -> r)
-> (forall u. (forall d. Data d => d -> u) -> LoginFlow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LoginFlow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow)
-> Data LoginFlow
LoginFlow -> DataType
LoginFlow -> Constr
(forall b. Data b => b -> b) -> LoginFlow -> LoginFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlow -> c LoginFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LoginFlow -> u
forall u. (forall d. Data d => d -> u) -> LoginFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlow -> c LoginFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LoginFlow)
$cLoginFlow :: Constr
$tLoginFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
gmapMp :: (forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
gmapM :: (forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LoginFlow -> m LoginFlow
gmapQi :: Int -> (forall d. Data d => d -> u) -> LoginFlow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LoginFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> LoginFlow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LoginFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlow -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlow -> r
gmapT :: (forall b. Data b => b -> b) -> LoginFlow -> LoginFlow
$cgmapT :: (forall b. Data b => b -> b) -> LoginFlow -> LoginFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LoginFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LoginFlow)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LoginFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginFlow)
dataTypeOf :: LoginFlow -> DataType
$cdataTypeOf :: LoginFlow -> DataType
toConstr :: LoginFlow -> Constr
$ctoConstr :: LoginFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlow -> c LoginFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlow -> c LoginFlow
$cp1Data :: Typeable LoginFlow
Data)

instance FromJSON LoginFlow where
  parseJSON :: Value -> Parser LoginFlow
parseJSON =
    Options -> Value -> Parser LoginFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON LoginFlow where
  toEncoding :: LoginFlow -> Encoding
toEncoding =
    Options -> LoginFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- |
data LoginFlowMethod = LoginFlowMethod
  { -- |
    LoginFlowMethod -> LoginFlowMethodConfig
config :: LoginFlowMethodConfig,
    -- | and so on.
    LoginFlowMethod -> Text
method :: Text
  }
  deriving stock (Int -> LoginFlowMethod -> String -> String
[LoginFlowMethod] -> String -> String
LoginFlowMethod -> String
(Int -> LoginFlowMethod -> String -> String)
-> (LoginFlowMethod -> String)
-> ([LoginFlowMethod] -> String -> String)
-> Show LoginFlowMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoginFlowMethod] -> String -> String
$cshowList :: [LoginFlowMethod] -> String -> String
show :: LoginFlowMethod -> String
$cshow :: LoginFlowMethod -> String
showsPrec :: Int -> LoginFlowMethod -> String -> String
$cshowsPrec :: Int -> LoginFlowMethod -> String -> String
Show, LoginFlowMethod -> LoginFlowMethod -> Bool
(LoginFlowMethod -> LoginFlowMethod -> Bool)
-> (LoginFlowMethod -> LoginFlowMethod -> Bool)
-> Eq LoginFlowMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginFlowMethod -> LoginFlowMethod -> Bool
$c/= :: LoginFlowMethod -> LoginFlowMethod -> Bool
== :: LoginFlowMethod -> LoginFlowMethod -> Bool
$c== :: LoginFlowMethod -> LoginFlowMethod -> Bool
Eq, (forall x. LoginFlowMethod -> Rep LoginFlowMethod x)
-> (forall x. Rep LoginFlowMethod x -> LoginFlowMethod)
-> Generic LoginFlowMethod
forall x. Rep LoginFlowMethod x -> LoginFlowMethod
forall x. LoginFlowMethod -> Rep LoginFlowMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoginFlowMethod x -> LoginFlowMethod
$cfrom :: forall x. LoginFlowMethod -> Rep LoginFlowMethod x
Generic, Typeable LoginFlowMethod
DataType
Constr
Typeable LoginFlowMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LoginFlowMethod -> c LoginFlowMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LoginFlowMethod)
-> (LoginFlowMethod -> Constr)
-> (LoginFlowMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LoginFlowMethod))
-> ((forall b. Data b => b -> b)
    -> LoginFlowMethod -> LoginFlowMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LoginFlowMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LoginFlowMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LoginFlowMethod -> m LoginFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LoginFlowMethod -> m LoginFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LoginFlowMethod -> m LoginFlowMethod)
-> Data LoginFlowMethod
LoginFlowMethod -> DataType
LoginFlowMethod -> Constr
(forall b. Data b => b -> b) -> LoginFlowMethod -> LoginFlowMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlowMethod -> c LoginFlowMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LoginFlowMethod -> u
forall u. (forall d. Data d => d -> u) -> LoginFlowMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlowMethod -> c LoginFlowMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginFlowMethod)
$cLoginFlowMethod :: Constr
$tLoginFlowMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
gmapMp :: (forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
gmapM :: (forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethod -> m LoginFlowMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> LoginFlowMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LoginFlowMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> LoginFlowMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LoginFlowMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethod -> r
gmapT :: (forall b. Data b => b -> b) -> LoginFlowMethod -> LoginFlowMethod
$cgmapT :: (forall b. Data b => b -> b) -> LoginFlowMethod -> LoginFlowMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginFlowMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginFlowMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethod)
dataTypeOf :: LoginFlowMethod -> DataType
$cdataTypeOf :: LoginFlowMethod -> DataType
toConstr :: LoginFlowMethod -> Constr
$ctoConstr :: LoginFlowMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlowMethod -> c LoginFlowMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LoginFlowMethod -> c LoginFlowMethod
$cp1Data :: Typeable LoginFlowMethod
Data)

instance FromJSON LoginFlowMethod

instance ToJSON LoginFlowMethod where
  toEncoding :: LoginFlowMethod -> Encoding
toEncoding = Options -> LoginFlowMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data LoginFlowMethodConfig = LoginFlowMethodConfig
  { -- | Action should be used as the form action URL `<form action=\"{{ .Action }}\" method=\"post\">`.
    LoginFlowMethodConfig -> Text
action :: Text,
    -- | Fields contains multiple fields
    LoginFlowMethodConfig -> [FormField]
fields :: [FormField],
    -- |
    LoginFlowMethodConfig -> Maybe [Message]
messages :: Maybe [Message],
    -- | Method is the form method (e.g. POST)
    LoginFlowMethodConfig -> Text
method :: Text,
    -- | Providers is set for the \"oidc\" flow method.
    LoginFlowMethodConfig -> Maybe [FormField]
providers :: Maybe [FormField]
  }
  deriving stock (Int -> LoginFlowMethodConfig -> String -> String
[LoginFlowMethodConfig] -> String -> String
LoginFlowMethodConfig -> String
(Int -> LoginFlowMethodConfig -> String -> String)
-> (LoginFlowMethodConfig -> String)
-> ([LoginFlowMethodConfig] -> String -> String)
-> Show LoginFlowMethodConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoginFlowMethodConfig] -> String -> String
$cshowList :: [LoginFlowMethodConfig] -> String -> String
show :: LoginFlowMethodConfig -> String
$cshow :: LoginFlowMethodConfig -> String
showsPrec :: Int -> LoginFlowMethodConfig -> String -> String
$cshowsPrec :: Int -> LoginFlowMethodConfig -> String -> String
Show, LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool
(LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool)
-> (LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool)
-> Eq LoginFlowMethodConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool
$c/= :: LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool
== :: LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool
$c== :: LoginFlowMethodConfig -> LoginFlowMethodConfig -> Bool
Eq, (forall x. LoginFlowMethodConfig -> Rep LoginFlowMethodConfig x)
-> (forall x. Rep LoginFlowMethodConfig x -> LoginFlowMethodConfig)
-> Generic LoginFlowMethodConfig
forall x. Rep LoginFlowMethodConfig x -> LoginFlowMethodConfig
forall x. LoginFlowMethodConfig -> Rep LoginFlowMethodConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoginFlowMethodConfig x -> LoginFlowMethodConfig
$cfrom :: forall x. LoginFlowMethodConfig -> Rep LoginFlowMethodConfig x
Generic, Typeable LoginFlowMethodConfig
DataType
Constr
Typeable LoginFlowMethodConfig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LoginFlowMethodConfig
    -> c LoginFlowMethodConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LoginFlowMethodConfig)
-> (LoginFlowMethodConfig -> Constr)
-> (LoginFlowMethodConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethodConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LoginFlowMethodConfig))
-> ((forall b. Data b => b -> b)
    -> LoginFlowMethodConfig -> LoginFlowMethodConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> LoginFlowMethodConfig
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> LoginFlowMethodConfig
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LoginFlowMethodConfig -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LoginFlowMethodConfig -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LoginFlowMethodConfig -> m LoginFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LoginFlowMethodConfig -> m LoginFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LoginFlowMethodConfig -> m LoginFlowMethodConfig)
-> Data LoginFlowMethodConfig
LoginFlowMethodConfig -> DataType
LoginFlowMethodConfig -> Constr
(forall b. Data b => b -> b)
-> LoginFlowMethodConfig -> LoginFlowMethodConfig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginFlowMethodConfig
-> c LoginFlowMethodConfig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethodConfig
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LoginFlowMethodConfig -> u
forall u.
(forall d. Data d => d -> u) -> LoginFlowMethodConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethodConfig -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethodConfig -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethodConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginFlowMethodConfig
-> c LoginFlowMethodConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethodConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginFlowMethodConfig)
$cLoginFlowMethodConfig :: Constr
$tLoginFlowMethodConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
gmapMp :: (forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
gmapM :: (forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LoginFlowMethodConfig -> m LoginFlowMethodConfig
gmapQi :: Int -> (forall d. Data d => d -> u) -> LoginFlowMethodConfig -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LoginFlowMethodConfig -> u
gmapQ :: (forall d. Data d => d -> u) -> LoginFlowMethodConfig -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> LoginFlowMethodConfig -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethodConfig -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethodConfig -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethodConfig -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginFlowMethodConfig -> r
gmapT :: (forall b. Data b => b -> b)
-> LoginFlowMethodConfig -> LoginFlowMethodConfig
$cgmapT :: (forall b. Data b => b -> b)
-> LoginFlowMethodConfig -> LoginFlowMethodConfig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginFlowMethodConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginFlowMethodConfig)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethodConfig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginFlowMethodConfig)
dataTypeOf :: LoginFlowMethodConfig -> DataType
$cdataTypeOf :: LoginFlowMethodConfig -> DataType
toConstr :: LoginFlowMethodConfig -> Constr
$ctoConstr :: LoginFlowMethodConfig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethodConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginFlowMethodConfig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginFlowMethodConfig
-> c LoginFlowMethodConfig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginFlowMethodConfig
-> c LoginFlowMethodConfig
$cp1Data :: Typeable LoginFlowMethodConfig
Data)

instance FromJSON LoginFlowMethodConfig

instance ToJSON LoginFlowMethodConfig where
  toEncoding :: LoginFlowMethodConfig -> Encoding
toEncoding = Options -> LoginFlowMethodConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | The Response for Login Flows via API
data LoginViaApiResponse = LoginViaApiResponse
  { -- |
    LoginViaApiResponse -> Session
session :: Session,
    -- | The Session Token  A session token is equivalent to a session cookie, but it can be sent in the HTTP Authorization Header:  Authorization: bearer ${session-token}  The session token is only issued for API flows, not for Browser flows!
    LoginViaApiResponse -> Text
session_token :: Text
  }
  deriving stock (Int -> LoginViaApiResponse -> String -> String
[LoginViaApiResponse] -> String -> String
LoginViaApiResponse -> String
(Int -> LoginViaApiResponse -> String -> String)
-> (LoginViaApiResponse -> String)
-> ([LoginViaApiResponse] -> String -> String)
-> Show LoginViaApiResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoginViaApiResponse] -> String -> String
$cshowList :: [LoginViaApiResponse] -> String -> String
show :: LoginViaApiResponse -> String
$cshow :: LoginViaApiResponse -> String
showsPrec :: Int -> LoginViaApiResponse -> String -> String
$cshowsPrec :: Int -> LoginViaApiResponse -> String -> String
Show, LoginViaApiResponse -> LoginViaApiResponse -> Bool
(LoginViaApiResponse -> LoginViaApiResponse -> Bool)
-> (LoginViaApiResponse -> LoginViaApiResponse -> Bool)
-> Eq LoginViaApiResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginViaApiResponse -> LoginViaApiResponse -> Bool
$c/= :: LoginViaApiResponse -> LoginViaApiResponse -> Bool
== :: LoginViaApiResponse -> LoginViaApiResponse -> Bool
$c== :: LoginViaApiResponse -> LoginViaApiResponse -> Bool
Eq, (forall x. LoginViaApiResponse -> Rep LoginViaApiResponse x)
-> (forall x. Rep LoginViaApiResponse x -> LoginViaApiResponse)
-> Generic LoginViaApiResponse
forall x. Rep LoginViaApiResponse x -> LoginViaApiResponse
forall x. LoginViaApiResponse -> Rep LoginViaApiResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoginViaApiResponse x -> LoginViaApiResponse
$cfrom :: forall x. LoginViaApiResponse -> Rep LoginViaApiResponse x
Generic, Typeable LoginViaApiResponse
DataType
Constr
Typeable LoginViaApiResponse
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LoginViaApiResponse
    -> c LoginViaApiResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LoginViaApiResponse)
-> (LoginViaApiResponse -> Constr)
-> (LoginViaApiResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LoginViaApiResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LoginViaApiResponse))
-> ((forall b. Data b => b -> b)
    -> LoginViaApiResponse -> LoginViaApiResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LoginViaApiResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LoginViaApiResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LoginViaApiResponse -> m LoginViaApiResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LoginViaApiResponse -> m LoginViaApiResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LoginViaApiResponse -> m LoginViaApiResponse)
-> Data LoginViaApiResponse
LoginViaApiResponse -> DataType
LoginViaApiResponse -> Constr
(forall b. Data b => b -> b)
-> LoginViaApiResponse -> LoginViaApiResponse
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginViaApiResponse
-> c LoginViaApiResponse
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginViaApiResponse
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LoginViaApiResponse -> u
forall u.
(forall d. Data d => d -> u) -> LoginViaApiResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginViaApiResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginViaApiResponse
-> c LoginViaApiResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginViaApiResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginViaApiResponse)
$cLoginViaApiResponse :: Constr
$tLoginViaApiResponse :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
gmapMp :: (forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
gmapM :: (forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LoginViaApiResponse -> m LoginViaApiResponse
gmapQi :: Int -> (forall d. Data d => d -> u) -> LoginViaApiResponse -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LoginViaApiResponse -> u
gmapQ :: (forall d. Data d => d -> u) -> LoginViaApiResponse -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> LoginViaApiResponse -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LoginViaApiResponse -> r
gmapT :: (forall b. Data b => b -> b)
-> LoginViaApiResponse -> LoginViaApiResponse
$cgmapT :: (forall b. Data b => b -> b)
-> LoginViaApiResponse -> LoginViaApiResponse
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginViaApiResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LoginViaApiResponse)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LoginViaApiResponse)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LoginViaApiResponse)
dataTypeOf :: LoginViaApiResponse -> DataType
$cdataTypeOf :: LoginViaApiResponse -> DataType
toConstr :: LoginViaApiResponse -> Constr
$ctoConstr :: LoginViaApiResponse -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginViaApiResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LoginViaApiResponse
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginViaApiResponse
-> c LoginViaApiResponse
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LoginViaApiResponse
-> c LoginViaApiResponse
$cp1Data :: Typeable LoginViaApiResponse
Data)

instance FromJSON LoginViaApiResponse

instance ToJSON LoginViaApiResponse where
  toEncoding :: LoginViaApiResponse -> Encoding
toEncoding = Options -> LoginViaApiResponse -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data Message = Message
  { -- |
    Message -> Maybe Value
context :: Maybe Value,
    -- |
    Message -> Maybe Integer
id :: Maybe Integer,
    -- |
    Message -> Maybe Text
text :: Maybe Text,
    -- | The flow type can either be `api` or `browser`.
    Message -> Maybe Text
_type :: Maybe Text
  }
  deriving stock (Int -> Message -> String -> String
[Message] -> String -> String
Message -> String
(Int -> Message -> String -> String)
-> (Message -> String)
-> ([Message] -> String -> String)
-> Show Message
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Message] -> String -> String
$cshowList :: [Message] -> String -> String
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> String -> String
$cshowsPrec :: Int -> Message -> String -> String
Show, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic, Typeable Message
DataType
Constr
Typeable Message
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Message -> c Message)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Message)
-> (Message -> Constr)
-> (Message -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Message))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Message))
-> ((forall b. Data b => b -> b) -> Message -> Message)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Message -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Message -> r)
-> (forall u. (forall d. Data d => d -> u) -> Message -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Message -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Message -> m Message)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Message -> m Message)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Message -> m Message)
-> Data Message
Message -> DataType
Message -> Constr
(forall b. Data b => b -> b) -> Message -> Message
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Message -> c Message
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Message
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Message -> u
forall u. (forall d. Data d => d -> u) -> Message -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Message -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Message -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Message -> m Message
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Message -> m Message
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Message
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Message -> c Message
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Message)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Message)
$cMessage :: Constr
$tMessage :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Message -> m Message
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Message -> m Message
gmapMp :: (forall d. Data d => d -> m d) -> Message -> m Message
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Message -> m Message
gmapM :: (forall d. Data d => d -> m d) -> Message -> m Message
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Message -> m Message
gmapQi :: Int -> (forall d. Data d => d -> u) -> Message -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Message -> u
gmapQ :: (forall d. Data d => d -> u) -> Message -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Message -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Message -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Message -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Message -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Message -> r
gmapT :: (forall b. Data b => b -> b) -> Message -> Message
$cgmapT :: (forall b. Data b => b -> b) -> Message -> Message
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Message)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Message)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Message)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Message)
dataTypeOf :: Message -> DataType
$cdataTypeOf :: Message -> DataType
toConstr :: Message -> Constr
$ctoConstr :: Message -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Message
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Message
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Message -> c Message
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Message -> c Message
$cp1Data :: Typeable Message
Data)

instance FromJSON Message where
  parseJSON :: Value -> Parser Message
parseJSON =
    Options -> Value -> Parser Message
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON Message where
  toEncoding :: Message -> Encoding
toEncoding =
    Options -> Message -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- |
data RecoveryAddress = RecoveryAddress
  { -- |
    RecoveryAddress -> Text
id :: Text,
    -- |
    RecoveryAddress -> Text
value :: Text,
    -- |
    RecoveryAddress -> Text
via :: Text
  }
  deriving stock (Int -> RecoveryAddress -> String -> String
[RecoveryAddress] -> String -> String
RecoveryAddress -> String
(Int -> RecoveryAddress -> String -> String)
-> (RecoveryAddress -> String)
-> ([RecoveryAddress] -> String -> String)
-> Show RecoveryAddress
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RecoveryAddress] -> String -> String
$cshowList :: [RecoveryAddress] -> String -> String
show :: RecoveryAddress -> String
$cshow :: RecoveryAddress -> String
showsPrec :: Int -> RecoveryAddress -> String -> String
$cshowsPrec :: Int -> RecoveryAddress -> String -> String
Show, RecoveryAddress -> RecoveryAddress -> Bool
(RecoveryAddress -> RecoveryAddress -> Bool)
-> (RecoveryAddress -> RecoveryAddress -> Bool)
-> Eq RecoveryAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecoveryAddress -> RecoveryAddress -> Bool
$c/= :: RecoveryAddress -> RecoveryAddress -> Bool
== :: RecoveryAddress -> RecoveryAddress -> Bool
$c== :: RecoveryAddress -> RecoveryAddress -> Bool
Eq, (forall x. RecoveryAddress -> Rep RecoveryAddress x)
-> (forall x. Rep RecoveryAddress x -> RecoveryAddress)
-> Generic RecoveryAddress
forall x. Rep RecoveryAddress x -> RecoveryAddress
forall x. RecoveryAddress -> Rep RecoveryAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecoveryAddress x -> RecoveryAddress
$cfrom :: forall x. RecoveryAddress -> Rep RecoveryAddress x
Generic, Typeable RecoveryAddress
DataType
Constr
Typeable RecoveryAddress
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RecoveryAddress -> c RecoveryAddress)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecoveryAddress)
-> (RecoveryAddress -> Constr)
-> (RecoveryAddress -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecoveryAddress))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecoveryAddress))
-> ((forall b. Data b => b -> b)
    -> RecoveryAddress -> RecoveryAddress)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RecoveryAddress -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecoveryAddress -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RecoveryAddress -> m RecoveryAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecoveryAddress -> m RecoveryAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecoveryAddress -> m RecoveryAddress)
-> Data RecoveryAddress
RecoveryAddress -> DataType
RecoveryAddress -> Constr
(forall b. Data b => b -> b) -> RecoveryAddress -> RecoveryAddress
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryAddress -> c RecoveryAddress
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryAddress
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RecoveryAddress -> u
forall u. (forall d. Data d => d -> u) -> RecoveryAddress -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryAddress
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryAddress -> c RecoveryAddress
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryAddress)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryAddress)
$cRecoveryAddress :: Constr
$tRecoveryAddress :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
gmapMp :: (forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
gmapM :: (forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecoveryAddress -> m RecoveryAddress
gmapQi :: Int -> (forall d. Data d => d -> u) -> RecoveryAddress -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RecoveryAddress -> u
gmapQ :: (forall d. Data d => d -> u) -> RecoveryAddress -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecoveryAddress -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryAddress -> r
gmapT :: (forall b. Data b => b -> b) -> RecoveryAddress -> RecoveryAddress
$cgmapT :: (forall b. Data b => b -> b) -> RecoveryAddress -> RecoveryAddress
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryAddress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryAddress)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RecoveryAddress)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryAddress)
dataTypeOf :: RecoveryAddress -> DataType
$cdataTypeOf :: RecoveryAddress -> DataType
toConstr :: RecoveryAddress -> Constr
$ctoConstr :: RecoveryAddress -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryAddress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryAddress
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryAddress -> c RecoveryAddress
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryAddress -> c RecoveryAddress
$cp1Data :: Typeable RecoveryAddress
Data)

instance FromJSON RecoveryAddress

instance ToJSON RecoveryAddress where
  toEncoding :: RecoveryAddress -> Encoding
toEncoding = Options -> RecoveryAddress -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | This request is used when an identity wants to recover their account.  We recommend reading the [Account Recovery Documentation](../self-service/flows/password-reset-account-recovery)
data RecoveryFlow = RecoveryFlow
  { -- | Active, if set, contains the registration method that is being used. It is initially not set.
    RecoveryFlow -> Maybe Text
active :: Maybe Text,
    -- | ExpiresAt is the time (UTC) when the request expires. If the user still wishes to update the setting, a new request has to be initiated.
    RecoveryFlow -> UTCTime
expires_at :: UTCTime,
    -- |
    RecoveryFlow -> Text
id :: Text,
    -- | IssuedAt is the time (UTC) when the request occurred.
    RecoveryFlow -> UTCTime
issued_at :: UTCTime,
    -- |
    RecoveryFlow -> Maybe [Message]
messages :: Maybe [Message],
    -- | Methods contains context for all account recovery methods. If a registration request has been processed, but for example the password is incorrect, this will contain error messages.
    RecoveryFlow -> Map String RecoveryFlowMethod
methods :: Map.Map String RecoveryFlowMethod,
    -- | RequestURL is the initial URL that was requested from ORY Kratos. It can be used to forward information contained in the URL's path or query for example.
    RecoveryFlow -> Text
request_url :: Text,
    -- |
    RecoveryFlow -> Text
state :: Text,
    -- | The flow type can either be `api` or `browser`.
    RecoveryFlow -> Maybe Text
_type :: Maybe Text
  }
  deriving stock (Int -> RecoveryFlow -> String -> String
[RecoveryFlow] -> String -> String
RecoveryFlow -> String
(Int -> RecoveryFlow -> String -> String)
-> (RecoveryFlow -> String)
-> ([RecoveryFlow] -> String -> String)
-> Show RecoveryFlow
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RecoveryFlow] -> String -> String
$cshowList :: [RecoveryFlow] -> String -> String
show :: RecoveryFlow -> String
$cshow :: RecoveryFlow -> String
showsPrec :: Int -> RecoveryFlow -> String -> String
$cshowsPrec :: Int -> RecoveryFlow -> String -> String
Show, RecoveryFlow -> RecoveryFlow -> Bool
(RecoveryFlow -> RecoveryFlow -> Bool)
-> (RecoveryFlow -> RecoveryFlow -> Bool) -> Eq RecoveryFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecoveryFlow -> RecoveryFlow -> Bool
$c/= :: RecoveryFlow -> RecoveryFlow -> Bool
== :: RecoveryFlow -> RecoveryFlow -> Bool
$c== :: RecoveryFlow -> RecoveryFlow -> Bool
Eq, (forall x. RecoveryFlow -> Rep RecoveryFlow x)
-> (forall x. Rep RecoveryFlow x -> RecoveryFlow)
-> Generic RecoveryFlow
forall x. Rep RecoveryFlow x -> RecoveryFlow
forall x. RecoveryFlow -> Rep RecoveryFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecoveryFlow x -> RecoveryFlow
$cfrom :: forall x. RecoveryFlow -> Rep RecoveryFlow x
Generic, Typeable RecoveryFlow
DataType
Constr
Typeable RecoveryFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RecoveryFlow -> c RecoveryFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecoveryFlow)
-> (RecoveryFlow -> Constr)
-> (RecoveryFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecoveryFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecoveryFlow))
-> ((forall b. Data b => b -> b) -> RecoveryFlow -> RecoveryFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r)
-> (forall u. (forall d. Data d => d -> u) -> RecoveryFlow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecoveryFlow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow)
-> Data RecoveryFlow
RecoveryFlow -> DataType
RecoveryFlow -> Constr
(forall b. Data b => b -> b) -> RecoveryFlow -> RecoveryFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryFlow -> c RecoveryFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RecoveryFlow -> u
forall u. (forall d. Data d => d -> u) -> RecoveryFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryFlow -> c RecoveryFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlow)
$cRecoveryFlow :: Constr
$tRecoveryFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
gmapMp :: (forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
gmapM :: (forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecoveryFlow -> m RecoveryFlow
gmapQi :: Int -> (forall d. Data d => d -> u) -> RecoveryFlow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecoveryFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> RecoveryFlow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecoveryFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlow -> r
gmapT :: (forall b. Data b => b -> b) -> RecoveryFlow -> RecoveryFlow
$cgmapT :: (forall b. Data b => b -> b) -> RecoveryFlow -> RecoveryFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlow)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RecoveryFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryFlow)
dataTypeOf :: RecoveryFlow -> DataType
$cdataTypeOf :: RecoveryFlow -> DataType
toConstr :: RecoveryFlow -> Constr
$ctoConstr :: RecoveryFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryFlow -> c RecoveryFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryFlow -> c RecoveryFlow
$cp1Data :: Typeable RecoveryFlow
Data)

instance FromJSON RecoveryFlow where
  parseJSON :: Value -> Parser RecoveryFlow
parseJSON =
    Options -> Value -> Parser RecoveryFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON RecoveryFlow where
  toEncoding :: RecoveryFlow -> Encoding
toEncoding =
    Options -> RecoveryFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- |
data RecoveryFlowMethod = RecoveryFlowMethod
  { -- |
    RecoveryFlowMethod -> RecoveryFlowMethodConfig
config :: RecoveryFlowMethodConfig,
    -- | Method contains the request credentials type.
    RecoveryFlowMethod -> Text
method :: Text
  }
  deriving stock (Int -> RecoveryFlowMethod -> String -> String
[RecoveryFlowMethod] -> String -> String
RecoveryFlowMethod -> String
(Int -> RecoveryFlowMethod -> String -> String)
-> (RecoveryFlowMethod -> String)
-> ([RecoveryFlowMethod] -> String -> String)
-> Show RecoveryFlowMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RecoveryFlowMethod] -> String -> String
$cshowList :: [RecoveryFlowMethod] -> String -> String
show :: RecoveryFlowMethod -> String
$cshow :: RecoveryFlowMethod -> String
showsPrec :: Int -> RecoveryFlowMethod -> String -> String
$cshowsPrec :: Int -> RecoveryFlowMethod -> String -> String
Show, RecoveryFlowMethod -> RecoveryFlowMethod -> Bool
(RecoveryFlowMethod -> RecoveryFlowMethod -> Bool)
-> (RecoveryFlowMethod -> RecoveryFlowMethod -> Bool)
-> Eq RecoveryFlowMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecoveryFlowMethod -> RecoveryFlowMethod -> Bool
$c/= :: RecoveryFlowMethod -> RecoveryFlowMethod -> Bool
== :: RecoveryFlowMethod -> RecoveryFlowMethod -> Bool
$c== :: RecoveryFlowMethod -> RecoveryFlowMethod -> Bool
Eq, (forall x. RecoveryFlowMethod -> Rep RecoveryFlowMethod x)
-> (forall x. Rep RecoveryFlowMethod x -> RecoveryFlowMethod)
-> Generic RecoveryFlowMethod
forall x. Rep RecoveryFlowMethod x -> RecoveryFlowMethod
forall x. RecoveryFlowMethod -> Rep RecoveryFlowMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecoveryFlowMethod x -> RecoveryFlowMethod
$cfrom :: forall x. RecoveryFlowMethod -> Rep RecoveryFlowMethod x
Generic, Typeable RecoveryFlowMethod
DataType
Constr
Typeable RecoveryFlowMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RecoveryFlowMethod
    -> c RecoveryFlowMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethod)
-> (RecoveryFlowMethod -> Constr)
-> (RecoveryFlowMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecoveryFlowMethod))
-> ((forall b. Data b => b -> b)
    -> RecoveryFlowMethod -> RecoveryFlowMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RecoveryFlowMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecoveryFlowMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RecoveryFlowMethod -> m RecoveryFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecoveryFlowMethod -> m RecoveryFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecoveryFlowMethod -> m RecoveryFlowMethod)
-> Data RecoveryFlowMethod
RecoveryFlowMethod -> DataType
RecoveryFlowMethod -> Constr
(forall b. Data b => b -> b)
-> RecoveryFlowMethod -> RecoveryFlowMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethod
-> c RecoveryFlowMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RecoveryFlowMethod -> u
forall u. (forall d. Data d => d -> u) -> RecoveryFlowMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethod
-> c RecoveryFlowMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlowMethod)
$cRecoveryFlowMethod :: Constr
$tRecoveryFlowMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
gmapMp :: (forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
gmapM :: (forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethod -> m RecoveryFlowMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> RecoveryFlowMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RecoveryFlowMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> RecoveryFlowMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecoveryFlowMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryFlowMethod -> r
gmapT :: (forall b. Data b => b -> b)
-> RecoveryFlowMethod -> RecoveryFlowMethod
$cgmapT :: (forall b. Data b => b -> b)
-> RecoveryFlowMethod -> RecoveryFlowMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlowMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlowMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethod)
dataTypeOf :: RecoveryFlowMethod -> DataType
$cdataTypeOf :: RecoveryFlowMethod -> DataType
toConstr :: RecoveryFlowMethod -> Constr
$ctoConstr :: RecoveryFlowMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethod
-> c RecoveryFlowMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethod
-> c RecoveryFlowMethod
$cp1Data :: Typeable RecoveryFlowMethod
Data)

instance FromJSON RecoveryFlowMethod

instance ToJSON RecoveryFlowMethod where
  toEncoding :: RecoveryFlowMethod -> Encoding
toEncoding = Options -> RecoveryFlowMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data RecoveryFlowMethodConfig = RecoveryFlowMethodConfig
  { -- | Action should be used as the form action URL `<form action=\"{{ .Action }}\" method=\"post\">`.
    RecoveryFlowMethodConfig -> Text
action :: Text,
    -- | Fields contains multiple fields
    RecoveryFlowMethodConfig -> [FormField]
fields :: [FormField],
    -- |
    RecoveryFlowMethodConfig -> Maybe [Message]
messages :: Maybe [Message],
    -- | Method is the form method (e.g. POST)
    RecoveryFlowMethodConfig -> Text
method :: Text
  }
  deriving stock (Int -> RecoveryFlowMethodConfig -> String -> String
[RecoveryFlowMethodConfig] -> String -> String
RecoveryFlowMethodConfig -> String
(Int -> RecoveryFlowMethodConfig -> String -> String)
-> (RecoveryFlowMethodConfig -> String)
-> ([RecoveryFlowMethodConfig] -> String -> String)
-> Show RecoveryFlowMethodConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RecoveryFlowMethodConfig] -> String -> String
$cshowList :: [RecoveryFlowMethodConfig] -> String -> String
show :: RecoveryFlowMethodConfig -> String
$cshow :: RecoveryFlowMethodConfig -> String
showsPrec :: Int -> RecoveryFlowMethodConfig -> String -> String
$cshowsPrec :: Int -> RecoveryFlowMethodConfig -> String -> String
Show, RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool
(RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool)
-> (RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool)
-> Eq RecoveryFlowMethodConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool
$c/= :: RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool
== :: RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool
$c== :: RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig -> Bool
Eq, (forall x.
 RecoveryFlowMethodConfig -> Rep RecoveryFlowMethodConfig x)
-> (forall x.
    Rep RecoveryFlowMethodConfig x -> RecoveryFlowMethodConfig)
-> Generic RecoveryFlowMethodConfig
forall x.
Rep RecoveryFlowMethodConfig x -> RecoveryFlowMethodConfig
forall x.
RecoveryFlowMethodConfig -> Rep RecoveryFlowMethodConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RecoveryFlowMethodConfig x -> RecoveryFlowMethodConfig
$cfrom :: forall x.
RecoveryFlowMethodConfig -> Rep RecoveryFlowMethodConfig x
Generic, Typeable RecoveryFlowMethodConfig
DataType
Constr
Typeable RecoveryFlowMethodConfig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RecoveryFlowMethodConfig
    -> c RecoveryFlowMethodConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethodConfig)
-> (RecoveryFlowMethodConfig -> Constr)
-> (RecoveryFlowMethodConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RecoveryFlowMethodConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecoveryFlowMethodConfig))
-> ((forall b. Data b => b -> b)
    -> RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RecoveryFlowMethodConfig
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RecoveryFlowMethodConfig
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig)
-> Data RecoveryFlowMethodConfig
RecoveryFlowMethodConfig -> DataType
RecoveryFlowMethodConfig -> Constr
(forall b. Data b => b -> b)
-> RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethodConfig
-> c RecoveryFlowMethodConfig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethodConfig
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> u
forall u.
(forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RecoveryFlowMethodConfig
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RecoveryFlowMethodConfig
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethodConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethodConfig
-> c RecoveryFlowMethodConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethodConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlowMethodConfig)
$cRecoveryFlowMethodConfig :: Constr
$tRecoveryFlowMethodConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
gmapMp :: (forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
gmapM :: (forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecoveryFlowMethodConfig -> m RecoveryFlowMethodConfig
gmapQi :: Int
-> (forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> u
gmapQ :: (forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RecoveryFlowMethodConfig -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RecoveryFlowMethodConfig
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RecoveryFlowMethodConfig
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RecoveryFlowMethodConfig
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RecoveryFlowMethodConfig
-> r
gmapT :: (forall b. Data b => b -> b)
-> RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig
$cgmapT :: (forall b. Data b => b -> b)
-> RecoveryFlowMethodConfig -> RecoveryFlowMethodConfig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlowMethodConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryFlowMethodConfig)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethodConfig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryFlowMethodConfig)
dataTypeOf :: RecoveryFlowMethodConfig -> DataType
$cdataTypeOf :: RecoveryFlowMethodConfig -> DataType
toConstr :: RecoveryFlowMethodConfig -> Constr
$ctoConstr :: RecoveryFlowMethodConfig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethodConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryFlowMethodConfig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethodConfig
-> c RecoveryFlowMethodConfig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecoveryFlowMethodConfig
-> c RecoveryFlowMethodConfig
$cp1Data :: Typeable RecoveryFlowMethodConfig
Data)

instance FromJSON RecoveryFlowMethodConfig

instance ToJSON RecoveryFlowMethodConfig where
  toEncoding :: RecoveryFlowMethodConfig -> Encoding
toEncoding = Options -> RecoveryFlowMethodConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data RecoveryLink = RecoveryLink
  { -- | Recovery Link Expires At  The timestamp when the recovery link expires.
    RecoveryLink -> Maybe UTCTime
expires_at :: Maybe UTCTime,
    -- | Recovery Link  This link can be used to recover the account.
    RecoveryLink -> Text
recovery_link :: Text
  }
  deriving stock (Int -> RecoveryLink -> String -> String
[RecoveryLink] -> String -> String
RecoveryLink -> String
(Int -> RecoveryLink -> String -> String)
-> (RecoveryLink -> String)
-> ([RecoveryLink] -> String -> String)
-> Show RecoveryLink
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RecoveryLink] -> String -> String
$cshowList :: [RecoveryLink] -> String -> String
show :: RecoveryLink -> String
$cshow :: RecoveryLink -> String
showsPrec :: Int -> RecoveryLink -> String -> String
$cshowsPrec :: Int -> RecoveryLink -> String -> String
Show, RecoveryLink -> RecoveryLink -> Bool
(RecoveryLink -> RecoveryLink -> Bool)
-> (RecoveryLink -> RecoveryLink -> Bool) -> Eq RecoveryLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecoveryLink -> RecoveryLink -> Bool
$c/= :: RecoveryLink -> RecoveryLink -> Bool
== :: RecoveryLink -> RecoveryLink -> Bool
$c== :: RecoveryLink -> RecoveryLink -> Bool
Eq, (forall x. RecoveryLink -> Rep RecoveryLink x)
-> (forall x. Rep RecoveryLink x -> RecoveryLink)
-> Generic RecoveryLink
forall x. Rep RecoveryLink x -> RecoveryLink
forall x. RecoveryLink -> Rep RecoveryLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecoveryLink x -> RecoveryLink
$cfrom :: forall x. RecoveryLink -> Rep RecoveryLink x
Generic, Typeable RecoveryLink
DataType
Constr
Typeable RecoveryLink
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RecoveryLink -> c RecoveryLink)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecoveryLink)
-> (RecoveryLink -> Constr)
-> (RecoveryLink -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecoveryLink))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecoveryLink))
-> ((forall b. Data b => b -> b) -> RecoveryLink -> RecoveryLink)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r)
-> (forall u. (forall d. Data d => d -> u) -> RecoveryLink -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecoveryLink -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink)
-> Data RecoveryLink
RecoveryLink -> DataType
RecoveryLink -> Constr
(forall b. Data b => b -> b) -> RecoveryLink -> RecoveryLink
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryLink -> c RecoveryLink
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryLink
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RecoveryLink -> u
forall u. (forall d. Data d => d -> u) -> RecoveryLink -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryLink
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryLink -> c RecoveryLink
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryLink)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryLink)
$cRecoveryLink :: Constr
$tRecoveryLink :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
gmapMp :: (forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
gmapM :: (forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecoveryLink -> m RecoveryLink
gmapQi :: Int -> (forall d. Data d => d -> u) -> RecoveryLink -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecoveryLink -> u
gmapQ :: (forall d. Data d => d -> u) -> RecoveryLink -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecoveryLink -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecoveryLink -> r
gmapT :: (forall b. Data b => b -> b) -> RecoveryLink -> RecoveryLink
$cgmapT :: (forall b. Data b => b -> b) -> RecoveryLink -> RecoveryLink
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryLink)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecoveryLink)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RecoveryLink)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecoveryLink)
dataTypeOf :: RecoveryLink -> DataType
$cdataTypeOf :: RecoveryLink -> DataType
toConstr :: RecoveryLink -> Constr
$ctoConstr :: RecoveryLink -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryLink
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecoveryLink
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryLink -> c RecoveryLink
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecoveryLink -> c RecoveryLink
$cp1Data :: Typeable RecoveryLink
Data)

instance FromJSON RecoveryLink

instance ToJSON RecoveryLink where
  toEncoding :: RecoveryLink -> Encoding
toEncoding = Options -> RecoveryLink -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data RegistrationFlow = RegistrationFlow
  { -- | and so on.
    RegistrationFlow -> Maybe Text
active :: Maybe Text,
    -- | ExpiresAt is the time (UTC) when the flow expires. If the user still wishes to log in, a new flow has to be initiated.
    RegistrationFlow -> UTCTime
expires_at :: UTCTime,
    -- |
    RegistrationFlow -> Text
id :: Text,
    -- | IssuedAt is the time (UTC) when the flow occurred.
    RegistrationFlow -> UTCTime
issued_at :: UTCTime,
    -- |
    RegistrationFlow -> Maybe [Message]
messages :: Maybe [Message],
    -- | Methods contains context for all enabled registration methods. If a registration flow has been processed, but for example the password is incorrect, this will contain error messages.
    RegistrationFlow -> Map String RegistrationFlowMethod
methods :: Map.Map String RegistrationFlowMethod,
    -- | RequestURL is the initial URL that was requested from ORY Kratos. It can be used to forward information contained in the URL's path or query for example.
    RegistrationFlow -> Text
request_url :: Text,
    -- | The flow type can either be `api` or `browser`.
    RegistrationFlow -> Maybe Text
_type :: Maybe Text
  }
  deriving stock (Int -> RegistrationFlow -> String -> String
[RegistrationFlow] -> String -> String
RegistrationFlow -> String
(Int -> RegistrationFlow -> String -> String)
-> (RegistrationFlow -> String)
-> ([RegistrationFlow] -> String -> String)
-> Show RegistrationFlow
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegistrationFlow] -> String -> String
$cshowList :: [RegistrationFlow] -> String -> String
show :: RegistrationFlow -> String
$cshow :: RegistrationFlow -> String
showsPrec :: Int -> RegistrationFlow -> String -> String
$cshowsPrec :: Int -> RegistrationFlow -> String -> String
Show, RegistrationFlow -> RegistrationFlow -> Bool
(RegistrationFlow -> RegistrationFlow -> Bool)
-> (RegistrationFlow -> RegistrationFlow -> Bool)
-> Eq RegistrationFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegistrationFlow -> RegistrationFlow -> Bool
$c/= :: RegistrationFlow -> RegistrationFlow -> Bool
== :: RegistrationFlow -> RegistrationFlow -> Bool
$c== :: RegistrationFlow -> RegistrationFlow -> Bool
Eq, (forall x. RegistrationFlow -> Rep RegistrationFlow x)
-> (forall x. Rep RegistrationFlow x -> RegistrationFlow)
-> Generic RegistrationFlow
forall x. Rep RegistrationFlow x -> RegistrationFlow
forall x. RegistrationFlow -> Rep RegistrationFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegistrationFlow x -> RegistrationFlow
$cfrom :: forall x. RegistrationFlow -> Rep RegistrationFlow x
Generic, Typeable RegistrationFlow
DataType
Constr
Typeable RegistrationFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RegistrationFlow -> c RegistrationFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RegistrationFlow)
-> (RegistrationFlow -> Constr)
-> (RegistrationFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RegistrationFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RegistrationFlow))
-> ((forall b. Data b => b -> b)
    -> RegistrationFlow -> RegistrationFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RegistrationFlow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RegistrationFlow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlow -> m RegistrationFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlow -> m RegistrationFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlow -> m RegistrationFlow)
-> Data RegistrationFlow
RegistrationFlow -> DataType
RegistrationFlow -> Constr
(forall b. Data b => b -> b)
-> RegistrationFlow -> RegistrationFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegistrationFlow -> c RegistrationFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RegistrationFlow -> u
forall u. (forall d. Data d => d -> u) -> RegistrationFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegistrationFlow -> c RegistrationFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegistrationFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlow)
$cRegistrationFlow :: Constr
$tRegistrationFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
gmapMp :: (forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
gmapM :: (forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationFlow -> m RegistrationFlow
gmapQi :: Int -> (forall d. Data d => d -> u) -> RegistrationFlow -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RegistrationFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> RegistrationFlow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RegistrationFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RegistrationFlow -> r
gmapT :: (forall b. Data b => b -> b)
-> RegistrationFlow -> RegistrationFlow
$cgmapT :: (forall b. Data b => b -> b)
-> RegistrationFlow -> RegistrationFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlow)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RegistrationFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegistrationFlow)
dataTypeOf :: RegistrationFlow -> DataType
$cdataTypeOf :: RegistrationFlow -> DataType
toConstr :: RegistrationFlow -> Constr
$ctoConstr :: RegistrationFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegistrationFlow -> c RegistrationFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RegistrationFlow -> c RegistrationFlow
$cp1Data :: Typeable RegistrationFlow
Data)

instance FromJSON RegistrationFlow where
  parseJSON :: Value -> Parser RegistrationFlow
parseJSON =
    Options -> Value -> Parser RegistrationFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON RegistrationFlow where
  toEncoding :: RegistrationFlow -> Encoding
toEncoding =
    Options -> RegistrationFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- |
data RegistrationFlowMethod = RegistrationFlowMethod
  { -- |
    RegistrationFlowMethod -> RegistrationFlowMethodConfig
config :: RegistrationFlowMethodConfig,
    -- | and so on.
    RegistrationFlowMethod -> Text
method :: Text
  }
  deriving stock (Int -> RegistrationFlowMethod -> String -> String
[RegistrationFlowMethod] -> String -> String
RegistrationFlowMethod -> String
(Int -> RegistrationFlowMethod -> String -> String)
-> (RegistrationFlowMethod -> String)
-> ([RegistrationFlowMethod] -> String -> String)
-> Show RegistrationFlowMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegistrationFlowMethod] -> String -> String
$cshowList :: [RegistrationFlowMethod] -> String -> String
show :: RegistrationFlowMethod -> String
$cshow :: RegistrationFlowMethod -> String
showsPrec :: Int -> RegistrationFlowMethod -> String -> String
$cshowsPrec :: Int -> RegistrationFlowMethod -> String -> String
Show, RegistrationFlowMethod -> RegistrationFlowMethod -> Bool
(RegistrationFlowMethod -> RegistrationFlowMethod -> Bool)
-> (RegistrationFlowMethod -> RegistrationFlowMethod -> Bool)
-> Eq RegistrationFlowMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegistrationFlowMethod -> RegistrationFlowMethod -> Bool
$c/= :: RegistrationFlowMethod -> RegistrationFlowMethod -> Bool
== :: RegistrationFlowMethod -> RegistrationFlowMethod -> Bool
$c== :: RegistrationFlowMethod -> RegistrationFlowMethod -> Bool
Eq, (forall x. RegistrationFlowMethod -> Rep RegistrationFlowMethod x)
-> (forall x.
    Rep RegistrationFlowMethod x -> RegistrationFlowMethod)
-> Generic RegistrationFlowMethod
forall x. Rep RegistrationFlowMethod x -> RegistrationFlowMethod
forall x. RegistrationFlowMethod -> Rep RegistrationFlowMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegistrationFlowMethod x -> RegistrationFlowMethod
$cfrom :: forall x. RegistrationFlowMethod -> Rep RegistrationFlowMethod x
Generic, Typeable RegistrationFlowMethod
DataType
Constr
Typeable RegistrationFlowMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RegistrationFlowMethod
    -> c RegistrationFlowMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethod)
-> (RegistrationFlowMethod -> Constr)
-> (RegistrationFlowMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RegistrationFlowMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RegistrationFlowMethod))
-> ((forall b. Data b => b -> b)
    -> RegistrationFlowMethod -> RegistrationFlowMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RegistrationFlowMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RegistrationFlowMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RegistrationFlowMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RegistrationFlowMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlowMethod -> m RegistrationFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlowMethod -> m RegistrationFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlowMethod -> m RegistrationFlowMethod)
-> Data RegistrationFlowMethod
RegistrationFlowMethod -> DataType
RegistrationFlowMethod -> Constr
(forall b. Data b => b -> b)
-> RegistrationFlowMethod -> RegistrationFlowMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethod
-> c RegistrationFlowMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RegistrationFlowMethod -> u
forall u.
(forall d. Data d => d -> u) -> RegistrationFlowMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethod
-> c RegistrationFlowMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegistrationFlowMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlowMethod)
$cRegistrationFlowMethod :: Constr
$tRegistrationFlowMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
gmapMp :: (forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
gmapM :: (forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethod -> m RegistrationFlowMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> RegistrationFlowMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RegistrationFlowMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> RegistrationFlowMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RegistrationFlowMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> RegistrationFlowMethod -> RegistrationFlowMethod
$cgmapT :: (forall b. Data b => b -> b)
-> RegistrationFlowMethod -> RegistrationFlowMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlowMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlowMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RegistrationFlowMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RegistrationFlowMethod)
dataTypeOf :: RegistrationFlowMethod -> DataType
$cdataTypeOf :: RegistrationFlowMethod -> DataType
toConstr :: RegistrationFlowMethod -> Constr
$ctoConstr :: RegistrationFlowMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethod
-> c RegistrationFlowMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethod
-> c RegistrationFlowMethod
$cp1Data :: Typeable RegistrationFlowMethod
Data)

instance FromJSON RegistrationFlowMethod

instance ToJSON RegistrationFlowMethod where
  toEncoding :: RegistrationFlowMethod -> Encoding
toEncoding = Options -> RegistrationFlowMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data RegistrationFlowMethodConfig = RegistrationFlowMethodConfig
  { -- | Action should be used as the form action URL `<form action=\"{{ .Action }}\" method=\"post\">`.
    RegistrationFlowMethodConfig -> Text
action :: Text,
    -- | Fields contains multiple fields
    RegistrationFlowMethodConfig -> [FormField]
fields :: [FormField],
    -- |
    RegistrationFlowMethodConfig -> Maybe [Message]
messages :: Maybe [Message],
    -- | Method is the form method (e.g. POST)
    RegistrationFlowMethodConfig -> Text
method :: Text,
    -- | Providers is set for the \"oidc\" registration method.
    RegistrationFlowMethodConfig -> Maybe [FormField]
providers :: Maybe [FormField]
  }
  deriving stock (Int -> RegistrationFlowMethodConfig -> String -> String
[RegistrationFlowMethodConfig] -> String -> String
RegistrationFlowMethodConfig -> String
(Int -> RegistrationFlowMethodConfig -> String -> String)
-> (RegistrationFlowMethodConfig -> String)
-> ([RegistrationFlowMethodConfig] -> String -> String)
-> Show RegistrationFlowMethodConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegistrationFlowMethodConfig] -> String -> String
$cshowList :: [RegistrationFlowMethodConfig] -> String -> String
show :: RegistrationFlowMethodConfig -> String
$cshow :: RegistrationFlowMethodConfig -> String
showsPrec :: Int -> RegistrationFlowMethodConfig -> String -> String
$cshowsPrec :: Int -> RegistrationFlowMethodConfig -> String -> String
Show, RegistrationFlowMethodConfig
-> RegistrationFlowMethodConfig -> Bool
(RegistrationFlowMethodConfig
 -> RegistrationFlowMethodConfig -> Bool)
-> (RegistrationFlowMethodConfig
    -> RegistrationFlowMethodConfig -> Bool)
-> Eq RegistrationFlowMethodConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegistrationFlowMethodConfig
-> RegistrationFlowMethodConfig -> Bool
$c/= :: RegistrationFlowMethodConfig
-> RegistrationFlowMethodConfig -> Bool
== :: RegistrationFlowMethodConfig
-> RegistrationFlowMethodConfig -> Bool
$c== :: RegistrationFlowMethodConfig
-> RegistrationFlowMethodConfig -> Bool
Eq, (forall x.
 RegistrationFlowMethodConfig -> Rep RegistrationFlowMethodConfig x)
-> (forall x.
    Rep RegistrationFlowMethodConfig x -> RegistrationFlowMethodConfig)
-> Generic RegistrationFlowMethodConfig
forall x.
Rep RegistrationFlowMethodConfig x -> RegistrationFlowMethodConfig
forall x.
RegistrationFlowMethodConfig -> Rep RegistrationFlowMethodConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegistrationFlowMethodConfig x -> RegistrationFlowMethodConfig
$cfrom :: forall x.
RegistrationFlowMethodConfig -> Rep RegistrationFlowMethodConfig x
Generic, Typeable RegistrationFlowMethodConfig
DataType
Constr
Typeable RegistrationFlowMethodConfig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RegistrationFlowMethodConfig
    -> c RegistrationFlowMethodConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c RegistrationFlowMethodConfig)
-> (RegistrationFlowMethodConfig -> Constr)
-> (RegistrationFlowMethodConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RegistrationFlowMethodConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RegistrationFlowMethodConfig))
-> ((forall b. Data b => b -> b)
    -> RegistrationFlowMethodConfig -> RegistrationFlowMethodConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RegistrationFlowMethodConfig
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RegistrationFlowMethodConfig
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> RegistrationFlowMethodConfig -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> RegistrationFlowMethodConfig
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig)
-> Data RegistrationFlowMethodConfig
RegistrationFlowMethodConfig -> DataType
RegistrationFlowMethodConfig -> Constr
(forall b. Data b => b -> b)
-> RegistrationFlowMethodConfig -> RegistrationFlowMethodConfig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethodConfig
-> c RegistrationFlowMethodConfig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethodConfig
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> RegistrationFlowMethodConfig
-> u
forall u.
(forall d. Data d => d -> u) -> RegistrationFlowMethodConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethodConfig
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethodConfig
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethodConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethodConfig
-> c RegistrationFlowMethodConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RegistrationFlowMethodConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlowMethodConfig)
$cRegistrationFlowMethodConfig :: Constr
$tRegistrationFlowMethodConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
gmapMp :: (forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
gmapM :: (forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationFlowMethodConfig -> m RegistrationFlowMethodConfig
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> RegistrationFlowMethodConfig
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> RegistrationFlowMethodConfig
-> u
gmapQ :: (forall d. Data d => d -> u) -> RegistrationFlowMethodConfig -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RegistrationFlowMethodConfig -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethodConfig
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethodConfig
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethodConfig
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationFlowMethodConfig
-> r
gmapT :: (forall b. Data b => b -> b)
-> RegistrationFlowMethodConfig -> RegistrationFlowMethodConfig
$cgmapT :: (forall b. Data b => b -> b)
-> RegistrationFlowMethodConfig -> RegistrationFlowMethodConfig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlowMethodConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationFlowMethodConfig)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c RegistrationFlowMethodConfig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RegistrationFlowMethodConfig)
dataTypeOf :: RegistrationFlowMethodConfig -> DataType
$cdataTypeOf :: RegistrationFlowMethodConfig -> DataType
toConstr :: RegistrationFlowMethodConfig -> Constr
$ctoConstr :: RegistrationFlowMethodConfig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethodConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationFlowMethodConfig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethodConfig
-> c RegistrationFlowMethodConfig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationFlowMethodConfig
-> c RegistrationFlowMethodConfig
$cp1Data :: Typeable RegistrationFlowMethodConfig
Data)

instance FromJSON RegistrationFlowMethodConfig

instance ToJSON RegistrationFlowMethodConfig where
  toEncoding :: RegistrationFlowMethodConfig -> Encoding
toEncoding = Options -> RegistrationFlowMethodConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | The Response for Registration Flows via API
data RegistrationViaApiResponse = RegistrationViaApiResponse
  { -- |
    RegistrationViaApiResponse -> Identity
identity :: Identity,
    -- |
    RegistrationViaApiResponse -> Maybe Session
session :: Maybe Session,
    -- | The Session Token  This field is only set when the session hook is configured as a post-registration hook.  A session token is equivalent to a session cookie, but it can be sent in the HTTP Authorization Header:  Authorization: bearer ${session-token}  The session token is only issued for API flows, not for Browser flows!
    RegistrationViaApiResponse -> Text
session_token :: Text
  }
  deriving stock (Int -> RegistrationViaApiResponse -> String -> String
[RegistrationViaApiResponse] -> String -> String
RegistrationViaApiResponse -> String
(Int -> RegistrationViaApiResponse -> String -> String)
-> (RegistrationViaApiResponse -> String)
-> ([RegistrationViaApiResponse] -> String -> String)
-> Show RegistrationViaApiResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RegistrationViaApiResponse] -> String -> String
$cshowList :: [RegistrationViaApiResponse] -> String -> String
show :: RegistrationViaApiResponse -> String
$cshow :: RegistrationViaApiResponse -> String
showsPrec :: Int -> RegistrationViaApiResponse -> String -> String
$cshowsPrec :: Int -> RegistrationViaApiResponse -> String -> String
Show, RegistrationViaApiResponse -> RegistrationViaApiResponse -> Bool
(RegistrationViaApiResponse -> RegistrationViaApiResponse -> Bool)
-> (RegistrationViaApiResponse
    -> RegistrationViaApiResponse -> Bool)
-> Eq RegistrationViaApiResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegistrationViaApiResponse -> RegistrationViaApiResponse -> Bool
$c/= :: RegistrationViaApiResponse -> RegistrationViaApiResponse -> Bool
== :: RegistrationViaApiResponse -> RegistrationViaApiResponse -> Bool
$c== :: RegistrationViaApiResponse -> RegistrationViaApiResponse -> Bool
Eq, (forall x.
 RegistrationViaApiResponse -> Rep RegistrationViaApiResponse x)
-> (forall x.
    Rep RegistrationViaApiResponse x -> RegistrationViaApiResponse)
-> Generic RegistrationViaApiResponse
forall x.
Rep RegistrationViaApiResponse x -> RegistrationViaApiResponse
forall x.
RegistrationViaApiResponse -> Rep RegistrationViaApiResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegistrationViaApiResponse x -> RegistrationViaApiResponse
$cfrom :: forall x.
RegistrationViaApiResponse -> Rep RegistrationViaApiResponse x
Generic, Typeable RegistrationViaApiResponse
DataType
Constr
Typeable RegistrationViaApiResponse
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RegistrationViaApiResponse
    -> c RegistrationViaApiResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RegistrationViaApiResponse)
-> (RegistrationViaApiResponse -> Constr)
-> (RegistrationViaApiResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c RegistrationViaApiResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RegistrationViaApiResponse))
-> ((forall b. Data b => b -> b)
    -> RegistrationViaApiResponse -> RegistrationViaApiResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RegistrationViaApiResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> RegistrationViaApiResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RegistrationViaApiResponse -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> RegistrationViaApiResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RegistrationViaApiResponse -> m RegistrationViaApiResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationViaApiResponse -> m RegistrationViaApiResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RegistrationViaApiResponse -> m RegistrationViaApiResponse)
-> Data RegistrationViaApiResponse
RegistrationViaApiResponse -> DataType
RegistrationViaApiResponse -> Constr
(forall b. Data b => b -> b)
-> RegistrationViaApiResponse -> RegistrationViaApiResponse
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationViaApiResponse
-> c RegistrationViaApiResponse
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationViaApiResponse
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> RegistrationViaApiResponse -> u
forall u.
(forall d. Data d => d -> u) -> RegistrationViaApiResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationViaApiResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationViaApiResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationViaApiResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationViaApiResponse
-> c RegistrationViaApiResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RegistrationViaApiResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationViaApiResponse)
$cRegistrationViaApiResponse :: Constr
$tRegistrationViaApiResponse :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
gmapMp :: (forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
gmapM :: (forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RegistrationViaApiResponse -> m RegistrationViaApiResponse
gmapQi :: Int
-> (forall d. Data d => d -> u) -> RegistrationViaApiResponse -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> RegistrationViaApiResponse -> u
gmapQ :: (forall d. Data d => d -> u) -> RegistrationViaApiResponse -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> RegistrationViaApiResponse -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationViaApiResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationViaApiResponse
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationViaApiResponse
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> RegistrationViaApiResponse
-> r
gmapT :: (forall b. Data b => b -> b)
-> RegistrationViaApiResponse -> RegistrationViaApiResponse
$cgmapT :: (forall b. Data b => b -> b)
-> RegistrationViaApiResponse -> RegistrationViaApiResponse
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationViaApiResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RegistrationViaApiResponse)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c RegistrationViaApiResponse)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c RegistrationViaApiResponse)
dataTypeOf :: RegistrationViaApiResponse -> DataType
$cdataTypeOf :: RegistrationViaApiResponse -> DataType
toConstr :: RegistrationViaApiResponse -> Constr
$ctoConstr :: RegistrationViaApiResponse -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationViaApiResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RegistrationViaApiResponse
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationViaApiResponse
-> c RegistrationViaApiResponse
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RegistrationViaApiResponse
-> c RegistrationViaApiResponse
$cp1Data :: Typeable RegistrationViaApiResponse
Data)

instance FromJSON RegistrationViaApiResponse

instance ToJSON RegistrationViaApiResponse where
  toEncoding :: RegistrationViaApiResponse -> Encoding
toEncoding = Options -> RegistrationViaApiResponse -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data RevokeSession = RevokeSession
  { -- | The Session Token  Invalidate this session token.
    RevokeSession -> Text
session_token :: Text
  }
  deriving stock (Int -> RevokeSession -> String -> String
[RevokeSession] -> String -> String
RevokeSession -> String
(Int -> RevokeSession -> String -> String)
-> (RevokeSession -> String)
-> ([RevokeSession] -> String -> String)
-> Show RevokeSession
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RevokeSession] -> String -> String
$cshowList :: [RevokeSession] -> String -> String
show :: RevokeSession -> String
$cshow :: RevokeSession -> String
showsPrec :: Int -> RevokeSession -> String -> String
$cshowsPrec :: Int -> RevokeSession -> String -> String
Show, RevokeSession -> RevokeSession -> Bool
(RevokeSession -> RevokeSession -> Bool)
-> (RevokeSession -> RevokeSession -> Bool) -> Eq RevokeSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokeSession -> RevokeSession -> Bool
$c/= :: RevokeSession -> RevokeSession -> Bool
== :: RevokeSession -> RevokeSession -> Bool
$c== :: RevokeSession -> RevokeSession -> Bool
Eq, (forall x. RevokeSession -> Rep RevokeSession x)
-> (forall x. Rep RevokeSession x -> RevokeSession)
-> Generic RevokeSession
forall x. Rep RevokeSession x -> RevokeSession
forall x. RevokeSession -> Rep RevokeSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokeSession x -> RevokeSession
$cfrom :: forall x. RevokeSession -> Rep RevokeSession x
Generic, Typeable RevokeSession
DataType
Constr
Typeable RevokeSession
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RevokeSession -> c RevokeSession)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RevokeSession)
-> (RevokeSession -> Constr)
-> (RevokeSession -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RevokeSession))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RevokeSession))
-> ((forall b. Data b => b -> b) -> RevokeSession -> RevokeSession)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RevokeSession -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RevokeSession -> r)
-> (forall u. (forall d. Data d => d -> u) -> RevokeSession -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RevokeSession -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession)
-> Data RevokeSession
RevokeSession -> DataType
RevokeSession -> Constr
(forall b. Data b => b -> b) -> RevokeSession -> RevokeSession
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokeSession -> c RevokeSession
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokeSession
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RevokeSession -> u
forall u. (forall d. Data d => d -> u) -> RevokeSession -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RevokeSession -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RevokeSession -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokeSession
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokeSession -> c RevokeSession
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RevokeSession)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RevokeSession)
$cRevokeSession :: Constr
$tRevokeSession :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
gmapMp :: (forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
gmapM :: (forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RevokeSession -> m RevokeSession
gmapQi :: Int -> (forall d. Data d => d -> u) -> RevokeSession -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RevokeSession -> u
gmapQ :: (forall d. Data d => d -> u) -> RevokeSession -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RevokeSession -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RevokeSession -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RevokeSession -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RevokeSession -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RevokeSession -> r
gmapT :: (forall b. Data b => b -> b) -> RevokeSession -> RevokeSession
$cgmapT :: (forall b. Data b => b -> b) -> RevokeSession -> RevokeSession
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RevokeSession)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RevokeSession)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RevokeSession)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RevokeSession)
dataTypeOf :: RevokeSession -> DataType
$cdataTypeOf :: RevokeSession -> DataType
toConstr :: RevokeSession -> Constr
$ctoConstr :: RevokeSession -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokeSession
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokeSession
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokeSession -> c RevokeSession
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokeSession -> c RevokeSession
$cp1Data :: Typeable RevokeSession
Data)

instance FromJSON RevokeSession

instance ToJSON RevokeSession where
  toEncoding :: RevokeSession -> Encoding
toEncoding = Options -> RevokeSession -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data Session = Session
  { -- |
    Session -> Maybe Bool
active :: Maybe Bool,
    -- |
    Session -> UTCTime
authenticated_at :: UTCTime,
    -- |
    Session -> UTCTime
expires_at :: UTCTime,
    -- |
    Session -> Text
id :: Text,
    -- |
    Session -> Identity
identity :: Identity,
    -- |
    Session -> UTCTime
issued_at :: UTCTime
  }
  deriving stock (Int -> Session -> String -> String
[Session] -> String -> String
Session -> String
(Int -> Session -> String -> String)
-> (Session -> String)
-> ([Session] -> String -> String)
-> Show Session
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Session] -> String -> String
$cshowList :: [Session] -> String -> String
show :: Session -> String
$cshow :: Session -> String
showsPrec :: Int -> Session -> String -> String
$cshowsPrec :: Int -> Session -> String -> String
Show, Session -> Session -> Bool
(Session -> Session -> Bool)
-> (Session -> Session -> Bool) -> Eq Session
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Session -> Session -> Bool
$c/= :: Session -> Session -> Bool
== :: Session -> Session -> Bool
$c== :: Session -> Session -> Bool
Eq, (forall x. Session -> Rep Session x)
-> (forall x. Rep Session x -> Session) -> Generic Session
forall x. Rep Session x -> Session
forall x. Session -> Rep Session x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Session x -> Session
$cfrom :: forall x. Session -> Rep Session x
Generic, Typeable Session
DataType
Constr
Typeable Session
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Session -> c Session)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Session)
-> (Session -> Constr)
-> (Session -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Session))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Session))
-> ((forall b. Data b => b -> b) -> Session -> Session)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Session -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Session -> r)
-> (forall u. (forall d. Data d => d -> u) -> Session -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Session -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Session -> m Session)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Session -> m Session)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Session -> m Session)
-> Data Session
Session -> DataType
Session -> Constr
(forall b. Data b => b -> b) -> Session -> Session
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Session -> c Session
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Session
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Session -> u
forall u. (forall d. Data d => d -> u) -> Session -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Session -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Session -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Session -> m Session
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Session -> m Session
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Session
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Session -> c Session
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Session)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Session)
$cSession :: Constr
$tSession :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Session -> m Session
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Session -> m Session
gmapMp :: (forall d. Data d => d -> m d) -> Session -> m Session
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Session -> m Session
gmapM :: (forall d. Data d => d -> m d) -> Session -> m Session
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Session -> m Session
gmapQi :: Int -> (forall d. Data d => d -> u) -> Session -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Session -> u
gmapQ :: (forall d. Data d => d -> u) -> Session -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Session -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Session -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Session -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Session -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Session -> r
gmapT :: (forall b. Data b => b -> b) -> Session -> Session
$cgmapT :: (forall b. Data b => b -> b) -> Session -> Session
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Session)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Session)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Session)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Session)
dataTypeOf :: Session -> DataType
$cdataTypeOf :: Session -> DataType
toConstr :: Session -> Constr
$ctoConstr :: Session -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Session
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Session
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Session -> c Session
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Session -> c Session
$cp1Data :: Typeable Session
Data)

instance FromJSON Session

instance ToJSON Session where
  toEncoding :: Session -> Encoding
toEncoding = Options -> Session -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | This flow is used when an identity wants to update settings (e.g. profile data, passwords, ...) in a selfservice manner.  We recommend reading the [User Settings Documentation](../self-service/flows/user-settings)
data SettingsFlow = SettingsFlow
  { -- | Active, if set, contains the registration method that is being used. It is initially not set.
    SettingsFlow -> Maybe Text
active :: Maybe Text,
    -- | ExpiresAt is the time (UTC) when the flow expires. If the user still wishes to update the setting, a new flow has to be initiated.
    SettingsFlow -> UTCTime
expires_at :: UTCTime,
    -- |
    SettingsFlow -> Text
id :: Text,
    -- |
    SettingsFlow -> Identity
identity :: Identity,
    -- | IssuedAt is the time (UTC) when the flow occurred.
    SettingsFlow -> UTCTime
issued_at :: UTCTime,
    -- |
    SettingsFlow -> Maybe [Message]
messages :: Maybe [Message],
    -- | Methods contains context for all enabled registration methods. If a settings flow has been processed, but for example the first name is empty, this will contain error messages.
    SettingsFlow -> Map String SettingsFlowMethod
methods :: Map.Map String SettingsFlowMethod,
    -- | RequestURL is the initial URL that was requested from ORY Kratos. It can be used to forward information contained in the URL's path or query for example.
    SettingsFlow -> Text
request_url :: Text,
    -- |
    SettingsFlow -> Text
state :: Text,
    -- | The flow type can either be `api` or `browser`.
    SettingsFlow -> Maybe Text
_type :: Maybe Text
  }
  deriving stock (Int -> SettingsFlow -> String -> String
[SettingsFlow] -> String -> String
SettingsFlow -> String
(Int -> SettingsFlow -> String -> String)
-> (SettingsFlow -> String)
-> ([SettingsFlow] -> String -> String)
-> Show SettingsFlow
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SettingsFlow] -> String -> String
$cshowList :: [SettingsFlow] -> String -> String
show :: SettingsFlow -> String
$cshow :: SettingsFlow -> String
showsPrec :: Int -> SettingsFlow -> String -> String
$cshowsPrec :: Int -> SettingsFlow -> String -> String
Show, SettingsFlow -> SettingsFlow -> Bool
(SettingsFlow -> SettingsFlow -> Bool)
-> (SettingsFlow -> SettingsFlow -> Bool) -> Eq SettingsFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SettingsFlow -> SettingsFlow -> Bool
$c/= :: SettingsFlow -> SettingsFlow -> Bool
== :: SettingsFlow -> SettingsFlow -> Bool
$c== :: SettingsFlow -> SettingsFlow -> Bool
Eq, (forall x. SettingsFlow -> Rep SettingsFlow x)
-> (forall x. Rep SettingsFlow x -> SettingsFlow)
-> Generic SettingsFlow
forall x. Rep SettingsFlow x -> SettingsFlow
forall x. SettingsFlow -> Rep SettingsFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SettingsFlow x -> SettingsFlow
$cfrom :: forall x. SettingsFlow -> Rep SettingsFlow x
Generic, Typeable SettingsFlow
DataType
Constr
Typeable SettingsFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SettingsFlow -> c SettingsFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SettingsFlow)
-> (SettingsFlow -> Constr)
-> (SettingsFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SettingsFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SettingsFlow))
-> ((forall b. Data b => b -> b) -> SettingsFlow -> SettingsFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r)
-> (forall u. (forall d. Data d => d -> u) -> SettingsFlow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SettingsFlow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow)
-> Data SettingsFlow
SettingsFlow -> DataType
SettingsFlow -> Constr
(forall b. Data b => b -> b) -> SettingsFlow -> SettingsFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SettingsFlow -> c SettingsFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SettingsFlow -> u
forall u. (forall d. Data d => d -> u) -> SettingsFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SettingsFlow -> c SettingsFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlow)
$cSettingsFlow :: Constr
$tSettingsFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
gmapMp :: (forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
gmapM :: (forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SettingsFlow -> m SettingsFlow
gmapQi :: Int -> (forall d. Data d => d -> u) -> SettingsFlow -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SettingsFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> SettingsFlow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SettingsFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlow -> r
gmapT :: (forall b. Data b => b -> b) -> SettingsFlow -> SettingsFlow
$cgmapT :: (forall b. Data b => b -> b) -> SettingsFlow -> SettingsFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlow)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SettingsFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsFlow)
dataTypeOf :: SettingsFlow -> DataType
$cdataTypeOf :: SettingsFlow -> DataType
toConstr :: SettingsFlow -> Constr
$ctoConstr :: SettingsFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SettingsFlow -> c SettingsFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SettingsFlow -> c SettingsFlow
$cp1Data :: Typeable SettingsFlow
Data)

instance FromJSON SettingsFlow where
  parseJSON :: Value -> Parser SettingsFlow
parseJSON =
    Options -> Value -> Parser SettingsFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON SettingsFlow where
  toEncoding :: SettingsFlow -> Encoding
toEncoding =
    Options -> SettingsFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- |
data SettingsFlowMethod = SettingsFlowMethod
  { -- |
    SettingsFlowMethod -> SettingsFlowMethodConfig
config :: SettingsFlowMethodConfig,
    -- | Method is the name of this flow method.
    SettingsFlowMethod -> Text
method :: Text
  }
  deriving stock (Int -> SettingsFlowMethod -> String -> String
[SettingsFlowMethod] -> String -> String
SettingsFlowMethod -> String
(Int -> SettingsFlowMethod -> String -> String)
-> (SettingsFlowMethod -> String)
-> ([SettingsFlowMethod] -> String -> String)
-> Show SettingsFlowMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SettingsFlowMethod] -> String -> String
$cshowList :: [SettingsFlowMethod] -> String -> String
show :: SettingsFlowMethod -> String
$cshow :: SettingsFlowMethod -> String
showsPrec :: Int -> SettingsFlowMethod -> String -> String
$cshowsPrec :: Int -> SettingsFlowMethod -> String -> String
Show, SettingsFlowMethod -> SettingsFlowMethod -> Bool
(SettingsFlowMethod -> SettingsFlowMethod -> Bool)
-> (SettingsFlowMethod -> SettingsFlowMethod -> Bool)
-> Eq SettingsFlowMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SettingsFlowMethod -> SettingsFlowMethod -> Bool
$c/= :: SettingsFlowMethod -> SettingsFlowMethod -> Bool
== :: SettingsFlowMethod -> SettingsFlowMethod -> Bool
$c== :: SettingsFlowMethod -> SettingsFlowMethod -> Bool
Eq, (forall x. SettingsFlowMethod -> Rep SettingsFlowMethod x)
-> (forall x. Rep SettingsFlowMethod x -> SettingsFlowMethod)
-> Generic SettingsFlowMethod
forall x. Rep SettingsFlowMethod x -> SettingsFlowMethod
forall x. SettingsFlowMethod -> Rep SettingsFlowMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SettingsFlowMethod x -> SettingsFlowMethod
$cfrom :: forall x. SettingsFlowMethod -> Rep SettingsFlowMethod x
Generic, Typeable SettingsFlowMethod
DataType
Constr
Typeable SettingsFlowMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SettingsFlowMethod
    -> c SettingsFlowMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SettingsFlowMethod)
-> (SettingsFlowMethod -> Constr)
-> (SettingsFlowMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SettingsFlowMethod))
-> ((forall b. Data b => b -> b)
    -> SettingsFlowMethod -> SettingsFlowMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SettingsFlowMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SettingsFlowMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SettingsFlowMethod -> m SettingsFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SettingsFlowMethod -> m SettingsFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SettingsFlowMethod -> m SettingsFlowMethod)
-> Data SettingsFlowMethod
SettingsFlowMethod -> DataType
SettingsFlowMethod -> Constr
(forall b. Data b => b -> b)
-> SettingsFlowMethod -> SettingsFlowMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethod
-> c SettingsFlowMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SettingsFlowMethod -> u
forall u. (forall d. Data d => d -> u) -> SettingsFlowMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethod
-> c SettingsFlowMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlowMethod)
$cSettingsFlowMethod :: Constr
$tSettingsFlowMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
gmapMp :: (forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
gmapM :: (forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethod -> m SettingsFlowMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> SettingsFlowMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SettingsFlowMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> SettingsFlowMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SettingsFlowMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SettingsFlowMethod -> r
gmapT :: (forall b. Data b => b -> b)
-> SettingsFlowMethod -> SettingsFlowMethod
$cgmapT :: (forall b. Data b => b -> b)
-> SettingsFlowMethod -> SettingsFlowMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlowMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlowMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethod)
dataTypeOf :: SettingsFlowMethod -> DataType
$cdataTypeOf :: SettingsFlowMethod -> DataType
toConstr :: SettingsFlowMethod -> Constr
$ctoConstr :: SettingsFlowMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethod
-> c SettingsFlowMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethod
-> c SettingsFlowMethod
$cp1Data :: Typeable SettingsFlowMethod
Data)

instance FromJSON SettingsFlowMethod

instance ToJSON SettingsFlowMethod where
  toEncoding :: SettingsFlowMethod -> Encoding
toEncoding = Options -> SettingsFlowMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data SettingsFlowMethodConfig = SettingsFlowMethodConfig
  { -- | Action should be used as the form action URL `<form action=\"{{ .Action }}\" method=\"post\">`.
    SettingsFlowMethodConfig -> Text
action :: Text,
    -- | Fields contains multiple fields
    SettingsFlowMethodConfig -> [FormField]
fields :: [FormField],
    -- |
    SettingsFlowMethodConfig -> Maybe [Message]
messages :: Maybe [Message],
    -- | Method is the form method (e.g. POST)
    SettingsFlowMethodConfig -> Text
method :: Text
  }
  deriving stock (Int -> SettingsFlowMethodConfig -> String -> String
[SettingsFlowMethodConfig] -> String -> String
SettingsFlowMethodConfig -> String
(Int -> SettingsFlowMethodConfig -> String -> String)
-> (SettingsFlowMethodConfig -> String)
-> ([SettingsFlowMethodConfig] -> String -> String)
-> Show SettingsFlowMethodConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SettingsFlowMethodConfig] -> String -> String
$cshowList :: [SettingsFlowMethodConfig] -> String -> String
show :: SettingsFlowMethodConfig -> String
$cshow :: SettingsFlowMethodConfig -> String
showsPrec :: Int -> SettingsFlowMethodConfig -> String -> String
$cshowsPrec :: Int -> SettingsFlowMethodConfig -> String -> String
Show, SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool
(SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool)
-> (SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool)
-> Eq SettingsFlowMethodConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool
$c/= :: SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool
== :: SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool
$c== :: SettingsFlowMethodConfig -> SettingsFlowMethodConfig -> Bool
Eq, (forall x.
 SettingsFlowMethodConfig -> Rep SettingsFlowMethodConfig x)
-> (forall x.
    Rep SettingsFlowMethodConfig x -> SettingsFlowMethodConfig)
-> Generic SettingsFlowMethodConfig
forall x.
Rep SettingsFlowMethodConfig x -> SettingsFlowMethodConfig
forall x.
SettingsFlowMethodConfig -> Rep SettingsFlowMethodConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SettingsFlowMethodConfig x -> SettingsFlowMethodConfig
$cfrom :: forall x.
SettingsFlowMethodConfig -> Rep SettingsFlowMethodConfig x
Generic, Typeable SettingsFlowMethodConfig
DataType
Constr
Typeable SettingsFlowMethodConfig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SettingsFlowMethodConfig
    -> c SettingsFlowMethodConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SettingsFlowMethodConfig)
-> (SettingsFlowMethodConfig -> Constr)
-> (SettingsFlowMethodConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SettingsFlowMethodConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SettingsFlowMethodConfig))
-> ((forall b. Data b => b -> b)
    -> SettingsFlowMethodConfig -> SettingsFlowMethodConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SettingsFlowMethodConfig
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SettingsFlowMethodConfig
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig)
-> Data SettingsFlowMethodConfig
SettingsFlowMethodConfig -> DataType
SettingsFlowMethodConfig -> Constr
(forall b. Data b => b -> b)
-> SettingsFlowMethodConfig -> SettingsFlowMethodConfig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethodConfig
-> c SettingsFlowMethodConfig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethodConfig
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> u
forall u.
(forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsFlowMethodConfig
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsFlowMethodConfig
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethodConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethodConfig
-> c SettingsFlowMethodConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethodConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlowMethodConfig)
$cSettingsFlowMethodConfig :: Constr
$tSettingsFlowMethodConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
gmapMp :: (forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
gmapM :: (forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SettingsFlowMethodConfig -> m SettingsFlowMethodConfig
gmapQi :: Int
-> (forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> u
gmapQ :: (forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SettingsFlowMethodConfig -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsFlowMethodConfig
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsFlowMethodConfig
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsFlowMethodConfig
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsFlowMethodConfig
-> r
gmapT :: (forall b. Data b => b -> b)
-> SettingsFlowMethodConfig -> SettingsFlowMethodConfig
$cgmapT :: (forall b. Data b => b -> b)
-> SettingsFlowMethodConfig -> SettingsFlowMethodConfig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlowMethodConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsFlowMethodConfig)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethodConfig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsFlowMethodConfig)
dataTypeOf :: SettingsFlowMethodConfig -> DataType
$cdataTypeOf :: SettingsFlowMethodConfig -> DataType
toConstr :: SettingsFlowMethodConfig -> Constr
$ctoConstr :: SettingsFlowMethodConfig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethodConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsFlowMethodConfig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethodConfig
-> c SettingsFlowMethodConfig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsFlowMethodConfig
-> c SettingsFlowMethodConfig
$cp1Data :: Typeable SettingsFlowMethodConfig
Data)

instance FromJSON SettingsFlowMethodConfig

instance ToJSON SettingsFlowMethodConfig where
  toEncoding :: SettingsFlowMethodConfig -> Encoding
toEncoding = Options -> SettingsFlowMethodConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | The Response for Settings Flows via API
data SettingsViaApiResponse = SettingsViaApiResponse
  { -- |
    SettingsViaApiResponse -> SettingsFlow
flow :: SettingsFlow,
    -- |
    SettingsViaApiResponse -> Identity
identity :: Identity
  }
  deriving stock (Int -> SettingsViaApiResponse -> String -> String
[SettingsViaApiResponse] -> String -> String
SettingsViaApiResponse -> String
(Int -> SettingsViaApiResponse -> String -> String)
-> (SettingsViaApiResponse -> String)
-> ([SettingsViaApiResponse] -> String -> String)
-> Show SettingsViaApiResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SettingsViaApiResponse] -> String -> String
$cshowList :: [SettingsViaApiResponse] -> String -> String
show :: SettingsViaApiResponse -> String
$cshow :: SettingsViaApiResponse -> String
showsPrec :: Int -> SettingsViaApiResponse -> String -> String
$cshowsPrec :: Int -> SettingsViaApiResponse -> String -> String
Show, SettingsViaApiResponse -> SettingsViaApiResponse -> Bool
(SettingsViaApiResponse -> SettingsViaApiResponse -> Bool)
-> (SettingsViaApiResponse -> SettingsViaApiResponse -> Bool)
-> Eq SettingsViaApiResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SettingsViaApiResponse -> SettingsViaApiResponse -> Bool
$c/= :: SettingsViaApiResponse -> SettingsViaApiResponse -> Bool
== :: SettingsViaApiResponse -> SettingsViaApiResponse -> Bool
$c== :: SettingsViaApiResponse -> SettingsViaApiResponse -> Bool
Eq, (forall x. SettingsViaApiResponse -> Rep SettingsViaApiResponse x)
-> (forall x.
    Rep SettingsViaApiResponse x -> SettingsViaApiResponse)
-> Generic SettingsViaApiResponse
forall x. Rep SettingsViaApiResponse x -> SettingsViaApiResponse
forall x. SettingsViaApiResponse -> Rep SettingsViaApiResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SettingsViaApiResponse x -> SettingsViaApiResponse
$cfrom :: forall x. SettingsViaApiResponse -> Rep SettingsViaApiResponse x
Generic, Typeable SettingsViaApiResponse
DataType
Constr
Typeable SettingsViaApiResponse
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SettingsViaApiResponse
    -> c SettingsViaApiResponse)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SettingsViaApiResponse)
-> (SettingsViaApiResponse -> Constr)
-> (SettingsViaApiResponse -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SettingsViaApiResponse))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SettingsViaApiResponse))
-> ((forall b. Data b => b -> b)
    -> SettingsViaApiResponse -> SettingsViaApiResponse)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SettingsViaApiResponse
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SettingsViaApiResponse
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SettingsViaApiResponse -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SettingsViaApiResponse -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SettingsViaApiResponse -> m SettingsViaApiResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SettingsViaApiResponse -> m SettingsViaApiResponse)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SettingsViaApiResponse -> m SettingsViaApiResponse)
-> Data SettingsViaApiResponse
SettingsViaApiResponse -> DataType
SettingsViaApiResponse -> Constr
(forall b. Data b => b -> b)
-> SettingsViaApiResponse -> SettingsViaApiResponse
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsViaApiResponse
-> c SettingsViaApiResponse
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsViaApiResponse
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SettingsViaApiResponse -> u
forall u.
(forall d. Data d => d -> u) -> SettingsViaApiResponse -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsViaApiResponse
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsViaApiResponse
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsViaApiResponse
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsViaApiResponse
-> c SettingsViaApiResponse
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsViaApiResponse)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsViaApiResponse)
$cSettingsViaApiResponse :: Constr
$tSettingsViaApiResponse :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
gmapMp :: (forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
gmapM :: (forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SettingsViaApiResponse -> m SettingsViaApiResponse
gmapQi :: Int -> (forall d. Data d => d -> u) -> SettingsViaApiResponse -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SettingsViaApiResponse -> u
gmapQ :: (forall d. Data d => d -> u) -> SettingsViaApiResponse -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SettingsViaApiResponse -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsViaApiResponse
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsViaApiResponse
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsViaApiResponse
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SettingsViaApiResponse
-> r
gmapT :: (forall b. Data b => b -> b)
-> SettingsViaApiResponse -> SettingsViaApiResponse
$cgmapT :: (forall b. Data b => b -> b)
-> SettingsViaApiResponse -> SettingsViaApiResponse
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsViaApiResponse)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SettingsViaApiResponse)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SettingsViaApiResponse)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SettingsViaApiResponse)
dataTypeOf :: SettingsViaApiResponse -> DataType
$cdataTypeOf :: SettingsViaApiResponse -> DataType
toConstr :: SettingsViaApiResponse -> Constr
$ctoConstr :: SettingsViaApiResponse -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsViaApiResponse
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SettingsViaApiResponse
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsViaApiResponse
-> c SettingsViaApiResponse
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SettingsViaApiResponse
-> c SettingsViaApiResponse
$cp1Data :: Typeable SettingsViaApiResponse
Data)

instance FromJSON SettingsViaApiResponse

instance ToJSON SettingsViaApiResponse where
  toEncoding :: SettingsViaApiResponse -> Encoding
toEncoding = Options -> SettingsViaApiResponse -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data UpdateIdentity = UpdateIdentity
  { -- | SchemaID is the ID of the JSON Schema to be used for validating the identity's traits. If set will update the Identity's SchemaID.
    UpdateIdentity -> Maybe Text
schema_id :: Maybe Text,
    -- | Traits represent an identity's traits. The identity is able to create, modify, and delete traits in a self-service manner. The input will always be validated against the JSON Schema defined in `schema_id`.
    UpdateIdentity -> Value
traits :: Value
  }
  deriving stock (Int -> UpdateIdentity -> String -> String
[UpdateIdentity] -> String -> String
UpdateIdentity -> String
(Int -> UpdateIdentity -> String -> String)
-> (UpdateIdentity -> String)
-> ([UpdateIdentity] -> String -> String)
-> Show UpdateIdentity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UpdateIdentity] -> String -> String
$cshowList :: [UpdateIdentity] -> String -> String
show :: UpdateIdentity -> String
$cshow :: UpdateIdentity -> String
showsPrec :: Int -> UpdateIdentity -> String -> String
$cshowsPrec :: Int -> UpdateIdentity -> String -> String
Show, UpdateIdentity -> UpdateIdentity -> Bool
(UpdateIdentity -> UpdateIdentity -> Bool)
-> (UpdateIdentity -> UpdateIdentity -> Bool) -> Eq UpdateIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIdentity -> UpdateIdentity -> Bool
$c/= :: UpdateIdentity -> UpdateIdentity -> Bool
== :: UpdateIdentity -> UpdateIdentity -> Bool
$c== :: UpdateIdentity -> UpdateIdentity -> Bool
Eq, (forall x. UpdateIdentity -> Rep UpdateIdentity x)
-> (forall x. Rep UpdateIdentity x -> UpdateIdentity)
-> Generic UpdateIdentity
forall x. Rep UpdateIdentity x -> UpdateIdentity
forall x. UpdateIdentity -> Rep UpdateIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateIdentity x -> UpdateIdentity
$cfrom :: forall x. UpdateIdentity -> Rep UpdateIdentity x
Generic, Typeable UpdateIdentity
DataType
Constr
Typeable UpdateIdentity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UpdateIdentity -> c UpdateIdentity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UpdateIdentity)
-> (UpdateIdentity -> Constr)
-> (UpdateIdentity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UpdateIdentity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c UpdateIdentity))
-> ((forall b. Data b => b -> b)
    -> UpdateIdentity -> UpdateIdentity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> UpdateIdentity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> UpdateIdentity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> UpdateIdentity -> m UpdateIdentity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> UpdateIdentity -> m UpdateIdentity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> UpdateIdentity -> m UpdateIdentity)
-> Data UpdateIdentity
UpdateIdentity -> DataType
UpdateIdentity -> Constr
(forall b. Data b => b -> b) -> UpdateIdentity -> UpdateIdentity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateIdentity -> c UpdateIdentity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateIdentity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> UpdateIdentity -> u
forall u. (forall d. Data d => d -> u) -> UpdateIdentity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateIdentity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateIdentity -> c UpdateIdentity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpdateIdentity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateIdentity)
$cUpdateIdentity :: Constr
$tUpdateIdentity :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
gmapMp :: (forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
gmapM :: (forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> UpdateIdentity -> m UpdateIdentity
gmapQi :: Int -> (forall d. Data d => d -> u) -> UpdateIdentity -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> UpdateIdentity -> u
gmapQ :: (forall d. Data d => d -> u) -> UpdateIdentity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UpdateIdentity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateIdentity -> r
gmapT :: (forall b. Data b => b -> b) -> UpdateIdentity -> UpdateIdentity
$cgmapT :: (forall b. Data b => b -> b) -> UpdateIdentity -> UpdateIdentity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateIdentity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UpdateIdentity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UpdateIdentity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpdateIdentity)
dataTypeOf :: UpdateIdentity -> DataType
$cdataTypeOf :: UpdateIdentity -> DataType
toConstr :: UpdateIdentity -> Constr
$ctoConstr :: UpdateIdentity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateIdentity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateIdentity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateIdentity -> c UpdateIdentity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateIdentity -> c UpdateIdentity
$cp1Data :: Typeable UpdateIdentity
Data)

instance FromJSON UpdateIdentity

instance ToJSON UpdateIdentity where
  toEncoding :: UpdateIdentity -> Encoding
toEncoding = Options -> UpdateIdentity -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data VerifiableAddress = VerifiableAddress
  { -- |
    VerifiableAddress -> Text
id :: Text,
    -- |
    VerifiableAddress -> Text
status :: Text,
    -- |
    VerifiableAddress -> Text
value :: Text,
    -- |
    VerifiableAddress -> Bool
verified :: Bool,
    -- |
    VerifiableAddress -> Maybe UTCTime
verified_at :: Maybe UTCTime,
    -- |
    VerifiableAddress -> Text
via :: Text
  }
  deriving stock (Int -> VerifiableAddress -> String -> String
[VerifiableAddress] -> String -> String
VerifiableAddress -> String
(Int -> VerifiableAddress -> String -> String)
-> (VerifiableAddress -> String)
-> ([VerifiableAddress] -> String -> String)
-> Show VerifiableAddress
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VerifiableAddress] -> String -> String
$cshowList :: [VerifiableAddress] -> String -> String
show :: VerifiableAddress -> String
$cshow :: VerifiableAddress -> String
showsPrec :: Int -> VerifiableAddress -> String -> String
$cshowsPrec :: Int -> VerifiableAddress -> String -> String
Show, VerifiableAddress -> VerifiableAddress -> Bool
(VerifiableAddress -> VerifiableAddress -> Bool)
-> (VerifiableAddress -> VerifiableAddress -> Bool)
-> Eq VerifiableAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifiableAddress -> VerifiableAddress -> Bool
$c/= :: VerifiableAddress -> VerifiableAddress -> Bool
== :: VerifiableAddress -> VerifiableAddress -> Bool
$c== :: VerifiableAddress -> VerifiableAddress -> Bool
Eq, (forall x. VerifiableAddress -> Rep VerifiableAddress x)
-> (forall x. Rep VerifiableAddress x -> VerifiableAddress)
-> Generic VerifiableAddress
forall x. Rep VerifiableAddress x -> VerifiableAddress
forall x. VerifiableAddress -> Rep VerifiableAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerifiableAddress x -> VerifiableAddress
$cfrom :: forall x. VerifiableAddress -> Rep VerifiableAddress x
Generic, Typeable VerifiableAddress
DataType
Constr
Typeable VerifiableAddress
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VerifiableAddress
    -> c VerifiableAddress)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VerifiableAddress)
-> (VerifiableAddress -> Constr)
-> (VerifiableAddress -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VerifiableAddress))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VerifiableAddress))
-> ((forall b. Data b => b -> b)
    -> VerifiableAddress -> VerifiableAddress)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VerifiableAddress -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VerifiableAddress -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VerifiableAddress -> m VerifiableAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerifiableAddress -> m VerifiableAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerifiableAddress -> m VerifiableAddress)
-> Data VerifiableAddress
VerifiableAddress -> DataType
VerifiableAddress -> Constr
(forall b. Data b => b -> b)
-> VerifiableAddress -> VerifiableAddress
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerifiableAddress -> c VerifiableAddress
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableAddress
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> VerifiableAddress -> u
forall u. (forall d. Data d => d -> u) -> VerifiableAddress -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableAddress
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerifiableAddress -> c VerifiableAddress
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VerifiableAddress)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerifiableAddress)
$cVerifiableAddress :: Constr
$tVerifiableAddress :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
gmapMp :: (forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
gmapM :: (forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerifiableAddress -> m VerifiableAddress
gmapQi :: Int -> (forall d. Data d => d -> u) -> VerifiableAddress -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> VerifiableAddress -> u
gmapQ :: (forall d. Data d => d -> u) -> VerifiableAddress -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VerifiableAddress -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VerifiableAddress -> r
gmapT :: (forall b. Data b => b -> b)
-> VerifiableAddress -> VerifiableAddress
$cgmapT :: (forall b. Data b => b -> b)
-> VerifiableAddress -> VerifiableAddress
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerifiableAddress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerifiableAddress)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VerifiableAddress)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VerifiableAddress)
dataTypeOf :: VerifiableAddress -> DataType
$cdataTypeOf :: VerifiableAddress -> DataType
toConstr :: VerifiableAddress -> Constr
$ctoConstr :: VerifiableAddress -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableAddress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableAddress
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerifiableAddress -> c VerifiableAddress
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerifiableAddress -> c VerifiableAddress
$cp1Data :: Typeable VerifiableAddress
Data)

instance FromJSON VerifiableAddress

instance ToJSON VerifiableAddress where
  toEncoding :: VerifiableAddress -> Encoding
toEncoding = Options -> VerifiableAddress -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- | Used to verify an out-of-band communication channel such as an email address or a phone number.  For more information head over to: https://www.ory.sh/docs/kratos/selfservice/flows/verify-email-account-activation
data VerificationFlow = VerificationFlow
  { -- | Active, if set, contains the registration method that is being used. It is initially not set.
    VerificationFlow -> Maybe Text
active :: Maybe Text,
    -- | ExpiresAt is the time (UTC) when the request expires. If the user still wishes to verify the address, a new request has to be initiated.
    VerificationFlow -> Maybe UTCTime
expires_at :: Maybe UTCTime,
    -- |
    VerificationFlow -> Maybe Text
id :: Maybe Text,
    -- | IssuedAt is the time (UTC) when the request occurred.
    VerificationFlow -> Maybe UTCTime
issued_at :: Maybe UTCTime,
    -- |
    VerificationFlow -> Maybe [Message]
messages :: Maybe [Message],
    -- | Methods contains context for all account verification methods. If a registration request has been processed, but for example the password is incorrect, this will contain error messages.
    VerificationFlow -> Map String VerificationFlowMethod
methods :: Map.Map String VerificationFlowMethod,
    -- | RequestURL is the initial URL that was requested from ORY Kratos. It can be used to forward information contained in the URL's path or query for example.
    VerificationFlow -> Maybe Text
request_url :: Maybe Text,
    -- |
    VerificationFlow -> Text
state :: Text,
    -- | The flow type can either be `api` or `browser`.
    VerificationFlow -> Maybe Text
_type :: Maybe Text
  }
  deriving stock (Int -> VerificationFlow -> String -> String
[VerificationFlow] -> String -> String
VerificationFlow -> String
(Int -> VerificationFlow -> String -> String)
-> (VerificationFlow -> String)
-> ([VerificationFlow] -> String -> String)
-> Show VerificationFlow
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VerificationFlow] -> String -> String
$cshowList :: [VerificationFlow] -> String -> String
show :: VerificationFlow -> String
$cshow :: VerificationFlow -> String
showsPrec :: Int -> VerificationFlow -> String -> String
$cshowsPrec :: Int -> VerificationFlow -> String -> String
Show, VerificationFlow -> VerificationFlow -> Bool
(VerificationFlow -> VerificationFlow -> Bool)
-> (VerificationFlow -> VerificationFlow -> Bool)
-> Eq VerificationFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationFlow -> VerificationFlow -> Bool
$c/= :: VerificationFlow -> VerificationFlow -> Bool
== :: VerificationFlow -> VerificationFlow -> Bool
$c== :: VerificationFlow -> VerificationFlow -> Bool
Eq, (forall x. VerificationFlow -> Rep VerificationFlow x)
-> (forall x. Rep VerificationFlow x -> VerificationFlow)
-> Generic VerificationFlow
forall x. Rep VerificationFlow x -> VerificationFlow
forall x. VerificationFlow -> Rep VerificationFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerificationFlow x -> VerificationFlow
$cfrom :: forall x. VerificationFlow -> Rep VerificationFlow x
Generic, Typeable VerificationFlow
DataType
Constr
Typeable VerificationFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> VerificationFlow -> c VerificationFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VerificationFlow)
-> (VerificationFlow -> Constr)
-> (VerificationFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VerificationFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VerificationFlow))
-> ((forall b. Data b => b -> b)
    -> VerificationFlow -> VerificationFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VerificationFlow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VerificationFlow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlow -> m VerificationFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlow -> m VerificationFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlow -> m VerificationFlow)
-> Data VerificationFlow
VerificationFlow -> DataType
VerificationFlow -> Constr
(forall b. Data b => b -> b)
-> VerificationFlow -> VerificationFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerificationFlow -> c VerificationFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlow
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> VerificationFlow -> u
forall u. (forall d. Data d => d -> u) -> VerificationFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerificationFlow -> c VerificationFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VerificationFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlow)
$cVerificationFlow :: Constr
$tVerificationFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
gmapMp :: (forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
gmapM :: (forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerificationFlow -> m VerificationFlow
gmapQi :: Int -> (forall d. Data d => d -> u) -> VerificationFlow -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> VerificationFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> VerificationFlow -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VerificationFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VerificationFlow -> r
gmapT :: (forall b. Data b => b -> b)
-> VerificationFlow -> VerificationFlow
$cgmapT :: (forall b. Data b => b -> b)
-> VerificationFlow -> VerificationFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlow)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VerificationFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VerificationFlow)
dataTypeOf :: VerificationFlow -> DataType
$cdataTypeOf :: VerificationFlow -> DataType
toConstr :: VerificationFlow -> Constr
$ctoConstr :: VerificationFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerificationFlow -> c VerificationFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VerificationFlow -> c VerificationFlow
$cp1Data :: Typeable VerificationFlow
Data)

instance FromJSON VerificationFlow where
  parseJSON :: Value -> Parser VerificationFlow
parseJSON =
    Options -> Value -> Parser VerificationFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

instance ToJSON VerificationFlow where
  toEncoding :: VerificationFlow -> Encoding
toEncoding =
    Options -> VerificationFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding
      Options
defaultOptions
        { constructorTagModifier :: String -> String
constructorTagModifier = String -> String
typeFieldRename,
          fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
typeFieldRename
        }

-- |
data VerificationFlowMethod = VerificationFlowMethod
  { -- |
    VerificationFlowMethod -> VerificationFlowMethodConfig
config :: VerificationFlowMethodConfig,
    -- | Method contains the request credentials type.
    VerificationFlowMethod -> Text
method :: Text
  }
  deriving stock (Int -> VerificationFlowMethod -> String -> String
[VerificationFlowMethod] -> String -> String
VerificationFlowMethod -> String
(Int -> VerificationFlowMethod -> String -> String)
-> (VerificationFlowMethod -> String)
-> ([VerificationFlowMethod] -> String -> String)
-> Show VerificationFlowMethod
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VerificationFlowMethod] -> String -> String
$cshowList :: [VerificationFlowMethod] -> String -> String
show :: VerificationFlowMethod -> String
$cshow :: VerificationFlowMethod -> String
showsPrec :: Int -> VerificationFlowMethod -> String -> String
$cshowsPrec :: Int -> VerificationFlowMethod -> String -> String
Show, VerificationFlowMethod -> VerificationFlowMethod -> Bool
(VerificationFlowMethod -> VerificationFlowMethod -> Bool)
-> (VerificationFlowMethod -> VerificationFlowMethod -> Bool)
-> Eq VerificationFlowMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationFlowMethod -> VerificationFlowMethod -> Bool
$c/= :: VerificationFlowMethod -> VerificationFlowMethod -> Bool
== :: VerificationFlowMethod -> VerificationFlowMethod -> Bool
$c== :: VerificationFlowMethod -> VerificationFlowMethod -> Bool
Eq, (forall x. VerificationFlowMethod -> Rep VerificationFlowMethod x)
-> (forall x.
    Rep VerificationFlowMethod x -> VerificationFlowMethod)
-> Generic VerificationFlowMethod
forall x. Rep VerificationFlowMethod x -> VerificationFlowMethod
forall x. VerificationFlowMethod -> Rep VerificationFlowMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VerificationFlowMethod x -> VerificationFlowMethod
$cfrom :: forall x. VerificationFlowMethod -> Rep VerificationFlowMethod x
Generic, Typeable VerificationFlowMethod
DataType
Constr
Typeable VerificationFlowMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VerificationFlowMethod
    -> c VerificationFlowMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VerificationFlowMethod)
-> (VerificationFlowMethod -> Constr)
-> (VerificationFlowMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c VerificationFlowMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VerificationFlowMethod))
-> ((forall b. Data b => b -> b)
    -> VerificationFlowMethod -> VerificationFlowMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VerificationFlowMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VerificationFlowMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VerificationFlowMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> VerificationFlowMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlowMethod -> m VerificationFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlowMethod -> m VerificationFlowMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlowMethod -> m VerificationFlowMethod)
-> Data VerificationFlowMethod
VerificationFlowMethod -> DataType
VerificationFlowMethod -> Constr
(forall b. Data b => b -> b)
-> VerificationFlowMethod -> VerificationFlowMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethod
-> c VerificationFlowMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> VerificationFlowMethod -> u
forall u.
(forall d. Data d => d -> u) -> VerificationFlowMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethod
-> c VerificationFlowMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VerificationFlowMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlowMethod)
$cVerificationFlowMethod :: Constr
$tVerificationFlowMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
gmapMp :: (forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
gmapM :: (forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethod -> m VerificationFlowMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> VerificationFlowMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> VerificationFlowMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> VerificationFlowMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VerificationFlowMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> VerificationFlowMethod -> VerificationFlowMethod
$cgmapT :: (forall b. Data b => b -> b)
-> VerificationFlowMethod -> VerificationFlowMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlowMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlowMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c VerificationFlowMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VerificationFlowMethod)
dataTypeOf :: VerificationFlowMethod -> DataType
$cdataTypeOf :: VerificationFlowMethod -> DataType
toConstr :: VerificationFlowMethod -> Constr
$ctoConstr :: VerificationFlowMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethod
-> c VerificationFlowMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethod
-> c VerificationFlowMethod
$cp1Data :: Typeable VerificationFlowMethod
Data)

instance FromJSON VerificationFlowMethod

instance ToJSON VerificationFlowMethod where
  toEncoding :: VerificationFlowMethod -> Encoding
toEncoding = Options -> VerificationFlowMethod -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data VerificationFlowMethodConfig = VerificationFlowMethodConfig
  { -- | Action should be used as the form action URL `<form action=\"{{ .Action }}\" method=\"post\">`.
    VerificationFlowMethodConfig -> Text
action :: Text,
    -- | Fields contains multiple fields
    VerificationFlowMethodConfig -> [FormField]
fields :: [FormField],
    -- |
    VerificationFlowMethodConfig -> Maybe [Message]
messages :: Maybe [Message],
    -- | Method is the form method (e.g. POST)
    VerificationFlowMethodConfig -> Text
method :: Text
  }
  deriving stock (Int -> VerificationFlowMethodConfig -> String -> String
[VerificationFlowMethodConfig] -> String -> String
VerificationFlowMethodConfig -> String
(Int -> VerificationFlowMethodConfig -> String -> String)
-> (VerificationFlowMethodConfig -> String)
-> ([VerificationFlowMethodConfig] -> String -> String)
-> Show VerificationFlowMethodConfig
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VerificationFlowMethodConfig] -> String -> String
$cshowList :: [VerificationFlowMethodConfig] -> String -> String
show :: VerificationFlowMethodConfig -> String
$cshow :: VerificationFlowMethodConfig -> String
showsPrec :: Int -> VerificationFlowMethodConfig -> String -> String
$cshowsPrec :: Int -> VerificationFlowMethodConfig -> String -> String
Show, VerificationFlowMethodConfig
-> VerificationFlowMethodConfig -> Bool
(VerificationFlowMethodConfig
 -> VerificationFlowMethodConfig -> Bool)
-> (VerificationFlowMethodConfig
    -> VerificationFlowMethodConfig -> Bool)
-> Eq VerificationFlowMethodConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerificationFlowMethodConfig
-> VerificationFlowMethodConfig -> Bool
$c/= :: VerificationFlowMethodConfig
-> VerificationFlowMethodConfig -> Bool
== :: VerificationFlowMethodConfig
-> VerificationFlowMethodConfig -> Bool
$c== :: VerificationFlowMethodConfig
-> VerificationFlowMethodConfig -> Bool
Eq, (forall x.
 VerificationFlowMethodConfig -> Rep VerificationFlowMethodConfig x)
-> (forall x.
    Rep VerificationFlowMethodConfig x -> VerificationFlowMethodConfig)
-> Generic VerificationFlowMethodConfig
forall x.
Rep VerificationFlowMethodConfig x -> VerificationFlowMethodConfig
forall x.
VerificationFlowMethodConfig -> Rep VerificationFlowMethodConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep VerificationFlowMethodConfig x -> VerificationFlowMethodConfig
$cfrom :: forall x.
VerificationFlowMethodConfig -> Rep VerificationFlowMethodConfig x
Generic, Typeable VerificationFlowMethodConfig
DataType
Constr
Typeable VerificationFlowMethodConfig
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VerificationFlowMethodConfig
    -> c VerificationFlowMethodConfig)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c VerificationFlowMethodConfig)
-> (VerificationFlowMethodConfig -> Constr)
-> (VerificationFlowMethodConfig -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c VerificationFlowMethodConfig))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VerificationFlowMethodConfig))
-> ((forall b. Data b => b -> b)
    -> VerificationFlowMethodConfig -> VerificationFlowMethodConfig)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VerificationFlowMethodConfig
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VerificationFlowMethodConfig
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> VerificationFlowMethodConfig -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> VerificationFlowMethodConfig
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig)
-> Data VerificationFlowMethodConfig
VerificationFlowMethodConfig -> DataType
VerificationFlowMethodConfig -> Constr
(forall b. Data b => b -> b)
-> VerificationFlowMethodConfig -> VerificationFlowMethodConfig
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethodConfig
-> c VerificationFlowMethodConfig
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethodConfig
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> VerificationFlowMethodConfig
-> u
forall u.
(forall d. Data d => d -> u) -> VerificationFlowMethodConfig -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethodConfig
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethodConfig
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethodConfig
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethodConfig
-> c VerificationFlowMethodConfig
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VerificationFlowMethodConfig)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlowMethodConfig)
$cVerificationFlowMethodConfig :: Constr
$tVerificationFlowMethodConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
gmapMp :: (forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
gmapM :: (forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerificationFlowMethodConfig -> m VerificationFlowMethodConfig
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> VerificationFlowMethodConfig
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> VerificationFlowMethodConfig
-> u
gmapQ :: (forall d. Data d => d -> u) -> VerificationFlowMethodConfig -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VerificationFlowMethodConfig -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethodConfig
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethodConfig
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethodConfig
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerificationFlowMethodConfig
-> r
gmapT :: (forall b. Data b => b -> b)
-> VerificationFlowMethodConfig -> VerificationFlowMethodConfig
$cgmapT :: (forall b. Data b => b -> b)
-> VerificationFlowMethodConfig -> VerificationFlowMethodConfig
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlowMethodConfig)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerificationFlowMethodConfig)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c VerificationFlowMethodConfig)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VerificationFlowMethodConfig)
dataTypeOf :: VerificationFlowMethodConfig -> DataType
$cdataTypeOf :: VerificationFlowMethodConfig -> DataType
toConstr :: VerificationFlowMethodConfig -> Constr
$ctoConstr :: VerificationFlowMethodConfig -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethodConfig
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerificationFlowMethodConfig
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethodConfig
-> c VerificationFlowMethodConfig
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerificationFlowMethodConfig
-> c VerificationFlowMethodConfig
$cp1Data :: Typeable VerificationFlowMethodConfig
Data)

instance FromJSON VerificationFlowMethodConfig

instance ToJSON VerificationFlowMethodConfig where
  toEncoding :: VerificationFlowMethodConfig -> Encoding
toEncoding = Options -> VerificationFlowMethodConfig -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

-- |
data Version = Version
  { -- | Version is the service's version.
    Version -> Maybe Text
version :: Maybe Text
  }
  deriving stock (Int -> Version -> String -> String
[Version] -> String -> String
Version -> String
(Int -> Version -> String -> String)
-> (Version -> String)
-> ([Version] -> String -> String)
-> Show Version
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Version] -> String -> String
$cshowList :: [Version] -> String -> String
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> String -> String
$cshowsPrec :: Int -> Version -> String -> String
Show, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic, Typeable Version
DataType
Constr
Typeable Version
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Version -> c Version)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Version)
-> (Version -> Constr)
-> (Version -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Version))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version))
-> ((forall b. Data b => b -> b) -> Version -> Version)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Version -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Version -> r)
-> (forall u. (forall d. Data d => d -> u) -> Version -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Version -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Version -> m Version)
-> Data Version
Version -> DataType
Version -> Constr
(forall b. Data b => b -> b) -> Version -> Version
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Version -> u
forall u. (forall d. Data d => d -> u) -> Version -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
$cVersion :: Constr
$tVersion :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Version -> m Version
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapMp :: (forall d. Data d => d -> m d) -> Version -> m Version
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapM :: (forall d. Data d => d -> m d) -> Version -> m Version
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Version -> m Version
gmapQi :: Int -> (forall d. Data d => d -> u) -> Version -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Version -> u
gmapQ :: (forall d. Data d => d -> u) -> Version -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Version -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Version -> r
gmapT :: (forall b. Data b => b -> b) -> Version -> Version
$cgmapT :: (forall b. Data b => b -> b) -> Version -> Version
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Version)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Version)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Version)
dataTypeOf :: Version -> DataType
$cdataTypeOf :: Version -> DataType
toConstr :: Version -> Constr
$ctoConstr :: Version -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Version
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Version -> c Version
$cp1Data :: Typeable Version
Data)

instance FromJSON Version

instance ToJSON Version where
  toEncoding :: Version -> Encoding
toEncoding = Options -> Version -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions