module OryKratos.Types.Misc
  ( Message (..),
    ErrorContainer (..),
    FormField (..),
    GenericError (..),
    GenericErrorPayload (..),
    HealthNotReadyStatus (..),
    HealthStatus (..),
    CompleteSelfServiceLoginFlowWithPasswordMethod (..),
    CompleteSelfServiceRecoveryFlowWithLinkMethod (..),
    CompleteSelfServiceSettingsFlowWithPasswordMethod (..),
    CompleteSelfServiceVerificationFlowWithLinkMethod (..),
    CreateIdentity (..),
    CreateRecoveryLink (..),
    Identity (..),
    RevokeSession (..),
    Session (..),
    UpdateIdentity (..),
    VerifiableAddress (..),
    Version (..),
    RecoveryAddress (..),
  )
where

import Pre

-- |
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 -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
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 :: ShowS
constructorTagModifier = ShowS
typeFieldRename,
          fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
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 :: ShowS
constructorTagModifier = ShowS
typeFieldRename,
          fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
typeFieldRename
        }

-- |
data ErrorContainer = ErrorContainer
  { -- | Errors in the container
    ErrorContainer -> Value
errors :: Value,
    -- |
    ErrorContainer -> Text
id :: Text
  }
  deriving stock (Int -> ErrorContainer -> ShowS
[ErrorContainer] -> ShowS
ErrorContainer -> String
(Int -> ErrorContainer -> ShowS)
-> (ErrorContainer -> String)
-> ([ErrorContainer] -> ShowS)
-> Show ErrorContainer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorContainer] -> ShowS
$cshowList :: [ErrorContainer] -> ShowS
show :: ErrorContainer -> String
$cshow :: ErrorContainer -> String
showsPrec :: Int -> ErrorContainer -> ShowS
$cshowsPrec :: Int -> ErrorContainer -> ShowS
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
p :: 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 -> ShowS
[FormField] -> ShowS
FormField -> String
(Int -> FormField -> ShowS)
-> (FormField -> String)
-> ([FormField] -> ShowS)
-> Show FormField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormField] -> ShowS
$cshowList :: [FormField] -> ShowS
show :: FormField -> String
$cshow :: FormField -> String
showsPrec :: Int -> FormField -> ShowS
$cshowsPrec :: Int -> FormField -> ShowS
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 :: ShowS
constructorTagModifier = ShowS
typeFieldRename,
          fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
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 :: ShowS
constructorTagModifier = ShowS
typeFieldRename,
          fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
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 -> ShowS
[GenericError] -> ShowS
GenericError -> String
(Int -> GenericError -> ShowS)
-> (GenericError -> String)
-> ([GenericError] -> ShowS)
-> Show GenericError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericError] -> ShowS
$cshowList :: [GenericError] -> ShowS
show :: GenericError -> String
$cshow :: GenericError -> String
showsPrec :: Int -> GenericError -> ShowS
$cshowsPrec :: Int -> GenericError -> ShowS
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 -> ShowS
[GenericErrorPayload] -> ShowS
GenericErrorPayload -> String
(Int -> GenericErrorPayload -> ShowS)
-> (GenericErrorPayload -> String)
-> ([GenericErrorPayload] -> ShowS)
-> Show GenericErrorPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericErrorPayload] -> ShowS
$cshowList :: [GenericErrorPayload] -> ShowS
show :: GenericErrorPayload -> String
$cshow :: GenericErrorPayload -> String
showsPrec :: Int -> GenericErrorPayload -> ShowS
$cshowsPrec :: Int -> GenericErrorPayload -> ShowS
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 String Text)
  }
  deriving stock (Int -> HealthNotReadyStatus -> ShowS
[HealthNotReadyStatus] -> ShowS
HealthNotReadyStatus -> String
(Int -> HealthNotReadyStatus -> ShowS)
-> (HealthNotReadyStatus -> String)
-> ([HealthNotReadyStatus] -> ShowS)
-> Show HealthNotReadyStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthNotReadyStatus] -> ShowS
$cshowList :: [HealthNotReadyStatus] -> ShowS
show :: HealthNotReadyStatus -> String
$cshow :: HealthNotReadyStatus -> String
showsPrec :: Int -> HealthNotReadyStatus -> ShowS
$cshowsPrec :: Int -> HealthNotReadyStatus -> ShowS
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 -> ShowS
[HealthStatus] -> ShowS
HealthStatus -> String
(Int -> HealthStatus -> ShowS)
-> (HealthStatus -> String)
-> ([HealthStatus] -> ShowS)
-> Show HealthStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthStatus] -> ShowS
$cshowList :: [HealthStatus] -> ShowS
show :: HealthStatus -> String
$cshow :: HealthStatus -> String
showsPrec :: Int -> HealthStatus -> ShowS
$cshowsPrec :: Int -> HealthStatus -> ShowS
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 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 -> ShowS
[CompleteSelfServiceLoginFlowWithPasswordMethod] -> ShowS
CompleteSelfServiceLoginFlowWithPasswordMethod -> String
(Int -> CompleteSelfServiceLoginFlowWithPasswordMethod -> ShowS)
-> (CompleteSelfServiceLoginFlowWithPasswordMethod -> String)
-> ([CompleteSelfServiceLoginFlowWithPasswordMethod] -> ShowS)
-> Show CompleteSelfServiceLoginFlowWithPasswordMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteSelfServiceLoginFlowWithPasswordMethod] -> ShowS
$cshowList :: [CompleteSelfServiceLoginFlowWithPasswordMethod] -> ShowS
show :: CompleteSelfServiceLoginFlowWithPasswordMethod -> String
$cshow :: CompleteSelfServiceLoginFlowWithPasswordMethod -> String
showsPrec :: Int -> CompleteSelfServiceLoginFlowWithPasswordMethod -> ShowS
$cshowsPrec :: Int -> CompleteSelfServiceLoginFlowWithPasswordMethod -> ShowS
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 -> ShowS
[CompleteSelfServiceRecoveryFlowWithLinkMethod] -> ShowS
CompleteSelfServiceRecoveryFlowWithLinkMethod -> String
(Int -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> ShowS)
-> (CompleteSelfServiceRecoveryFlowWithLinkMethod -> String)
-> ([CompleteSelfServiceRecoveryFlowWithLinkMethod] -> ShowS)
-> Show CompleteSelfServiceRecoveryFlowWithLinkMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteSelfServiceRecoveryFlowWithLinkMethod] -> ShowS
$cshowList :: [CompleteSelfServiceRecoveryFlowWithLinkMethod] -> ShowS
show :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> String
$cshow :: CompleteSelfServiceRecoveryFlowWithLinkMethod -> String
showsPrec :: Int -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> ShowS
$cshowsPrec :: Int -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> ShowS
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 -> ShowS
[CompleteSelfServiceSettingsFlowWithPasswordMethod] -> ShowS
CompleteSelfServiceSettingsFlowWithPasswordMethod -> String
(Int -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> ShowS)
-> (CompleteSelfServiceSettingsFlowWithPasswordMethod -> String)
-> ([CompleteSelfServiceSettingsFlowWithPasswordMethod] -> ShowS)
-> Show CompleteSelfServiceSettingsFlowWithPasswordMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteSelfServiceSettingsFlowWithPasswordMethod] -> ShowS
$cshowList :: [CompleteSelfServiceSettingsFlowWithPasswordMethod] -> ShowS
show :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> String
$cshow :: CompleteSelfServiceSettingsFlowWithPasswordMethod -> String
showsPrec :: Int -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> ShowS
$cshowsPrec :: Int -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> ShowS
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 -> ShowS
[CompleteSelfServiceVerificationFlowWithLinkMethod] -> ShowS
CompleteSelfServiceVerificationFlowWithLinkMethod -> String
(Int -> CompleteSelfServiceVerificationFlowWithLinkMethod -> ShowS)
-> (CompleteSelfServiceVerificationFlowWithLinkMethod -> String)
-> ([CompleteSelfServiceVerificationFlowWithLinkMethod] -> ShowS)
-> Show CompleteSelfServiceVerificationFlowWithLinkMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteSelfServiceVerificationFlowWithLinkMethod] -> ShowS
$cshowList :: [CompleteSelfServiceVerificationFlowWithLinkMethod] -> ShowS
show :: CompleteSelfServiceVerificationFlowWithLinkMethod -> String
$cshow :: CompleteSelfServiceVerificationFlowWithLinkMethod -> String
showsPrec :: Int -> CompleteSelfServiceVerificationFlowWithLinkMethod -> ShowS
$cshowsPrec :: Int -> CompleteSelfServiceVerificationFlowWithLinkMethod -> ShowS
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 -> ShowS
[CreateIdentity] -> ShowS
CreateIdentity -> String
(Int -> CreateIdentity -> ShowS)
-> (CreateIdentity -> String)
-> ([CreateIdentity] -> ShowS)
-> Show CreateIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIdentity] -> ShowS
$cshowList :: [CreateIdentity] -> ShowS
show :: CreateIdentity -> String
$cshow :: CreateIdentity -> String
showsPrec :: Int -> CreateIdentity -> ShowS
$cshowsPrec :: Int -> CreateIdentity -> ShowS
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 -> UUID
identity_id :: UUID
  }
  deriving stock (Int -> CreateRecoveryLink -> ShowS
[CreateRecoveryLink] -> ShowS
CreateRecoveryLink -> String
(Int -> CreateRecoveryLink -> ShowS)
-> (CreateRecoveryLink -> String)
-> ([CreateRecoveryLink] -> ShowS)
-> Show CreateRecoveryLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRecoveryLink] -> ShowS
$cshowList :: [CreateRecoveryLink] -> ShowS
show :: CreateRecoveryLink -> String
$cshow :: CreateRecoveryLink -> String
showsPrec :: Int -> CreateRecoveryLink -> ShowS
$cshowsPrec :: Int -> CreateRecoveryLink -> ShowS
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 Identity = Identity
  { -- |
    Identity -> UUID
id :: UUID,
    -- | 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 -> ShowS
[Identity] -> ShowS
Identity -> String
(Int -> Identity -> ShowS)
-> (Identity -> String) -> ([Identity] -> ShowS) -> Show Identity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identity] -> ShowS
$cshowList :: [Identity] -> ShowS
show :: Identity -> String
$cshow :: Identity -> String
showsPrec :: Int -> Identity -> ShowS
$cshowsPrec :: Int -> Identity -> ShowS
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

-- |
data RevokeSession = RevokeSession
  { -- | The Session Token  Invalidate this session token.
    RevokeSession -> Text
session_token :: Text
  }
  deriving stock (Int -> RevokeSession -> ShowS
[RevokeSession] -> ShowS
RevokeSession -> String
(Int -> RevokeSession -> ShowS)
-> (RevokeSession -> String)
-> ([RevokeSession] -> ShowS)
-> Show RevokeSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokeSession] -> ShowS
$cshowList :: [RevokeSession] -> ShowS
show :: RevokeSession -> String
$cshow :: RevokeSession -> String
showsPrec :: Int -> RevokeSession -> ShowS
$cshowsPrec :: Int -> RevokeSession -> ShowS
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 -> UUID
id :: UUID,
    -- |
    Session -> Identity
identity :: Identity,
    -- |
    Session -> UTCTime
issued_at :: UTCTime
  }
  deriving stock (Int -> Session -> ShowS
[Session] -> ShowS
Session -> String
(Int -> Session -> ShowS)
-> (Session -> String) -> ([Session] -> ShowS) -> Show Session
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Session] -> ShowS
$cshowList :: [Session] -> ShowS
show :: Session -> String
$cshow :: Session -> String
showsPrec :: Int -> Session -> ShowS
$cshowsPrec :: Int -> Session -> ShowS
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

-- |
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 -> ShowS
[UpdateIdentity] -> ShowS
UpdateIdentity -> String
(Int -> UpdateIdentity -> ShowS)
-> (UpdateIdentity -> String)
-> ([UpdateIdentity] -> ShowS)
-> Show UpdateIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIdentity] -> ShowS
$cshowList :: [UpdateIdentity] -> ShowS
show :: UpdateIdentity -> String
$cshow :: UpdateIdentity -> String
showsPrec :: Int -> UpdateIdentity -> ShowS
$cshowsPrec :: Int -> UpdateIdentity -> ShowS
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 -> UUID
id :: UUID,
    -- |
    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 -> ShowS
[VerifiableAddress] -> ShowS
VerifiableAddress -> String
(Int -> VerifiableAddress -> ShowS)
-> (VerifiableAddress -> String)
-> ([VerifiableAddress] -> ShowS)
-> Show VerifiableAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifiableAddress] -> ShowS
$cshowList :: [VerifiableAddress] -> ShowS
show :: VerifiableAddress -> String
$cshow :: VerifiableAddress -> String
showsPrec :: Int -> VerifiableAddress -> ShowS
$cshowsPrec :: Int -> VerifiableAddress -> ShowS
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

-- |
data Version = Version
  { -- | Version is the service's version.
    Version -> Maybe Text
version :: Maybe Text
  }
  deriving stock (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
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

-- |
data RecoveryAddress = RecoveryAddress
  { -- |
    RecoveryAddress -> UUID
id :: UUID,
    -- |
    RecoveryAddress -> Text
value :: Text,
    -- |
    RecoveryAddress -> Text
via :: Text
  }
  deriving stock (Int -> RecoveryAddress -> ShowS
[RecoveryAddress] -> ShowS
RecoveryAddress -> String
(Int -> RecoveryAddress -> ShowS)
-> (RecoveryAddress -> String)
-> ([RecoveryAddress] -> ShowS)
-> Show RecoveryAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecoveryAddress] -> ShowS
$cshowList :: [RecoveryAddress] -> ShowS
show :: RecoveryAddress -> String
$cshow :: RecoveryAddress -> String
showsPrec :: Int -> RecoveryAddress -> ShowS
$cshowsPrec :: Int -> RecoveryAddress -> ShowS
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