{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

module OryKratos.Types.SelfService
  ( SelfServiceBrowserLocationChangeRequiredError (..),
    SelfServiceError (..),
    SelfServiceFlowExpiredError (..),
    SelfServiceLoginFlow (..),
    SelfServiceLogoutUrl (..),
    SelfServiceRecoveryFlow (..),
    SelfServiceRecoveryFlowState (..),
    SelfServiceRecoveryLink (..),
    SelfServiceRegistrationFlow (..),
    SelfServiceSettingsFlow (..),
    SelfServiceSettingsFlowState (..),
    SelfServiceVerificationFlow (..),
    SelfServiceVerificationFlowState (..),
  )
where

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

data SelfServiceBrowserLocationChangeRequiredError = SelfServiceBrowserLocationChangeRequiredError
  { -- | The status code
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Integer
code :: Maybe Integer,
    -- | Debug information  This field is often not exposed to protect against leaking sensitive information.
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Text
debug :: Maybe Text,
    -- | Further error details
    SelfServiceBrowserLocationChangeRequiredError
-> Maybe (Map String Value)
details :: Maybe (Map.Map String Value),
    -- | The error ID  Useful when trying to identify various errors in application logic.
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Text
id :: Maybe Text,
    -- | Error message  The error's message.
    SelfServiceBrowserLocationChangeRequiredError -> Text
message :: Text,
    -- | A human-readable reason for the error
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Text
reason :: Maybe Text,
    -- | Since when the flow has expired
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Text
redirect_browser_to :: Maybe Text,
    -- | The request ID  The request ID is often exposed internally in order to trace errors across service architectures. This is often a UUID.
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Text
request :: Maybe Text,
    -- | The status description
    SelfServiceBrowserLocationChangeRequiredError -> Maybe Text
status :: Maybe Text
  }
  deriving stock (Int -> SelfServiceBrowserLocationChangeRequiredError -> ShowS
[SelfServiceBrowserLocationChangeRequiredError] -> ShowS
SelfServiceBrowserLocationChangeRequiredError -> String
(Int -> SelfServiceBrowserLocationChangeRequiredError -> ShowS)
-> (SelfServiceBrowserLocationChangeRequiredError -> String)
-> ([SelfServiceBrowserLocationChangeRequiredError] -> ShowS)
-> Show SelfServiceBrowserLocationChangeRequiredError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceBrowserLocationChangeRequiredError] -> ShowS
$cshowList :: [SelfServiceBrowserLocationChangeRequiredError] -> ShowS
show :: SelfServiceBrowserLocationChangeRequiredError -> String
$cshow :: SelfServiceBrowserLocationChangeRequiredError -> String
showsPrec :: Int -> SelfServiceBrowserLocationChangeRequiredError -> ShowS
$cshowsPrec :: Int -> SelfServiceBrowserLocationChangeRequiredError -> ShowS
Show, SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError -> Bool
(SelfServiceBrowserLocationChangeRequiredError
 -> SelfServiceBrowserLocationChangeRequiredError -> Bool)
-> (SelfServiceBrowserLocationChangeRequiredError
    -> SelfServiceBrowserLocationChangeRequiredError -> Bool)
-> Eq SelfServiceBrowserLocationChangeRequiredError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError -> Bool
$c/= :: SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError -> Bool
== :: SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError -> Bool
$c== :: SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError -> Bool
Eq, (forall x.
 SelfServiceBrowserLocationChangeRequiredError
 -> Rep SelfServiceBrowserLocationChangeRequiredError x)
-> (forall x.
    Rep SelfServiceBrowserLocationChangeRequiredError x
    -> SelfServiceBrowserLocationChangeRequiredError)
-> Generic SelfServiceBrowserLocationChangeRequiredError
forall x.
Rep SelfServiceBrowserLocationChangeRequiredError x
-> SelfServiceBrowserLocationChangeRequiredError
forall x.
SelfServiceBrowserLocationChangeRequiredError
-> Rep SelfServiceBrowserLocationChangeRequiredError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelfServiceBrowserLocationChangeRequiredError x
-> SelfServiceBrowserLocationChangeRequiredError
$cfrom :: forall x.
SelfServiceBrowserLocationChangeRequiredError
-> Rep SelfServiceBrowserLocationChangeRequiredError x
Generic, Typeable SelfServiceBrowserLocationChangeRequiredError
DataType
Constr
Typeable SelfServiceBrowserLocationChangeRequiredError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceBrowserLocationChangeRequiredError
    -> c SelfServiceBrowserLocationChangeRequiredError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c SelfServiceBrowserLocationChangeRequiredError)
-> (SelfServiceBrowserLocationChangeRequiredError -> Constr)
-> (SelfServiceBrowserLocationChangeRequiredError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SelfServiceBrowserLocationChangeRequiredError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceBrowserLocationChangeRequiredError))
-> ((forall b. Data b => b -> b)
    -> SelfServiceBrowserLocationChangeRequiredError
    -> SelfServiceBrowserLocationChangeRequiredError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceBrowserLocationChangeRequiredError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceBrowserLocationChangeRequiredError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> SelfServiceBrowserLocationChangeRequiredError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SelfServiceBrowserLocationChangeRequiredError
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceBrowserLocationChangeRequiredError
    -> m SelfServiceBrowserLocationChangeRequiredError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceBrowserLocationChangeRequiredError
    -> m SelfServiceBrowserLocationChangeRequiredError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceBrowserLocationChangeRequiredError
    -> m SelfServiceBrowserLocationChangeRequiredError)
-> Data SelfServiceBrowserLocationChangeRequiredError
SelfServiceBrowserLocationChangeRequiredError -> DataType
SelfServiceBrowserLocationChangeRequiredError -> Constr
(forall b. Data b => b -> b)
-> SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceBrowserLocationChangeRequiredError
-> c SelfServiceBrowserLocationChangeRequiredError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceBrowserLocationChangeRequiredError
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)
-> SelfServiceBrowserLocationChangeRequiredError
-> u
forall u.
(forall d. Data d => d -> u)
-> SelfServiceBrowserLocationChangeRequiredError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceBrowserLocationChangeRequiredError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceBrowserLocationChangeRequiredError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceBrowserLocationChangeRequiredError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceBrowserLocationChangeRequiredError
-> c SelfServiceBrowserLocationChangeRequiredError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceBrowserLocationChangeRequiredError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceBrowserLocationChangeRequiredError)
$cSelfServiceBrowserLocationChangeRequiredError :: Constr
$tSelfServiceBrowserLocationChangeRequiredError :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceBrowserLocationChangeRequiredError
-> m SelfServiceBrowserLocationChangeRequiredError
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> SelfServiceBrowserLocationChangeRequiredError
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SelfServiceBrowserLocationChangeRequiredError
-> u
gmapQ :: (forall d. Data d => d -> u)
-> SelfServiceBrowserLocationChangeRequiredError -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> SelfServiceBrowserLocationChangeRequiredError -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceBrowserLocationChangeRequiredError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceBrowserLocationChangeRequiredError
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceBrowserLocationChangeRequiredError
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceBrowserLocationChangeRequiredError
-> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceBrowserLocationChangeRequiredError
-> SelfServiceBrowserLocationChangeRequiredError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceBrowserLocationChangeRequiredError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceBrowserLocationChangeRequiredError)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SelfServiceBrowserLocationChangeRequiredError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceBrowserLocationChangeRequiredError)
dataTypeOf :: SelfServiceBrowserLocationChangeRequiredError -> DataType
$cdataTypeOf :: SelfServiceBrowserLocationChangeRequiredError -> DataType
toConstr :: SelfServiceBrowserLocationChangeRequiredError -> Constr
$ctoConstr :: SelfServiceBrowserLocationChangeRequiredError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceBrowserLocationChangeRequiredError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceBrowserLocationChangeRequiredError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceBrowserLocationChangeRequiredError
-> c SelfServiceBrowserLocationChangeRequiredError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceBrowserLocationChangeRequiredError
-> c SelfServiceBrowserLocationChangeRequiredError
$cp1Data :: Typeable SelfServiceBrowserLocationChangeRequiredError
Data)

instance FromJSON SelfServiceBrowserLocationChangeRequiredError

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

data SelfServiceError = SelfServiceError
  { -- | CreatedAt is a helper struct field for gobuffalo.pop.
    SelfServiceError -> Maybe UTCTime
created_at :: Maybe UTCTime,
    SelfServiceError -> Maybe Value
error :: Maybe Value,
    SelfServiceError -> UUID
id :: UUID,
    -- | UpdatedAt is a helper struct field for gobuffalo.pop.
    SelfServiceError -> Maybe UTCTime
updated_at :: Maybe UTCTime
  }
  deriving stock (Int -> SelfServiceError -> ShowS
[SelfServiceError] -> ShowS
SelfServiceError -> String
(Int -> SelfServiceError -> ShowS)
-> (SelfServiceError -> String)
-> ([SelfServiceError] -> ShowS)
-> Show SelfServiceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceError] -> ShowS
$cshowList :: [SelfServiceError] -> ShowS
show :: SelfServiceError -> String
$cshow :: SelfServiceError -> String
showsPrec :: Int -> SelfServiceError -> ShowS
$cshowsPrec :: Int -> SelfServiceError -> ShowS
Show, SelfServiceError -> SelfServiceError -> Bool
(SelfServiceError -> SelfServiceError -> Bool)
-> (SelfServiceError -> SelfServiceError -> Bool)
-> Eq SelfServiceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceError -> SelfServiceError -> Bool
$c/= :: SelfServiceError -> SelfServiceError -> Bool
== :: SelfServiceError -> SelfServiceError -> Bool
$c== :: SelfServiceError -> SelfServiceError -> Bool
Eq, (forall x. SelfServiceError -> Rep SelfServiceError x)
-> (forall x. Rep SelfServiceError x -> SelfServiceError)
-> Generic SelfServiceError
forall x. Rep SelfServiceError x -> SelfServiceError
forall x. SelfServiceError -> Rep SelfServiceError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelfServiceError x -> SelfServiceError
$cfrom :: forall x. SelfServiceError -> Rep SelfServiceError x
Generic, Typeable SelfServiceError
DataType
Constr
Typeable SelfServiceError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SelfServiceError -> c SelfServiceError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelfServiceError)
-> (SelfServiceError -> Constr)
-> (SelfServiceError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelfServiceError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceError))
-> ((forall b. Data b => b -> b)
    -> SelfServiceError -> SelfServiceError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SelfServiceError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelfServiceError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceError -> m SelfServiceError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceError -> m SelfServiceError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceError -> m SelfServiceError)
-> Data SelfServiceError
SelfServiceError -> DataType
SelfServiceError -> Constr
(forall b. Data b => b -> b)
-> SelfServiceError -> SelfServiceError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelfServiceError -> c SelfServiceError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceError
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) -> SelfServiceError -> u
forall u. (forall d. Data d => d -> u) -> SelfServiceError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelfServiceError -> c SelfServiceError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelfServiceError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceError)
$cSelfServiceError :: Constr
$tSelfServiceError :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceError -> m SelfServiceError
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelfServiceError -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelfServiceError -> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SelfServiceError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceError -> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceError -> SelfServiceError
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceError -> SelfServiceError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelfServiceError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelfServiceError)
dataTypeOf :: SelfServiceError -> DataType
$cdataTypeOf :: SelfServiceError -> DataType
toConstr :: SelfServiceError -> Constr
$ctoConstr :: SelfServiceError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelfServiceError -> c SelfServiceError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SelfServiceError -> c SelfServiceError
$cp1Data :: Typeable SelfServiceError
Data)

instance FromJSON SelfServiceError

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

-- | Is sent when a flow is expired
data SelfServiceFlowExpiredError = SelfServiceFlowExpiredError
  { -- | The status code
    SelfServiceFlowExpiredError -> Maybe Integer
code :: Maybe Integer,
    -- | Debug information  This field is often not exposed to protect against leaking sensitive information.
    SelfServiceFlowExpiredError -> Maybe Text
debug :: Maybe Text,
    -- | Further error details
    SelfServiceFlowExpiredError -> Maybe (Map String Value)
details :: Maybe (Map.Map String Value),
    -- | The error ID  Useful when trying to identify various errors in application logic.
    SelfServiceFlowExpiredError -> Maybe Text
id :: Maybe Text,
    -- | Error message  The error's message.
    SelfServiceFlowExpiredError -> Text
message :: Text,
    -- | A human-readable reason for the error
    SelfServiceFlowExpiredError -> Maybe Text
reason :: Maybe Text,
    -- | The request ID  The request ID is often exposed internally in order to trace errors across service architectures. This is often a UUID.
    SelfServiceFlowExpiredError -> Maybe Text
request :: Maybe Text,
    -- | A Duration represents the elapsed time between two instants as an int64 nanosecond count. The representation limits the largest representable duration to approximately 290 years.
    SelfServiceFlowExpiredError -> Maybe Integer
since :: Maybe Integer,
    -- | The status description
    SelfServiceFlowExpiredError -> Maybe Text
status :: Maybe Text,
    SelfServiceFlowExpiredError -> Maybe UUID
use_flow_id :: Maybe UUID
  }
  deriving stock (Int -> SelfServiceFlowExpiredError -> ShowS
[SelfServiceFlowExpiredError] -> ShowS
SelfServiceFlowExpiredError -> String
(Int -> SelfServiceFlowExpiredError -> ShowS)
-> (SelfServiceFlowExpiredError -> String)
-> ([SelfServiceFlowExpiredError] -> ShowS)
-> Show SelfServiceFlowExpiredError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceFlowExpiredError] -> ShowS
$cshowList :: [SelfServiceFlowExpiredError] -> ShowS
show :: SelfServiceFlowExpiredError -> String
$cshow :: SelfServiceFlowExpiredError -> String
showsPrec :: Int -> SelfServiceFlowExpiredError -> ShowS
$cshowsPrec :: Int -> SelfServiceFlowExpiredError -> ShowS
Show, SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError -> Bool
(SelfServiceFlowExpiredError
 -> SelfServiceFlowExpiredError -> Bool)
-> (SelfServiceFlowExpiredError
    -> SelfServiceFlowExpiredError -> Bool)
-> Eq SelfServiceFlowExpiredError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError -> Bool
$c/= :: SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError -> Bool
== :: SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError -> Bool
$c== :: SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError -> Bool
Eq, (forall x.
 SelfServiceFlowExpiredError -> Rep SelfServiceFlowExpiredError x)
-> (forall x.
    Rep SelfServiceFlowExpiredError x -> SelfServiceFlowExpiredError)
-> Generic SelfServiceFlowExpiredError
forall x.
Rep SelfServiceFlowExpiredError x -> SelfServiceFlowExpiredError
forall x.
SelfServiceFlowExpiredError -> Rep SelfServiceFlowExpiredError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelfServiceFlowExpiredError x -> SelfServiceFlowExpiredError
$cfrom :: forall x.
SelfServiceFlowExpiredError -> Rep SelfServiceFlowExpiredError x
Generic, Typeable SelfServiceFlowExpiredError
DataType
Constr
Typeable SelfServiceFlowExpiredError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceFlowExpiredError
    -> c SelfServiceFlowExpiredError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelfServiceFlowExpiredError)
-> (SelfServiceFlowExpiredError -> Constr)
-> (SelfServiceFlowExpiredError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SelfServiceFlowExpiredError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceFlowExpiredError))
-> ((forall b. Data b => b -> b)
    -> SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceFlowExpiredError
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceFlowExpiredError
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SelfServiceFlowExpiredError -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SelfServiceFlowExpiredError
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError)
-> Data SelfServiceFlowExpiredError
SelfServiceFlowExpiredError -> DataType
SelfServiceFlowExpiredError -> Constr
(forall b. Data b => b -> b)
-> SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceFlowExpiredError
-> c SelfServiceFlowExpiredError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceFlowExpiredError
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) -> SelfServiceFlowExpiredError -> u
forall u.
(forall d. Data d => d -> u) -> SelfServiceFlowExpiredError -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceFlowExpiredError
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceFlowExpiredError
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceFlowExpiredError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceFlowExpiredError
-> c SelfServiceFlowExpiredError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceFlowExpiredError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceFlowExpiredError)
$cSelfServiceFlowExpiredError :: Constr
$tSelfServiceFlowExpiredError :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceFlowExpiredError -> m SelfServiceFlowExpiredError
gmapQi :: Int
-> (forall d. Data d => d -> u) -> SelfServiceFlowExpiredError -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SelfServiceFlowExpiredError -> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceFlowExpiredError -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelfServiceFlowExpiredError -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceFlowExpiredError
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceFlowExpiredError
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceFlowExpiredError
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceFlowExpiredError
-> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceFlowExpiredError -> SelfServiceFlowExpiredError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceFlowExpiredError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceFlowExpiredError)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SelfServiceFlowExpiredError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceFlowExpiredError)
dataTypeOf :: SelfServiceFlowExpiredError -> DataType
$cdataTypeOf :: SelfServiceFlowExpiredError -> DataType
toConstr :: SelfServiceFlowExpiredError -> Constr
$ctoConstr :: SelfServiceFlowExpiredError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceFlowExpiredError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceFlowExpiredError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceFlowExpiredError
-> c SelfServiceFlowExpiredError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceFlowExpiredError
-> c SelfServiceFlowExpiredError
$cp1Data :: Typeable SelfServiceFlowExpiredError
Data)

instance FromJSON SelfServiceFlowExpiredError

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

-- | This object represents a login flow. A login flow is initiated at the \"Initiate Login API / Browser Flow\" endpoint by a client.  Once a login flow is completed successfully, a session cookie or session token will be issued.
data SelfServiceLoginFlow = SelfServiceLoginFlow
  { SelfServiceLoginFlow -> Maybe IdentityCredentialsType
active :: Maybe IdentityCredentialsType,
    -- | CreatedAt is a helper struct field for gobuffalo.pop.
    SelfServiceLoginFlow -> Maybe UTCTime
created_at :: Maybe UTCTime,
    -- | ExpiresAt is the time (UTC) when the flow expires. If the user still wishes to log in, a new flow has to be initiated.
    SelfServiceLoginFlow -> UTCTime
expires_at :: UTCTime,
    SelfServiceLoginFlow -> UUID
id :: UUID,
    -- | IssuedAt is the time (UTC) when the flow started.
    SelfServiceLoginFlow -> UTCTime
issued_at :: UTCTime,
    -- | Refresh stores whether this login flow should enforce re-authentication.
    SelfServiceLoginFlow -> Maybe Bool
refresh :: Maybe Bool,
    -- | RequestURL is the initial URL that was requested from Ory Kratos. It can be used to forward information contained in the URL's path or query for example.
    SelfServiceLoginFlow -> Text
request_url :: Text,
    SelfServiceLoginFlow -> Maybe AuthenticatorAssuranceLevel
requested_aal :: Maybe AuthenticatorAssuranceLevel,
    -- | ReturnTo contains the requested return_to URL.
    SelfServiceLoginFlow -> Maybe Text
return_to :: Maybe Text,
    -- | The flow type can either be `api` or `browser`.
    SelfServiceLoginFlow -> Text
_type :: Text,
    SelfServiceLoginFlow -> UiContainer
ui :: UiContainer,
    -- | UpdatedAt is a helper struct field for gobuffalo.pop.
    SelfServiceLoginFlow -> Maybe UTCTime
updated_at :: Maybe UTCTime
  }
  deriving stock (Int -> SelfServiceLoginFlow -> ShowS
[SelfServiceLoginFlow] -> ShowS
SelfServiceLoginFlow -> String
(Int -> SelfServiceLoginFlow -> ShowS)
-> (SelfServiceLoginFlow -> String)
-> ([SelfServiceLoginFlow] -> ShowS)
-> Show SelfServiceLoginFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceLoginFlow] -> ShowS
$cshowList :: [SelfServiceLoginFlow] -> ShowS
show :: SelfServiceLoginFlow -> String
$cshow :: SelfServiceLoginFlow -> String
showsPrec :: Int -> SelfServiceLoginFlow -> ShowS
$cshowsPrec :: Int -> SelfServiceLoginFlow -> ShowS
Show, SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool
(SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool)
-> (SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool)
-> Eq SelfServiceLoginFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool
$c/= :: SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool
== :: SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool
$c== :: SelfServiceLoginFlow -> SelfServiceLoginFlow -> Bool
Eq, (forall x. SelfServiceLoginFlow -> Rep SelfServiceLoginFlow x)
-> (forall x. Rep SelfServiceLoginFlow x -> SelfServiceLoginFlow)
-> Generic SelfServiceLoginFlow
forall x. Rep SelfServiceLoginFlow x -> SelfServiceLoginFlow
forall x. SelfServiceLoginFlow -> Rep SelfServiceLoginFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelfServiceLoginFlow x -> SelfServiceLoginFlow
$cfrom :: forall x. SelfServiceLoginFlow -> Rep SelfServiceLoginFlow x
Generic, Typeable SelfServiceLoginFlow
DataType
Constr
Typeable SelfServiceLoginFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceLoginFlow
    -> c SelfServiceLoginFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelfServiceLoginFlow)
-> (SelfServiceLoginFlow -> Constr)
-> (SelfServiceLoginFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelfServiceLoginFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceLoginFlow))
-> ((forall b. Data b => b -> b)
    -> SelfServiceLoginFlow -> SelfServiceLoginFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SelfServiceLoginFlow -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelfServiceLoginFlow -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceLoginFlow -> m SelfServiceLoginFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceLoginFlow -> m SelfServiceLoginFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceLoginFlow -> m SelfServiceLoginFlow)
-> Data SelfServiceLoginFlow
SelfServiceLoginFlow -> DataType
SelfServiceLoginFlow -> Constr
(forall b. Data b => b -> b)
-> SelfServiceLoginFlow -> SelfServiceLoginFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLoginFlow
-> c SelfServiceLoginFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLoginFlow
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) -> SelfServiceLoginFlow -> u
forall u.
(forall d. Data d => d -> u) -> SelfServiceLoginFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLoginFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLoginFlow
-> c SelfServiceLoginFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelfServiceLoginFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceLoginFlow)
$cSelfServiceLoginFlow :: Constr
$tSelfServiceLoginFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceLoginFlow -> m SelfServiceLoginFlow
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelfServiceLoginFlow -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelfServiceLoginFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceLoginFlow -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelfServiceLoginFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLoginFlow -> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceLoginFlow -> SelfServiceLoginFlow
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceLoginFlow -> SelfServiceLoginFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceLoginFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceLoginFlow)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelfServiceLoginFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelfServiceLoginFlow)
dataTypeOf :: SelfServiceLoginFlow -> DataType
$cdataTypeOf :: SelfServiceLoginFlow -> DataType
toConstr :: SelfServiceLoginFlow -> Constr
$ctoConstr :: SelfServiceLoginFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLoginFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLoginFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLoginFlow
-> c SelfServiceLoginFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLoginFlow
-> c SelfServiceLoginFlow
$cp1Data :: Typeable SelfServiceLoginFlow
Data)

instance FromJSON SelfServiceLoginFlow where
  parseJSON :: Value -> Parser SelfServiceLoginFlow
parseJSON = Options -> Value -> Parser SelfServiceLoginFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
customOptions

instance ToJSON SelfServiceLoginFlow where
  toJSON :: SelfServiceLoginFlow -> Value
toJSON = Options -> SelfServiceLoginFlow -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
customOptions
  toEncoding :: SelfServiceLoginFlow -> Encoding
toEncoding = Options -> SelfServiceLoginFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
customOptions

data SelfServiceLogoutUrl = SelfServiceLogoutUrl
  { -- | LogoutToken can be used to perform logout using AJAX.
    SelfServiceLogoutUrl -> Text
logout_token :: Text,
    -- | LogoutURL can be opened in a browser to sign the user out.  format: uri
    SelfServiceLogoutUrl -> Text
logout_url :: Text
  }
  deriving stock (Int -> SelfServiceLogoutUrl -> ShowS
[SelfServiceLogoutUrl] -> ShowS
SelfServiceLogoutUrl -> String
(Int -> SelfServiceLogoutUrl -> ShowS)
-> (SelfServiceLogoutUrl -> String)
-> ([SelfServiceLogoutUrl] -> ShowS)
-> Show SelfServiceLogoutUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceLogoutUrl] -> ShowS
$cshowList :: [SelfServiceLogoutUrl] -> ShowS
show :: SelfServiceLogoutUrl -> String
$cshow :: SelfServiceLogoutUrl -> String
showsPrec :: Int -> SelfServiceLogoutUrl -> ShowS
$cshowsPrec :: Int -> SelfServiceLogoutUrl -> ShowS
Show, SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool
(SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool)
-> (SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool)
-> Eq SelfServiceLogoutUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool
$c/= :: SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool
== :: SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool
$c== :: SelfServiceLogoutUrl -> SelfServiceLogoutUrl -> Bool
Eq, (forall x. SelfServiceLogoutUrl -> Rep SelfServiceLogoutUrl x)
-> (forall x. Rep SelfServiceLogoutUrl x -> SelfServiceLogoutUrl)
-> Generic SelfServiceLogoutUrl
forall x. Rep SelfServiceLogoutUrl x -> SelfServiceLogoutUrl
forall x. SelfServiceLogoutUrl -> Rep SelfServiceLogoutUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelfServiceLogoutUrl x -> SelfServiceLogoutUrl
$cfrom :: forall x. SelfServiceLogoutUrl -> Rep SelfServiceLogoutUrl x
Generic, Typeable SelfServiceLogoutUrl
DataType
Constr
Typeable SelfServiceLogoutUrl
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceLogoutUrl
    -> c SelfServiceLogoutUrl)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelfServiceLogoutUrl)
-> (SelfServiceLogoutUrl -> Constr)
-> (SelfServiceLogoutUrl -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SelfServiceLogoutUrl))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceLogoutUrl))
-> ((forall b. Data b => b -> b)
    -> SelfServiceLogoutUrl -> SelfServiceLogoutUrl)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl)
-> Data SelfServiceLogoutUrl
SelfServiceLogoutUrl -> DataType
SelfServiceLogoutUrl -> Constr
(forall b. Data b => b -> b)
-> SelfServiceLogoutUrl -> SelfServiceLogoutUrl
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLogoutUrl
-> c SelfServiceLogoutUrl
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLogoutUrl
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) -> SelfServiceLogoutUrl -> u
forall u.
(forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLogoutUrl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLogoutUrl
-> c SelfServiceLogoutUrl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelfServiceLogoutUrl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceLogoutUrl)
$cSelfServiceLogoutUrl :: Constr
$tSelfServiceLogoutUrl :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceLogoutUrl -> m SelfServiceLogoutUrl
gmapQi :: Int -> (forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelfServiceLogoutUrl -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SelfServiceLogoutUrl -> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceLogoutUrl -> SelfServiceLogoutUrl
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceLogoutUrl -> SelfServiceLogoutUrl
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceLogoutUrl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceLogoutUrl)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SelfServiceLogoutUrl)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SelfServiceLogoutUrl)
dataTypeOf :: SelfServiceLogoutUrl -> DataType
$cdataTypeOf :: SelfServiceLogoutUrl -> DataType
toConstr :: SelfServiceLogoutUrl -> Constr
$ctoConstr :: SelfServiceLogoutUrl -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLogoutUrl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceLogoutUrl
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLogoutUrl
-> c SelfServiceLogoutUrl
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceLogoutUrl
-> c SelfServiceLogoutUrl
$cp1Data :: Typeable SelfServiceLogoutUrl
Data)

instance FromJSON SelfServiceLogoutUrl

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

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

instance FromJSON SelfServiceRecoveryFlow where
  parseJSON :: Value -> Parser SelfServiceRecoveryFlow
parseJSON = Options -> Value -> Parser SelfServiceRecoveryFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
customOptions

instance ToJSON SelfServiceRecoveryFlow where
  toJSON :: SelfServiceRecoveryFlow -> Value
toJSON = Options -> SelfServiceRecoveryFlow -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
customOptions
  toEncoding :: SelfServiceRecoveryFlow -> Encoding
toEncoding = Options -> SelfServiceRecoveryFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
customOptions

-- | The state represents the state of the recovery flow.  choose_method: ask the user to choose a method (e.g. recover account via email) sent_email: the email has been sent to the user passed_challenge: the request was successful and the recovery challenge was passed.
data SelfServiceRecoveryFlowState
  = SelfServiceRecoveryFlowStateChooseMethod
  | SelfServiceRecoveryFlowStateSentEmail
  | SelfServiceRecoveryFlowStatePassedChallenge
  deriving stock (Int -> SelfServiceRecoveryFlowState -> ShowS
[SelfServiceRecoveryFlowState] -> ShowS
SelfServiceRecoveryFlowState -> String
(Int -> SelfServiceRecoveryFlowState -> ShowS)
-> (SelfServiceRecoveryFlowState -> String)
-> ([SelfServiceRecoveryFlowState] -> ShowS)
-> Show SelfServiceRecoveryFlowState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceRecoveryFlowState] -> ShowS
$cshowList :: [SelfServiceRecoveryFlowState] -> ShowS
show :: SelfServiceRecoveryFlowState -> String
$cshow :: SelfServiceRecoveryFlowState -> String
showsPrec :: Int -> SelfServiceRecoveryFlowState -> ShowS
$cshowsPrec :: Int -> SelfServiceRecoveryFlowState -> ShowS
Show, SelfServiceRecoveryFlowState
-> SelfServiceRecoveryFlowState -> Bool
(SelfServiceRecoveryFlowState
 -> SelfServiceRecoveryFlowState -> Bool)
-> (SelfServiceRecoveryFlowState
    -> SelfServiceRecoveryFlowState -> Bool)
-> Eq SelfServiceRecoveryFlowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceRecoveryFlowState
-> SelfServiceRecoveryFlowState -> Bool
$c/= :: SelfServiceRecoveryFlowState
-> SelfServiceRecoveryFlowState -> Bool
== :: SelfServiceRecoveryFlowState
-> SelfServiceRecoveryFlowState -> Bool
$c== :: SelfServiceRecoveryFlowState
-> SelfServiceRecoveryFlowState -> Bool
Eq, (forall x.
 SelfServiceRecoveryFlowState -> Rep SelfServiceRecoveryFlowState x)
-> (forall x.
    Rep SelfServiceRecoveryFlowState x -> SelfServiceRecoveryFlowState)
-> Generic SelfServiceRecoveryFlowState
forall x.
Rep SelfServiceRecoveryFlowState x -> SelfServiceRecoveryFlowState
forall x.
SelfServiceRecoveryFlowState -> Rep SelfServiceRecoveryFlowState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelfServiceRecoveryFlowState x -> SelfServiceRecoveryFlowState
$cfrom :: forall x.
SelfServiceRecoveryFlowState -> Rep SelfServiceRecoveryFlowState x
Generic, Typeable SelfServiceRecoveryFlowState
DataType
Constr
Typeable SelfServiceRecoveryFlowState
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceRecoveryFlowState
    -> c SelfServiceRecoveryFlowState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c SelfServiceRecoveryFlowState)
-> (SelfServiceRecoveryFlowState -> Constr)
-> (SelfServiceRecoveryFlowState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SelfServiceRecoveryFlowState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceRecoveryFlowState))
-> ((forall b. Data b => b -> b)
    -> SelfServiceRecoveryFlowState -> SelfServiceRecoveryFlowState)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceRecoveryFlowState
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceRecoveryFlowState
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> SelfServiceRecoveryFlowState -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SelfServiceRecoveryFlowState
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState)
-> Data SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowState -> DataType
SelfServiceRecoveryFlowState -> Constr
(forall b. Data b => b -> b)
-> SelfServiceRecoveryFlowState -> SelfServiceRecoveryFlowState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRecoveryFlowState
-> c SelfServiceRecoveryFlowState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRecoveryFlowState
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)
-> SelfServiceRecoveryFlowState
-> u
forall u.
(forall d. Data d => d -> u) -> SelfServiceRecoveryFlowState -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRecoveryFlowState
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRecoveryFlowState
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRecoveryFlowState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRecoveryFlowState
-> c SelfServiceRecoveryFlowState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceRecoveryFlowState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceRecoveryFlowState)
$cSelfServiceRecoveryFlowStatePassedChallenge :: Constr
$cSelfServiceRecoveryFlowStateSentEmail :: Constr
$cSelfServiceRecoveryFlowStateChooseMethod :: Constr
$tSelfServiceRecoveryFlowState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceRecoveryFlowState -> m SelfServiceRecoveryFlowState
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> SelfServiceRecoveryFlowState
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SelfServiceRecoveryFlowState
-> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceRecoveryFlowState -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelfServiceRecoveryFlowState -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRecoveryFlowState
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRecoveryFlowState
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRecoveryFlowState
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRecoveryFlowState
-> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceRecoveryFlowState -> SelfServiceRecoveryFlowState
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceRecoveryFlowState -> SelfServiceRecoveryFlowState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceRecoveryFlowState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceRecoveryFlowState)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SelfServiceRecoveryFlowState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceRecoveryFlowState)
dataTypeOf :: SelfServiceRecoveryFlowState -> DataType
$cdataTypeOf :: SelfServiceRecoveryFlowState -> DataType
toConstr :: SelfServiceRecoveryFlowState -> Constr
$ctoConstr :: SelfServiceRecoveryFlowState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRecoveryFlowState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRecoveryFlowState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRecoveryFlowState
-> c SelfServiceRecoveryFlowState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRecoveryFlowState
-> c SelfServiceRecoveryFlowState
$cp1Data :: Typeable SelfServiceRecoveryFlowState
Data)

instance FromJSON SelfServiceRecoveryFlowState where
  parseJSON :: Value -> Parser SelfServiceRecoveryFlowState
parseJSON (Aeson.String Text
s) = case Text -> String
T.unpack Text
s of
    String
"choose_method" -> SelfServiceRecoveryFlowState -> Parser SelfServiceRecoveryFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowStateChooseMethod
    String
"sent_email" -> SelfServiceRecoveryFlowState -> Parser SelfServiceRecoveryFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowStateSentEmail
    String
"passed_challenge" -> SelfServiceRecoveryFlowState -> Parser SelfServiceRecoveryFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowStatePassedChallenge
    String
_ -> String -> Parser SelfServiceRecoveryFlowState
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid SelfServiceRecoveryFlowState"
  parseJSON Value
_ = String -> Parser SelfServiceRecoveryFlowState
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid SelfServiceRecoveryFlowState"

instance ToJSON SelfServiceRecoveryFlowState where
  toJSON :: SelfServiceRecoveryFlowState -> Value
toJSON (SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowStateChooseMethod) = Text -> Value
Aeson.String Text
"choose_method"
  toJSON (SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowStateSentEmail) = Text -> Value
Aeson.String Text
"sent_email"
  toJSON (SelfServiceRecoveryFlowState
SelfServiceRecoveryFlowStatePassedChallenge) = Text -> Value
Aeson.String Text
"passed_challenge"

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

instance FromJSON SelfServiceRecoveryLink

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

data SelfServiceRegistrationFlow = SelfServiceRegistrationFlow
  { SelfServiceRegistrationFlow -> Maybe IdentityCredentialsType
active :: Maybe IdentityCredentialsType,
    -- | ExpiresAt is the time (UTC) when the flow expires. If the user still wishes to log in, a new flow has to be initiated.
    SelfServiceRegistrationFlow -> UTCTime
expires_at :: UTCTime,
    SelfServiceRegistrationFlow -> UUID
id :: UUID,
    -- | IssuedAt is the time (UTC) when the flow occurred.
    SelfServiceRegistrationFlow -> UTCTime
issued_at :: UTCTime,
    -- | RequestURL is the initial URL that was requested from Ory Kratos. It can be used to forward information contained in the URL's path or query for example.
    SelfServiceRegistrationFlow -> Text
request_url :: Text,
    -- | ReturnTo contains the requested return_to URL.
    SelfServiceRegistrationFlow -> Maybe Text
return_to :: Maybe Text,
    -- | The flow type can either be `api` or `browser`.
    SelfServiceRegistrationFlow -> Text
_type :: Text,
    SelfServiceRegistrationFlow -> UiContainer
ui :: UiContainer
  }
  deriving stock (Int -> SelfServiceRegistrationFlow -> ShowS
[SelfServiceRegistrationFlow] -> ShowS
SelfServiceRegistrationFlow -> String
(Int -> SelfServiceRegistrationFlow -> ShowS)
-> (SelfServiceRegistrationFlow -> String)
-> ([SelfServiceRegistrationFlow] -> ShowS)
-> Show SelfServiceRegistrationFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceRegistrationFlow] -> ShowS
$cshowList :: [SelfServiceRegistrationFlow] -> ShowS
show :: SelfServiceRegistrationFlow -> String
$cshow :: SelfServiceRegistrationFlow -> String
showsPrec :: Int -> SelfServiceRegistrationFlow -> ShowS
$cshowsPrec :: Int -> SelfServiceRegistrationFlow -> ShowS
Show, SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow -> Bool
(SelfServiceRegistrationFlow
 -> SelfServiceRegistrationFlow -> Bool)
-> (SelfServiceRegistrationFlow
    -> SelfServiceRegistrationFlow -> Bool)
-> Eq SelfServiceRegistrationFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow -> Bool
$c/= :: SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow -> Bool
== :: SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow -> Bool
$c== :: SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow -> Bool
Eq, (forall x.
 SelfServiceRegistrationFlow -> Rep SelfServiceRegistrationFlow x)
-> (forall x.
    Rep SelfServiceRegistrationFlow x -> SelfServiceRegistrationFlow)
-> Generic SelfServiceRegistrationFlow
forall x.
Rep SelfServiceRegistrationFlow x -> SelfServiceRegistrationFlow
forall x.
SelfServiceRegistrationFlow -> Rep SelfServiceRegistrationFlow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelfServiceRegistrationFlow x -> SelfServiceRegistrationFlow
$cfrom :: forall x.
SelfServiceRegistrationFlow -> Rep SelfServiceRegistrationFlow x
Generic, Typeable SelfServiceRegistrationFlow
DataType
Constr
Typeable SelfServiceRegistrationFlow
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceRegistrationFlow
    -> c SelfServiceRegistrationFlow)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SelfServiceRegistrationFlow)
-> (SelfServiceRegistrationFlow -> Constr)
-> (SelfServiceRegistrationFlow -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SelfServiceRegistrationFlow))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceRegistrationFlow))
-> ((forall b. Data b => b -> b)
    -> SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceRegistrationFlow
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceRegistrationFlow
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SelfServiceRegistrationFlow -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SelfServiceRegistrationFlow
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow)
-> Data SelfServiceRegistrationFlow
SelfServiceRegistrationFlow -> DataType
SelfServiceRegistrationFlow -> Constr
(forall b. Data b => b -> b)
-> SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRegistrationFlow
-> c SelfServiceRegistrationFlow
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRegistrationFlow
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) -> SelfServiceRegistrationFlow -> u
forall u.
(forall d. Data d => d -> u) -> SelfServiceRegistrationFlow -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRegistrationFlow
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRegistrationFlow
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRegistrationFlow
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRegistrationFlow
-> c SelfServiceRegistrationFlow
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceRegistrationFlow)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceRegistrationFlow)
$cSelfServiceRegistrationFlow :: Constr
$tSelfServiceRegistrationFlow :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceRegistrationFlow -> m SelfServiceRegistrationFlow
gmapQi :: Int
-> (forall d. Data d => d -> u) -> SelfServiceRegistrationFlow -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SelfServiceRegistrationFlow -> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceRegistrationFlow -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelfServiceRegistrationFlow -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRegistrationFlow
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRegistrationFlow
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRegistrationFlow
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceRegistrationFlow
-> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceRegistrationFlow -> SelfServiceRegistrationFlow
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceRegistrationFlow)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceRegistrationFlow)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SelfServiceRegistrationFlow)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceRegistrationFlow)
dataTypeOf :: SelfServiceRegistrationFlow -> DataType
$cdataTypeOf :: SelfServiceRegistrationFlow -> DataType
toConstr :: SelfServiceRegistrationFlow -> Constr
$ctoConstr :: SelfServiceRegistrationFlow -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRegistrationFlow
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceRegistrationFlow
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRegistrationFlow
-> c SelfServiceRegistrationFlow
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceRegistrationFlow
-> c SelfServiceRegistrationFlow
$cp1Data :: Typeable SelfServiceRegistrationFlow
Data)

instance FromJSON SelfServiceRegistrationFlow where
  parseJSON :: Value -> Parser SelfServiceRegistrationFlow
parseJSON = Options -> Value -> Parser SelfServiceRegistrationFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
customOptions

instance ToJSON SelfServiceRegistrationFlow where
  toJSON :: SelfServiceRegistrationFlow -> Value
toJSON = Options -> SelfServiceRegistrationFlow -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
customOptions
  toEncoding :: SelfServiceRegistrationFlow -> Encoding
toEncoding = Options -> SelfServiceRegistrationFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
customOptions

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

instance
  ( FromJSON traits,
    FromJSON metadataAdmin,
    FromJSON metadataPublic
  ) =>
  FromJSON (SelfServiceSettingsFlow traits metadataAdmin metadataPublic)
  where
  parseJSON :: Value
-> Parser
     (SelfServiceSettingsFlow traits metadataAdmin metadataPublic)
parseJSON = Options
-> Value
-> Parser
     (SelfServiceSettingsFlow traits metadataAdmin metadataPublic)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
customOptions

instance
  ( ToJSON traits,
    ToJSON metadataAdmin,
    ToJSON metadataPublic
  ) =>
  ToJSON (SelfServiceSettingsFlow traits metadataAdmin metadataPublic)
  where
  toJSON :: SelfServiceSettingsFlow traits metadataAdmin metadataPublic
-> Value
toJSON = Options
-> SelfServiceSettingsFlow traits metadataAdmin metadataPublic
-> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
customOptions
  toEncoding :: SelfServiceSettingsFlow traits metadataAdmin metadataPublic
-> Encoding
toEncoding = Options
-> SelfServiceSettingsFlow traits metadataAdmin metadataPublic
-> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
customOptions

-- | show_form: No user data has been collected, or it is invalid, and thus the form should be shown. success: Indicates that the settings flow has been updated successfully with the provided data. Done will stay true when repeatedly checking. If set to true, done will revert back to false only when a flow with invalid (e.g. \"please use a valid phone number\") data was sent.
data SelfServiceSettingsFlowState = SelfServiceSettingsFlowStateShowForm | SelfServiceSettingsFlowStateSuccess deriving stock (Int -> SelfServiceSettingsFlowState -> ShowS
[SelfServiceSettingsFlowState] -> ShowS
SelfServiceSettingsFlowState -> String
(Int -> SelfServiceSettingsFlowState -> ShowS)
-> (SelfServiceSettingsFlowState -> String)
-> ([SelfServiceSettingsFlowState] -> ShowS)
-> Show SelfServiceSettingsFlowState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceSettingsFlowState] -> ShowS
$cshowList :: [SelfServiceSettingsFlowState] -> ShowS
show :: SelfServiceSettingsFlowState -> String
$cshow :: SelfServiceSettingsFlowState -> String
showsPrec :: Int -> SelfServiceSettingsFlowState -> ShowS
$cshowsPrec :: Int -> SelfServiceSettingsFlowState -> ShowS
Show, SelfServiceSettingsFlowState
-> SelfServiceSettingsFlowState -> Bool
(SelfServiceSettingsFlowState
 -> SelfServiceSettingsFlowState -> Bool)
-> (SelfServiceSettingsFlowState
    -> SelfServiceSettingsFlowState -> Bool)
-> Eq SelfServiceSettingsFlowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceSettingsFlowState
-> SelfServiceSettingsFlowState -> Bool
$c/= :: SelfServiceSettingsFlowState
-> SelfServiceSettingsFlowState -> Bool
== :: SelfServiceSettingsFlowState
-> SelfServiceSettingsFlowState -> Bool
$c== :: SelfServiceSettingsFlowState
-> SelfServiceSettingsFlowState -> Bool
Eq, (forall x.
 SelfServiceSettingsFlowState -> Rep SelfServiceSettingsFlowState x)
-> (forall x.
    Rep SelfServiceSettingsFlowState x -> SelfServiceSettingsFlowState)
-> Generic SelfServiceSettingsFlowState
forall x.
Rep SelfServiceSettingsFlowState x -> SelfServiceSettingsFlowState
forall x.
SelfServiceSettingsFlowState -> Rep SelfServiceSettingsFlowState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelfServiceSettingsFlowState x -> SelfServiceSettingsFlowState
$cfrom :: forall x.
SelfServiceSettingsFlowState -> Rep SelfServiceSettingsFlowState x
Generic, Typeable SelfServiceSettingsFlowState
DataType
Constr
Typeable SelfServiceSettingsFlowState
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceSettingsFlowState
    -> c SelfServiceSettingsFlowState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c SelfServiceSettingsFlowState)
-> (SelfServiceSettingsFlowState -> Constr)
-> (SelfServiceSettingsFlowState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SelfServiceSettingsFlowState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceSettingsFlowState))
-> ((forall b. Data b => b -> b)
    -> SelfServiceSettingsFlowState -> SelfServiceSettingsFlowState)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceSettingsFlowState
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceSettingsFlowState
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> SelfServiceSettingsFlowState -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SelfServiceSettingsFlowState
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState)
-> Data SelfServiceSettingsFlowState
SelfServiceSettingsFlowState -> DataType
SelfServiceSettingsFlowState -> Constr
(forall b. Data b => b -> b)
-> SelfServiceSettingsFlowState -> SelfServiceSettingsFlowState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceSettingsFlowState
-> c SelfServiceSettingsFlowState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceSettingsFlowState
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)
-> SelfServiceSettingsFlowState
-> u
forall u.
(forall d. Data d => d -> u) -> SelfServiceSettingsFlowState -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceSettingsFlowState
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceSettingsFlowState
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceSettingsFlowState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceSettingsFlowState
-> c SelfServiceSettingsFlowState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceSettingsFlowState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceSettingsFlowState)
$cSelfServiceSettingsFlowStateSuccess :: Constr
$cSelfServiceSettingsFlowStateShowForm :: Constr
$tSelfServiceSettingsFlowState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceSettingsFlowState -> m SelfServiceSettingsFlowState
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> SelfServiceSettingsFlowState
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SelfServiceSettingsFlowState
-> u
gmapQ :: (forall d. Data d => d -> u) -> SelfServiceSettingsFlowState -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SelfServiceSettingsFlowState -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceSettingsFlowState
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceSettingsFlowState
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceSettingsFlowState
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceSettingsFlowState
-> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceSettingsFlowState -> SelfServiceSettingsFlowState
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceSettingsFlowState -> SelfServiceSettingsFlowState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceSettingsFlowState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceSettingsFlowState)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SelfServiceSettingsFlowState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceSettingsFlowState)
dataTypeOf :: SelfServiceSettingsFlowState -> DataType
$cdataTypeOf :: SelfServiceSettingsFlowState -> DataType
toConstr :: SelfServiceSettingsFlowState -> Constr
$ctoConstr :: SelfServiceSettingsFlowState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceSettingsFlowState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SelfServiceSettingsFlowState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceSettingsFlowState
-> c SelfServiceSettingsFlowState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceSettingsFlowState
-> c SelfServiceSettingsFlowState
$cp1Data :: Typeable SelfServiceSettingsFlowState
Data)

instance FromJSON SelfServiceSettingsFlowState where
  parseJSON :: Value -> Parser SelfServiceSettingsFlowState
parseJSON (Aeson.String Text
s) = case Text -> String
T.unpack Text
s of
    String
"show_form" -> SelfServiceSettingsFlowState -> Parser SelfServiceSettingsFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceSettingsFlowState
SelfServiceSettingsFlowStateShowForm
    String
"success" -> SelfServiceSettingsFlowState -> Parser SelfServiceSettingsFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceSettingsFlowState
SelfServiceSettingsFlowStateSuccess
    String
_ -> String -> Parser SelfServiceSettingsFlowState
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid SelfServiceSettingsFlowState"
  parseJSON Value
_ = String -> Parser SelfServiceSettingsFlowState
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid SelfServiceSettingsFlowState"

instance ToJSON SelfServiceSettingsFlowState where
  toJSON :: SelfServiceSettingsFlowState -> Value
toJSON (SelfServiceSettingsFlowState
SelfServiceSettingsFlowStateShowForm) = Text -> Value
Aeson.String Text
"show_form"
  toJSON (SelfServiceSettingsFlowState
SelfServiceSettingsFlowStateSuccess) = Text -> Value
Aeson.String Text
"success"

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

instance FromJSON SelfServiceVerificationFlow where
  parseJSON :: Value -> Parser SelfServiceVerificationFlow
parseJSON = Options -> Value -> Parser SelfServiceVerificationFlow
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
customOptions

instance ToJSON SelfServiceVerificationFlow where
  toJSON :: SelfServiceVerificationFlow -> Value
toJSON = Options -> SelfServiceVerificationFlow -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
customOptions
  toEncoding :: SelfServiceVerificationFlow -> Encoding
toEncoding = Options -> SelfServiceVerificationFlow -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
customOptions

-- | The state represents the state of the verification flow.  choose_method: ask the user to choose a method (e.g. recover account via email) sent_email: the email has been sent to the user passed_challenge: the request was successful and the recovery challenge was passed.
data SelfServiceVerificationFlowState
  = SelfServiceVerificationFlowStateChooseMethod
  | SelfServiceVerificationFlowStateSentEmail
  | SelfServiceVerificationFlowStatePassedChallenge
  deriving stock (Int -> SelfServiceVerificationFlowState -> ShowS
[SelfServiceVerificationFlowState] -> ShowS
SelfServiceVerificationFlowState -> String
(Int -> SelfServiceVerificationFlowState -> ShowS)
-> (SelfServiceVerificationFlowState -> String)
-> ([SelfServiceVerificationFlowState] -> ShowS)
-> Show SelfServiceVerificationFlowState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfServiceVerificationFlowState] -> ShowS
$cshowList :: [SelfServiceVerificationFlowState] -> ShowS
show :: SelfServiceVerificationFlowState -> String
$cshow :: SelfServiceVerificationFlowState -> String
showsPrec :: Int -> SelfServiceVerificationFlowState -> ShowS
$cshowsPrec :: Int -> SelfServiceVerificationFlowState -> ShowS
Show, SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState -> Bool
(SelfServiceVerificationFlowState
 -> SelfServiceVerificationFlowState -> Bool)
-> (SelfServiceVerificationFlowState
    -> SelfServiceVerificationFlowState -> Bool)
-> Eq SelfServiceVerificationFlowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState -> Bool
$c/= :: SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState -> Bool
== :: SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState -> Bool
$c== :: SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState -> Bool
Eq, (forall x.
 SelfServiceVerificationFlowState
 -> Rep SelfServiceVerificationFlowState x)
-> (forall x.
    Rep SelfServiceVerificationFlowState x
    -> SelfServiceVerificationFlowState)
-> Generic SelfServiceVerificationFlowState
forall x.
Rep SelfServiceVerificationFlowState x
-> SelfServiceVerificationFlowState
forall x.
SelfServiceVerificationFlowState
-> Rep SelfServiceVerificationFlowState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SelfServiceVerificationFlowState x
-> SelfServiceVerificationFlowState
$cfrom :: forall x.
SelfServiceVerificationFlowState
-> Rep SelfServiceVerificationFlowState x
Generic, Typeable SelfServiceVerificationFlowState
DataType
Constr
Typeable SelfServiceVerificationFlowState
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SelfServiceVerificationFlowState
    -> c SelfServiceVerificationFlowState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c SelfServiceVerificationFlowState)
-> (SelfServiceVerificationFlowState -> Constr)
-> (SelfServiceVerificationFlowState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SelfServiceVerificationFlowState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SelfServiceVerificationFlowState))
-> ((forall b. Data b => b -> b)
    -> SelfServiceVerificationFlowState
    -> SelfServiceVerificationFlowState)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceVerificationFlowState
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SelfServiceVerificationFlowState
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> SelfServiceVerificationFlowState -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SelfServiceVerificationFlowState
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceVerificationFlowState
    -> m SelfServiceVerificationFlowState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceVerificationFlowState
    -> m SelfServiceVerificationFlowState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SelfServiceVerificationFlowState
    -> m SelfServiceVerificationFlowState)
-> Data SelfServiceVerificationFlowState
SelfServiceVerificationFlowState -> DataType
SelfServiceVerificationFlowState -> Constr
(forall b. Data b => b -> b)
-> SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceVerificationFlowState
-> c SelfServiceVerificationFlowState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceVerificationFlowState
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)
-> SelfServiceVerificationFlowState
-> u
forall u.
(forall d. Data d => d -> u)
-> SelfServiceVerificationFlowState -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceVerificationFlowState
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceVerificationFlowState
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceVerificationFlowState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceVerificationFlowState
-> c SelfServiceVerificationFlowState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceVerificationFlowState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceVerificationFlowState)
$cSelfServiceVerificationFlowStatePassedChallenge :: Constr
$cSelfServiceVerificationFlowStateSentEmail :: Constr
$cSelfServiceVerificationFlowStateChooseMethod :: Constr
$tSelfServiceVerificationFlowState :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
gmapMp :: (forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
gmapM :: (forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SelfServiceVerificationFlowState
-> m SelfServiceVerificationFlowState
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> SelfServiceVerificationFlowState
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SelfServiceVerificationFlowState
-> u
gmapQ :: (forall d. Data d => d -> u)
-> SelfServiceVerificationFlowState -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> SelfServiceVerificationFlowState -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceVerificationFlowState
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceVerificationFlowState
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceVerificationFlowState
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SelfServiceVerificationFlowState
-> r
gmapT :: (forall b. Data b => b -> b)
-> SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState
$cgmapT :: (forall b. Data b => b -> b)
-> SelfServiceVerificationFlowState
-> SelfServiceVerificationFlowState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceVerificationFlowState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SelfServiceVerificationFlowState)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SelfServiceVerificationFlowState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SelfServiceVerificationFlowState)
dataTypeOf :: SelfServiceVerificationFlowState -> DataType
$cdataTypeOf :: SelfServiceVerificationFlowState -> DataType
toConstr :: SelfServiceVerificationFlowState -> Constr
$ctoConstr :: SelfServiceVerificationFlowState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceVerificationFlowState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SelfServiceVerificationFlowState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceVerificationFlowState
-> c SelfServiceVerificationFlowState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SelfServiceVerificationFlowState
-> c SelfServiceVerificationFlowState
$cp1Data :: Typeable SelfServiceVerificationFlowState
Data)

instance FromJSON SelfServiceVerificationFlowState where
  parseJSON :: Value -> Parser SelfServiceVerificationFlowState
parseJSON (Aeson.String Text
s) = case Text -> String
T.unpack Text
s of
    String
"choose_method" -> SelfServiceVerificationFlowState
-> Parser SelfServiceVerificationFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceVerificationFlowState
SelfServiceVerificationFlowStateChooseMethod
    String
"sent_email" -> SelfServiceVerificationFlowState
-> Parser SelfServiceVerificationFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceVerificationFlowState
SelfServiceVerificationFlowStateSentEmail
    String
"passed_challenge" -> SelfServiceVerificationFlowState
-> Parser SelfServiceVerificationFlowState
forall (m :: * -> *) a. Monad m => a -> m a
return SelfServiceVerificationFlowState
SelfServiceVerificationFlowStatePassedChallenge
    String
_ -> String -> Parser SelfServiceVerificationFlowState
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid SelfServiceRecoveryFlowState"
  parseJSON Value
_ = String -> Parser SelfServiceVerificationFlowState
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid SelfServiceRecoveryFlowState"

instance ToJSON SelfServiceVerificationFlowState where
  toJSON :: SelfServiceVerificationFlowState -> Value
toJSON (SelfServiceVerificationFlowState
SelfServiceVerificationFlowStateChooseMethod) = Text -> Value
Aeson.String Text
"choose_method"
  toJSON (SelfServiceVerificationFlowState
SelfServiceVerificationFlowStateSentEmail) = Text -> Value
Aeson.String Text
"sent_email"
  toJSON (SelfServiceVerificationFlowState
SelfServiceVerificationFlowStatePassedChallenge) = Text -> Value
Aeson.String Text
"passed_challenge"