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

module OryKratos.Types.Types
  ( AuthenticatorAssuranceLevel (..),
    ErrorAuthenticatorAssuranceLevelNotSatisfied (..),
    GenericError (..),
    GetVersion200Response (..),
    HealthNotReadyStatus (..),
    HealthStatus (..),
    IsAlive200Response (..),
    IsReady503Response (..),
    JsonError (..),
    NeedsPrivilegedSessionError (..),
    Pagination (..),
    RecoveryAddress (..),
    RevokedSessions (..),
    SessionAuthenticationMethod (..),
    SessionDevice (..),
    SubmitSelfServiceFlowWithWebAuthnRegistrationMethod (..),
    VerifiableIdentityAddress (..),
    Version (..),
  )
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 (removeFieldLabelPrefix)

-- | The authenticator assurance level can be one of \"aal1\", \"aal2\", or \"aal3\". A higher number means that it is harder for an attacker to compromise the account.  Generally, \"aal1\" implies that one authentication factor was used while AAL2 implies that two factors (e.g. password + TOTP) have been used.  To learn more about these levels please head over to: https://www.ory.sh/kratos/docs/concepts/credentials
data AuthenticatorAssuranceLevel
  = AuthenticatorAssuranceLevel0
  | AuthenticatorAssuranceLevel1
  | AuthenticatorAssuranceLevel2
  | AuthenticatorAssuranceLevel3
  deriving stock (Int -> AuthenticatorAssuranceLevel -> ShowS
[AuthenticatorAssuranceLevel] -> ShowS
AuthenticatorAssuranceLevel -> String
(Int -> AuthenticatorAssuranceLevel -> ShowS)
-> (AuthenticatorAssuranceLevel -> String)
-> ([AuthenticatorAssuranceLevel] -> ShowS)
-> Show AuthenticatorAssuranceLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatorAssuranceLevel] -> ShowS
$cshowList :: [AuthenticatorAssuranceLevel] -> ShowS
show :: AuthenticatorAssuranceLevel -> String
$cshow :: AuthenticatorAssuranceLevel -> String
showsPrec :: Int -> AuthenticatorAssuranceLevel -> ShowS
$cshowsPrec :: Int -> AuthenticatorAssuranceLevel -> ShowS
Show, AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel -> Bool
(AuthenticatorAssuranceLevel
 -> AuthenticatorAssuranceLevel -> Bool)
-> (AuthenticatorAssuranceLevel
    -> AuthenticatorAssuranceLevel -> Bool)
-> Eq AuthenticatorAssuranceLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel -> Bool
$c/= :: AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel -> Bool
== :: AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel -> Bool
$c== :: AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel -> Bool
Eq, (forall x.
 AuthenticatorAssuranceLevel -> Rep AuthenticatorAssuranceLevel x)
-> (forall x.
    Rep AuthenticatorAssuranceLevel x -> AuthenticatorAssuranceLevel)
-> Generic AuthenticatorAssuranceLevel
forall x.
Rep AuthenticatorAssuranceLevel x -> AuthenticatorAssuranceLevel
forall x.
AuthenticatorAssuranceLevel -> Rep AuthenticatorAssuranceLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthenticatorAssuranceLevel x -> AuthenticatorAssuranceLevel
$cfrom :: forall x.
AuthenticatorAssuranceLevel -> Rep AuthenticatorAssuranceLevel x
Generic, Typeable AuthenticatorAssuranceLevel
DataType
Constr
Typeable AuthenticatorAssuranceLevel
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> AuthenticatorAssuranceLevel
    -> c AuthenticatorAssuranceLevel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AuthenticatorAssuranceLevel)
-> (AuthenticatorAssuranceLevel -> Constr)
-> (AuthenticatorAssuranceLevel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c AuthenticatorAssuranceLevel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AuthenticatorAssuranceLevel))
-> ((forall b. Data b => b -> b)
    -> AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AuthenticatorAssuranceLevel
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AuthenticatorAssuranceLevel
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AuthenticatorAssuranceLevel -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> AuthenticatorAssuranceLevel
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel)
-> Data AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel -> DataType
AuthenticatorAssuranceLevel -> Constr
(forall b. Data b => b -> b)
-> AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AuthenticatorAssuranceLevel
-> c AuthenticatorAssuranceLevel
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AuthenticatorAssuranceLevel
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) -> AuthenticatorAssuranceLevel -> u
forall u.
(forall d. Data d => d -> u) -> AuthenticatorAssuranceLevel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AuthenticatorAssuranceLevel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AuthenticatorAssuranceLevel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AuthenticatorAssuranceLevel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AuthenticatorAssuranceLevel
-> c AuthenticatorAssuranceLevel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AuthenticatorAssuranceLevel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AuthenticatorAssuranceLevel)
$cAuthenticatorAssuranceLevel3 :: Constr
$cAuthenticatorAssuranceLevel2 :: Constr
$cAuthenticatorAssuranceLevel1 :: Constr
$cAuthenticatorAssuranceLevel0 :: Constr
$tAuthenticatorAssuranceLevel :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
gmapMp :: (forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
gmapM :: (forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AuthenticatorAssuranceLevel -> m AuthenticatorAssuranceLevel
gmapQi :: Int
-> (forall d. Data d => d -> u) -> AuthenticatorAssuranceLevel -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> AuthenticatorAssuranceLevel -> u
gmapQ :: (forall d. Data d => d -> u) -> AuthenticatorAssuranceLevel -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AuthenticatorAssuranceLevel -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AuthenticatorAssuranceLevel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AuthenticatorAssuranceLevel
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AuthenticatorAssuranceLevel
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AuthenticatorAssuranceLevel
-> r
gmapT :: (forall b. Data b => b -> b)
-> AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel
$cgmapT :: (forall b. Data b => b -> b)
-> AuthenticatorAssuranceLevel -> AuthenticatorAssuranceLevel
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AuthenticatorAssuranceLevel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AuthenticatorAssuranceLevel)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c AuthenticatorAssuranceLevel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c AuthenticatorAssuranceLevel)
dataTypeOf :: AuthenticatorAssuranceLevel -> DataType
$cdataTypeOf :: AuthenticatorAssuranceLevel -> DataType
toConstr :: AuthenticatorAssuranceLevel -> Constr
$ctoConstr :: AuthenticatorAssuranceLevel -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AuthenticatorAssuranceLevel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AuthenticatorAssuranceLevel
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AuthenticatorAssuranceLevel
-> c AuthenticatorAssuranceLevel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AuthenticatorAssuranceLevel
-> c AuthenticatorAssuranceLevel
$cp1Data :: Typeable AuthenticatorAssuranceLevel
Data)

instance FromJSON AuthenticatorAssuranceLevel where
  parseJSON :: Value -> Parser AuthenticatorAssuranceLevel
parseJSON (Aeson.String Text
s) = case Text -> String
T.unpack Text
s of
    String
"aal0" -> AuthenticatorAssuranceLevel -> Parser AuthenticatorAssuranceLevel
forall (m :: * -> *) a. Monad m => a -> m a
return AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel0
    String
"aal1" -> AuthenticatorAssuranceLevel -> Parser AuthenticatorAssuranceLevel
forall (m :: * -> *) a. Monad m => a -> m a
return AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel1
    String
"aal2" -> AuthenticatorAssuranceLevel -> Parser AuthenticatorAssuranceLevel
forall (m :: * -> *) a. Monad m => a -> m a
return AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel2
    String
"aal3" -> AuthenticatorAssuranceLevel -> Parser AuthenticatorAssuranceLevel
forall (m :: * -> *) a. Monad m => a -> m a
return AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel3
    String
_ -> String -> Parser AuthenticatorAssuranceLevel
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid AuthenticatorAssuranceLevel"
  parseJSON Value
_ = String -> Parser AuthenticatorAssuranceLevel
forall a. HasCallStack => String -> a
Prelude.error String
"Invalid AuthenticatorAssuranceLevel"

instance ToJSON AuthenticatorAssuranceLevel where
  toJSON :: AuthenticatorAssuranceLevel -> Value
toJSON (AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel0) = Text -> Value
Aeson.String Text
"aal0"
  toJSON (AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel1) = Text -> Value
Aeson.String Text
"aal1"
  toJSON (AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel2) = Text -> Value
Aeson.String Text
"aal2"
  toJSON (AuthenticatorAssuranceLevel
AuthenticatorAssuranceLevel3) = Text -> Value
Aeson.String Text
"aal3"

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

instance FromJSON ErrorAuthenticatorAssuranceLevelNotSatisfied where
  parseJSON :: Value -> Parser ErrorAuthenticatorAssuranceLevelNotSatisfied
parseJSON = Options
-> Value -> Parser ErrorAuthenticatorAssuranceLevelNotSatisfied
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"errorAuthenticatorAssuranceLevelNotSatisfied")

instance ToJSON ErrorAuthenticatorAssuranceLevelNotSatisfied where
  toJSON :: ErrorAuthenticatorAssuranceLevelNotSatisfied -> Value
toJSON = Options -> ErrorAuthenticatorAssuranceLevelNotSatisfied -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"errorAuthenticatorAssuranceLevelNotSatisfied")
  toEncoding :: ErrorAuthenticatorAssuranceLevelNotSatisfied -> Encoding
toEncoding = Options -> ErrorAuthenticatorAssuranceLevelNotSatisfied -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"errorAuthenticatorAssuranceLevelNotSatisfied")

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

instance FromJSON GenericError where
  parseJSON :: Value -> Parser GenericError
parseJSON = Options -> Value -> Parser GenericError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"genericError")

instance ToJSON GenericError where
  toJSON :: GenericError -> Value
toJSON = Options -> GenericError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"genericError")
  toEncoding :: GenericError -> Encoding
toEncoding = Options -> GenericError -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"genericError")

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

instance FromJSON GetVersion200Response where
  parseJSON :: Value -> Parser GetVersion200Response
parseJSON = Options -> Value -> Parser GetVersion200Response
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"getVersion200Response")

instance ToJSON GetVersion200Response where
  toJSON :: GetVersion200Response -> Value
toJSON = Options -> GetVersion200Response -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"getVersion200Response")
  toEncoding :: GetVersion200Response -> Encoding
toEncoding = Options -> GetVersion200Response -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"getVersion200Response")

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

instance FromJSON HealthNotReadyStatus where
  parseJSON :: Value -> Parser HealthNotReadyStatus
parseJSON = Options -> Value -> Parser HealthNotReadyStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"healthNotReadyStatus")

instance ToJSON HealthNotReadyStatus where
  toJSON :: HealthNotReadyStatus -> Value
toJSON = Options -> HealthNotReadyStatus -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"healthNotReadyStatus")
  toEncoding :: HealthNotReadyStatus -> Encoding
toEncoding = Options -> HealthNotReadyStatus -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"healthNotReadyStatus")

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

instance FromJSON HealthStatus where
  parseJSON :: Value -> Parser HealthStatus
parseJSON = Options -> Value -> Parser HealthStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"healthStatus")

instance ToJSON HealthStatus where
  toJSON :: HealthStatus -> Value
toJSON = Options -> HealthStatus -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"healthStatus")
  toEncoding :: HealthStatus -> Encoding
toEncoding = Options -> HealthStatus -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"healthStatus")

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

instance FromJSON IsAlive200Response where
  parseJSON :: Value -> Parser IsAlive200Response
parseJSON = Options -> Value -> Parser IsAlive200Response
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"isAlive200Response")

instance ToJSON IsAlive200Response where
  toJSON :: IsAlive200Response -> Value
toJSON = Options -> IsAlive200Response -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"isAlive200Response")
  toEncoding :: IsAlive200Response -> Encoding
toEncoding = Options -> IsAlive200Response -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"isAlive200Response")

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

instance FromJSON IsReady503Response where
  parseJSON :: Value -> Parser IsReady503Response
parseJSON = Options -> Value -> Parser IsReady503Response
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"isReady503Response")

instance ToJSON IsReady503Response where
  toJSON :: IsReady503Response -> Value
toJSON = Options -> IsReady503Response -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"isReady503Response")
  toEncoding :: IsReady503Response -> Encoding
toEncoding = Options -> IsReady503Response -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"isReady503Response")

-- | The standard Ory JSON API error format.
data JsonError = JsonError
  { JsonError -> GenericError
jsonErrorError :: GenericError
  }
  deriving stock (Int -> JsonError -> ShowS
[JsonError] -> ShowS
JsonError -> String
(Int -> JsonError -> ShowS)
-> (JsonError -> String)
-> ([JsonError] -> ShowS)
-> Show JsonError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonError] -> ShowS
$cshowList :: [JsonError] -> ShowS
show :: JsonError -> String
$cshow :: JsonError -> String
showsPrec :: Int -> JsonError -> ShowS
$cshowsPrec :: Int -> JsonError -> ShowS
Show, JsonError -> JsonError -> Bool
(JsonError -> JsonError -> Bool)
-> (JsonError -> JsonError -> Bool) -> Eq JsonError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonError -> JsonError -> Bool
$c/= :: JsonError -> JsonError -> Bool
== :: JsonError -> JsonError -> Bool
$c== :: JsonError -> JsonError -> Bool
Eq, (forall x. JsonError -> Rep JsonError x)
-> (forall x. Rep JsonError x -> JsonError) -> Generic JsonError
forall x. Rep JsonError x -> JsonError
forall x. JsonError -> Rep JsonError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonError x -> JsonError
$cfrom :: forall x. JsonError -> Rep JsonError x
Generic, Typeable JsonError
DataType
Constr
Typeable JsonError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JsonError -> c JsonError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JsonError)
-> (JsonError -> Constr)
-> (JsonError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JsonError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonError))
-> ((forall b. Data b => b -> b) -> JsonError -> JsonError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JsonError -> r)
-> (forall u. (forall d. Data d => d -> u) -> JsonError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> JsonError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JsonError -> m JsonError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JsonError -> m JsonError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JsonError -> m JsonError)
-> Data JsonError
JsonError -> DataType
JsonError -> Constr
(forall b. Data b => b -> b) -> JsonError -> JsonError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonError -> c JsonError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonError
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) -> JsonError -> u
forall u. (forall d. Data d => d -> u) -> JsonError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonError -> m JsonError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonError -> m JsonError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonError -> c JsonError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonError)
$cJsonError :: Constr
$tJsonError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JsonError -> m JsonError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonError -> m JsonError
gmapMp :: (forall d. Data d => d -> m d) -> JsonError -> m JsonError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JsonError -> m JsonError
gmapM :: (forall d. Data d => d -> m d) -> JsonError -> m JsonError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JsonError -> m JsonError
gmapQi :: Int -> (forall d. Data d => d -> u) -> JsonError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JsonError -> u
gmapQ :: (forall d. Data d => d -> u) -> JsonError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JsonError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JsonError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JsonError -> r
gmapT :: (forall b. Data b => b -> b) -> JsonError -> JsonError
$cgmapT :: (forall b. Data b => b -> b) -> JsonError -> JsonError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JsonError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JsonError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JsonError)
dataTypeOf :: JsonError -> DataType
$cdataTypeOf :: JsonError -> DataType
toConstr :: JsonError -> Constr
$ctoConstr :: JsonError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JsonError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonError -> c JsonError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JsonError -> c JsonError
$cp1Data :: Typeable JsonError
Data)

instance FromJSON JsonError where
  parseJSON :: Value -> Parser JsonError
parseJSON = Options -> Value -> Parser JsonError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
True String
"jsonError")

instance ToJSON JsonError where
  toJSON :: JsonError -> Value
toJSON = Options -> JsonError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"jsonError")
  toEncoding :: JsonError -> Encoding
toEncoding = Options -> JsonError -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Bool -> String -> Options
removeFieldLabelPrefix Bool
False String
"jsonError")

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

instance FromJSON NeedsPrivilegedSessionError

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

data Pagination = Pagination
  { -- | Pagination Page
    Pagination -> Maybe Integer
page :: Maybe Integer,
    -- | Items per Page  This is the number of items per page.
    Pagination -> Maybe Integer
per_page :: Maybe Integer
  }
  deriving stock (Int -> Pagination -> ShowS
[Pagination] -> ShowS
Pagination -> String
(Int -> Pagination -> ShowS)
-> (Pagination -> String)
-> ([Pagination] -> ShowS)
-> Show Pagination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pagination] -> ShowS
$cshowList :: [Pagination] -> ShowS
show :: Pagination -> String
$cshow :: Pagination -> String
showsPrec :: Int -> Pagination -> ShowS
$cshowsPrec :: Int -> Pagination -> ShowS
Show, Pagination -> Pagination -> Bool
(Pagination -> Pagination -> Bool)
-> (Pagination -> Pagination -> Bool) -> Eq Pagination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pagination -> Pagination -> Bool
$c/= :: Pagination -> Pagination -> Bool
== :: Pagination -> Pagination -> Bool
$c== :: Pagination -> Pagination -> Bool
Eq, (forall x. Pagination -> Rep Pagination x)
-> (forall x. Rep Pagination x -> Pagination) -> Generic Pagination
forall x. Rep Pagination x -> Pagination
forall x. Pagination -> Rep Pagination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pagination x -> Pagination
$cfrom :: forall x. Pagination -> Rep Pagination x
Generic, Typeable Pagination
DataType
Constr
Typeable Pagination
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pagination -> c Pagination)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pagination)
-> (Pagination -> Constr)
-> (Pagination -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pagination))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Pagination))
-> ((forall b. Data b => b -> b) -> Pagination -> Pagination)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Pagination -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Pagination -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pagination -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Pagination -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pagination -> m Pagination)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pagination -> m Pagination)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pagination -> m Pagination)
-> Data Pagination
Pagination -> DataType
Pagination -> Constr
(forall b. Data b => b -> b) -> Pagination -> Pagination
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pagination -> c Pagination
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pagination
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) -> Pagination -> u
forall u. (forall d. Data d => d -> u) -> Pagination -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pagination -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pagination -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pagination -> m Pagination
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pagination -> m Pagination
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pagination
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pagination -> c Pagination
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pagination)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pagination)
$cPagination :: Constr
$tPagination :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pagination -> m Pagination
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pagination -> m Pagination
gmapMp :: (forall d. Data d => d -> m d) -> Pagination -> m Pagination
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pagination -> m Pagination
gmapM :: (forall d. Data d => d -> m d) -> Pagination -> m Pagination
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pagination -> m Pagination
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pagination -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pagination -> u
gmapQ :: (forall d. Data d => d -> u) -> Pagination -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pagination -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pagination -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pagination -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pagination -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pagination -> r
gmapT :: (forall b. Data b => b -> b) -> Pagination -> Pagination
$cgmapT :: (forall b. Data b => b -> b) -> Pagination -> Pagination
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pagination)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pagination)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pagination)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pagination)
dataTypeOf :: Pagination -> DataType
$cdataTypeOf :: Pagination -> DataType
toConstr :: Pagination -> Constr
$ctoConstr :: Pagination -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pagination
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pagination
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pagination -> c Pagination
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pagination -> c Pagination
$cp1Data :: Typeable Pagination
Data)

instance FromJSON Pagination

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

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

instance FromJSON RecoveryAddress

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

data RevokedSessions = RevokedSessions
  { -- | The number of sessions that were revoked.
    RevokedSessions -> Maybe Integer
count :: Maybe Integer
  }
  deriving stock (Int -> RevokedSessions -> ShowS
[RevokedSessions] -> ShowS
RevokedSessions -> String
(Int -> RevokedSessions -> ShowS)
-> (RevokedSessions -> String)
-> ([RevokedSessions] -> ShowS)
-> Show RevokedSessions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokedSessions] -> ShowS
$cshowList :: [RevokedSessions] -> ShowS
show :: RevokedSessions -> String
$cshow :: RevokedSessions -> String
showsPrec :: Int -> RevokedSessions -> ShowS
$cshowsPrec :: Int -> RevokedSessions -> ShowS
Show, RevokedSessions -> RevokedSessions -> Bool
(RevokedSessions -> RevokedSessions -> Bool)
-> (RevokedSessions -> RevokedSessions -> Bool)
-> Eq RevokedSessions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokedSessions -> RevokedSessions -> Bool
$c/= :: RevokedSessions -> RevokedSessions -> Bool
== :: RevokedSessions -> RevokedSessions -> Bool
$c== :: RevokedSessions -> RevokedSessions -> Bool
Eq, (forall x. RevokedSessions -> Rep RevokedSessions x)
-> (forall x. Rep RevokedSessions x -> RevokedSessions)
-> Generic RevokedSessions
forall x. Rep RevokedSessions x -> RevokedSessions
forall x. RevokedSessions -> Rep RevokedSessions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokedSessions x -> RevokedSessions
$cfrom :: forall x. RevokedSessions -> Rep RevokedSessions x
Generic, Typeable RevokedSessions
DataType
Constr
Typeable RevokedSessions
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RevokedSessions -> c RevokedSessions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RevokedSessions)
-> (RevokedSessions -> Constr)
-> (RevokedSessions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RevokedSessions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RevokedSessions))
-> ((forall b. Data b => b -> b)
    -> RevokedSessions -> RevokedSessions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RevokedSessions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RevokedSessions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RevokedSessions -> m RevokedSessions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RevokedSessions -> m RevokedSessions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RevokedSessions -> m RevokedSessions)
-> Data RevokedSessions
RevokedSessions -> DataType
RevokedSessions -> Constr
(forall b. Data b => b -> b) -> RevokedSessions -> RevokedSessions
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokedSessions -> c RevokedSessions
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokedSessions
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) -> RevokedSessions -> u
forall u. (forall d. Data d => d -> u) -> RevokedSessions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokedSessions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokedSessions -> c RevokedSessions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RevokedSessions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RevokedSessions)
$cRevokedSessions :: Constr
$tRevokedSessions :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
gmapMp :: (forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
gmapM :: (forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RevokedSessions -> m RevokedSessions
gmapQi :: Int -> (forall d. Data d => d -> u) -> RevokedSessions -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RevokedSessions -> u
gmapQ :: (forall d. Data d => d -> u) -> RevokedSessions -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RevokedSessions -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RevokedSessions -> r
gmapT :: (forall b. Data b => b -> b) -> RevokedSessions -> RevokedSessions
$cgmapT :: (forall b. Data b => b -> b) -> RevokedSessions -> RevokedSessions
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RevokedSessions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RevokedSessions)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RevokedSessions)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RevokedSessions)
dataTypeOf :: RevokedSessions -> DataType
$cdataTypeOf :: RevokedSessions -> DataType
toConstr :: RevokedSessions -> Constr
$ctoConstr :: RevokedSessions -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokedSessions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RevokedSessions
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokedSessions -> c RevokedSessions
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RevokedSessions -> c RevokedSessions
$cp1Data :: Typeable RevokedSessions
Data)

instance FromJSON RevokedSessions

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

-- | A singular authenticator used during authentication / login.
data SessionAuthenticationMethod = SessionAuthenticationMethod
  { SessionAuthenticationMethod -> Maybe AuthenticatorAssuranceLevel
aal :: Maybe AuthenticatorAssuranceLevel,
    -- | When the authentication challenge was completed.
    SessionAuthenticationMethod -> Maybe UTCTime
completed_at :: Maybe UTCTime,
    SessionAuthenticationMethod -> Maybe Text
method :: Maybe Text
  }
  deriving stock (Int -> SessionAuthenticationMethod -> ShowS
[SessionAuthenticationMethod] -> ShowS
SessionAuthenticationMethod -> String
(Int -> SessionAuthenticationMethod -> ShowS)
-> (SessionAuthenticationMethod -> String)
-> ([SessionAuthenticationMethod] -> ShowS)
-> Show SessionAuthenticationMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionAuthenticationMethod] -> ShowS
$cshowList :: [SessionAuthenticationMethod] -> ShowS
show :: SessionAuthenticationMethod -> String
$cshow :: SessionAuthenticationMethod -> String
showsPrec :: Int -> SessionAuthenticationMethod -> ShowS
$cshowsPrec :: Int -> SessionAuthenticationMethod -> ShowS
Show, SessionAuthenticationMethod -> SessionAuthenticationMethod -> Bool
(SessionAuthenticationMethod
 -> SessionAuthenticationMethod -> Bool)
-> (SessionAuthenticationMethod
    -> SessionAuthenticationMethod -> Bool)
-> Eq SessionAuthenticationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionAuthenticationMethod -> SessionAuthenticationMethod -> Bool
$c/= :: SessionAuthenticationMethod -> SessionAuthenticationMethod -> Bool
== :: SessionAuthenticationMethod -> SessionAuthenticationMethod -> Bool
$c== :: SessionAuthenticationMethod -> SessionAuthenticationMethod -> Bool
Eq, (forall x.
 SessionAuthenticationMethod -> Rep SessionAuthenticationMethod x)
-> (forall x.
    Rep SessionAuthenticationMethod x -> SessionAuthenticationMethod)
-> Generic SessionAuthenticationMethod
forall x.
Rep SessionAuthenticationMethod x -> SessionAuthenticationMethod
forall x.
SessionAuthenticationMethod -> Rep SessionAuthenticationMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SessionAuthenticationMethod x -> SessionAuthenticationMethod
$cfrom :: forall x.
SessionAuthenticationMethod -> Rep SessionAuthenticationMethod x
Generic, Typeable SessionAuthenticationMethod
DataType
Constr
Typeable SessionAuthenticationMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SessionAuthenticationMethod
    -> c SessionAuthenticationMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SessionAuthenticationMethod)
-> (SessionAuthenticationMethod -> Constr)
-> (SessionAuthenticationMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SessionAuthenticationMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SessionAuthenticationMethod))
-> ((forall b. Data b => b -> b)
    -> SessionAuthenticationMethod -> SessionAuthenticationMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SessionAuthenticationMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SessionAuthenticationMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SessionAuthenticationMethod -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SessionAuthenticationMethod
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SessionAuthenticationMethod -> m SessionAuthenticationMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SessionAuthenticationMethod -> m SessionAuthenticationMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SessionAuthenticationMethod -> m SessionAuthenticationMethod)
-> Data SessionAuthenticationMethod
SessionAuthenticationMethod -> DataType
SessionAuthenticationMethod -> Constr
(forall b. Data b => b -> b)
-> SessionAuthenticationMethod -> SessionAuthenticationMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SessionAuthenticationMethod
-> c SessionAuthenticationMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SessionAuthenticationMethod
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) -> SessionAuthenticationMethod -> u
forall u.
(forall d. Data d => d -> u) -> SessionAuthenticationMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SessionAuthenticationMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SessionAuthenticationMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SessionAuthenticationMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SessionAuthenticationMethod
-> c SessionAuthenticationMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SessionAuthenticationMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SessionAuthenticationMethod)
$cSessionAuthenticationMethod :: Constr
$tSessionAuthenticationMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
gmapMp :: (forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
gmapM :: (forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SessionAuthenticationMethod -> m SessionAuthenticationMethod
gmapQi :: Int
-> (forall d. Data d => d -> u) -> SessionAuthenticationMethod -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> SessionAuthenticationMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> SessionAuthenticationMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SessionAuthenticationMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SessionAuthenticationMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SessionAuthenticationMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SessionAuthenticationMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SessionAuthenticationMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> SessionAuthenticationMethod -> SessionAuthenticationMethod
$cgmapT :: (forall b. Data b => b -> b)
-> SessionAuthenticationMethod -> SessionAuthenticationMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SessionAuthenticationMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SessionAuthenticationMethod)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SessionAuthenticationMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SessionAuthenticationMethod)
dataTypeOf :: SessionAuthenticationMethod -> DataType
$cdataTypeOf :: SessionAuthenticationMethod -> DataType
toConstr :: SessionAuthenticationMethod -> Constr
$ctoConstr :: SessionAuthenticationMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SessionAuthenticationMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SessionAuthenticationMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SessionAuthenticationMethod
-> c SessionAuthenticationMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SessionAuthenticationMethod
-> c SessionAuthenticationMethod
$cp1Data :: Typeable SessionAuthenticationMethod
Data)

instance FromJSON SessionAuthenticationMethod

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

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

instance FromJSON SessionDevice

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

data SubmitSelfServiceFlowWithWebAuthnRegistrationMethod = SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
  { -- | Register a WebAuthn Security Key  It is expected that the JSON returned by the WebAuthn registration process is included here.
    SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Maybe Text
webauthn_register :: Maybe Text,
    -- | Name of the WebAuthn Security Key to be Added  A human-readable name for the security key which will be added.
    SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Maybe Text
webauthn_register_displayname :: Maybe Text
  }
  deriving stock (Int -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> ShowS
[SubmitSelfServiceFlowWithWebAuthnRegistrationMethod] -> ShowS
SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> String
(Int
 -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> ShowS)
-> (SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> String)
-> ([SubmitSelfServiceFlowWithWebAuthnRegistrationMethod] -> ShowS)
-> Show SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubmitSelfServiceFlowWithWebAuthnRegistrationMethod] -> ShowS
$cshowList :: [SubmitSelfServiceFlowWithWebAuthnRegistrationMethod] -> ShowS
show :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> String
$cshow :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> String
showsPrec :: Int -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> ShowS
$cshowsPrec :: Int -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> ShowS
Show, SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool
(SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
 -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool)
-> (SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool)
-> Eq SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool
$c/= :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool
== :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool
$c== :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Bool
Eq, (forall x.
 SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
 -> Rep SubmitSelfServiceFlowWithWebAuthnRegistrationMethod x)
-> (forall x.
    Rep SubmitSelfServiceFlowWithWebAuthnRegistrationMethod x
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> Generic SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall x.
Rep SubmitSelfServiceFlowWithWebAuthnRegistrationMethod x
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall x.
SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> Rep SubmitSelfServiceFlowWithWebAuthnRegistrationMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SubmitSelfServiceFlowWithWebAuthnRegistrationMethod x
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cfrom :: forall x.
SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> Rep SubmitSelfServiceFlowWithWebAuthnRegistrationMethod x
Generic, Typeable SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
DataType
Constr
Typeable SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r)
    -> Constr
    -> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> (SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Constr)
-> (SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod))
-> ((forall b. Data b => b -> b)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> r)
-> (forall u.
    (forall d. Data d => d -> u)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
    -> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
-> Data SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> DataType
SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Constr
(forall b. Data b => b -> b)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
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)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> u
forall u.
(forall d. Data d => d -> u)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
$cSubmitSelfServiceFlowWithWebAuthnRegistrationMethod :: Constr
$tSubmitSelfServiceFlowWithWebAuthnRegistrationMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
gmapMp :: (forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
gmapM :: (forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> m SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
gmapQi :: Int
-> (forall d. Data d => d -> u)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> u
gmapQ :: (forall d. Data d => d -> u)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> r
gmapT :: (forall b. Data b => b -> b)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cgmapT :: (forall b. Data b => b -> b)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod)
dataTypeOf :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> DataType
$cdataTypeOf :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> DataType
toConstr :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Constr
$ctoConstr :: SubmitSelfServiceFlowWithWebAuthnRegistrationMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
-> c SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
$cp1Data :: Typeable SubmitSelfServiceFlowWithWebAuthnRegistrationMethod
Data)

instance FromJSON SubmitSelfServiceFlowWithWebAuthnRegistrationMethod

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

-- | VerifiableAddress is an identity's verifiable address
data VerifiableIdentityAddress = VerifiableIdentityAddress
  { -- | When this entry was created
    VerifiableIdentityAddress -> Maybe UTCTime
created_at :: Maybe UTCTime,
    VerifiableIdentityAddress -> UUID
id :: UUID,
    -- | VerifiableAddressStatus must not exceed 16 characters as that is the limitation in the SQL Schema
    VerifiableIdentityAddress -> Text
status :: Text,
    -- | When this entry was last updated
    VerifiableIdentityAddress -> Maybe UTCTime
updated_at :: Maybe UTCTime,
    -- | The address value  example foo@user.com
    VerifiableIdentityAddress -> Text
value :: Text,
    -- | Indicates if the address has already been verified
    VerifiableIdentityAddress -> Bool
verified :: Bool,
    VerifiableIdentityAddress -> Maybe UTCTime
verified_at :: Maybe UTCTime,
    -- | VerifiableAddressType must not exceed 16 characters as that is the limitation in the SQL Schema
    VerifiableIdentityAddress -> Text
via :: Text
  }
  deriving stock (Int -> VerifiableIdentityAddress -> ShowS
[VerifiableIdentityAddress] -> ShowS
VerifiableIdentityAddress -> String
(Int -> VerifiableIdentityAddress -> ShowS)
-> (VerifiableIdentityAddress -> String)
-> ([VerifiableIdentityAddress] -> ShowS)
-> Show VerifiableIdentityAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerifiableIdentityAddress] -> ShowS
$cshowList :: [VerifiableIdentityAddress] -> ShowS
show :: VerifiableIdentityAddress -> String
$cshow :: VerifiableIdentityAddress -> String
showsPrec :: Int -> VerifiableIdentityAddress -> ShowS
$cshowsPrec :: Int -> VerifiableIdentityAddress -> ShowS
Show, VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool
(VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool)
-> (VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool)
-> Eq VerifiableIdentityAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool
$c/= :: VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool
== :: VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool
$c== :: VerifiableIdentityAddress -> VerifiableIdentityAddress -> Bool
Eq, (forall x.
 VerifiableIdentityAddress -> Rep VerifiableIdentityAddress x)
-> (forall x.
    Rep VerifiableIdentityAddress x -> VerifiableIdentityAddress)
-> Generic VerifiableIdentityAddress
forall x.
Rep VerifiableIdentityAddress x -> VerifiableIdentityAddress
forall x.
VerifiableIdentityAddress -> Rep VerifiableIdentityAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep VerifiableIdentityAddress x -> VerifiableIdentityAddress
$cfrom :: forall x.
VerifiableIdentityAddress -> Rep VerifiableIdentityAddress x
Generic, Typeable VerifiableIdentityAddress
DataType
Constr
Typeable VerifiableIdentityAddress
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> VerifiableIdentityAddress
    -> c VerifiableIdentityAddress)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c VerifiableIdentityAddress)
-> (VerifiableIdentityAddress -> Constr)
-> (VerifiableIdentityAddress -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c VerifiableIdentityAddress))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c VerifiableIdentityAddress))
-> ((forall b. Data b => b -> b)
    -> VerifiableIdentityAddress -> VerifiableIdentityAddress)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VerifiableIdentityAddress
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> VerifiableIdentityAddress
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> VerifiableIdentityAddress -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> VerifiableIdentityAddress -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> VerifiableIdentityAddress -> m VerifiableIdentityAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerifiableIdentityAddress -> m VerifiableIdentityAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> VerifiableIdentityAddress -> m VerifiableIdentityAddress)
-> Data VerifiableIdentityAddress
VerifiableIdentityAddress -> DataType
VerifiableIdentityAddress -> Constr
(forall b. Data b => b -> b)
-> VerifiableIdentityAddress -> VerifiableIdentityAddress
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerifiableIdentityAddress
-> c VerifiableIdentityAddress
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableIdentityAddress
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) -> VerifiableIdentityAddress -> u
forall u.
(forall d. Data d => d -> u) -> VerifiableIdentityAddress -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerifiableIdentityAddress
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerifiableIdentityAddress
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableIdentityAddress
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerifiableIdentityAddress
-> c VerifiableIdentityAddress
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VerifiableIdentityAddress)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerifiableIdentityAddress)
$cVerifiableIdentityAddress :: Constr
$tVerifiableIdentityAddress :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
gmapMp :: (forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
gmapM :: (forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> VerifiableIdentityAddress -> m VerifiableIdentityAddress
gmapQi :: Int
-> (forall d. Data d => d -> u) -> VerifiableIdentityAddress -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> VerifiableIdentityAddress -> u
gmapQ :: (forall d. Data d => d -> u) -> VerifiableIdentityAddress -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> VerifiableIdentityAddress -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerifiableIdentityAddress
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerifiableIdentityAddress
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerifiableIdentityAddress
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> VerifiableIdentityAddress
-> r
gmapT :: (forall b. Data b => b -> b)
-> VerifiableIdentityAddress -> VerifiableIdentityAddress
$cgmapT :: (forall b. Data b => b -> b)
-> VerifiableIdentityAddress -> VerifiableIdentityAddress
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerifiableIdentityAddress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c VerifiableIdentityAddress)
dataCast1 :: (forall d. Data d => c (t d))
-> Maybe (c VerifiableIdentityAddress)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c VerifiableIdentityAddress)
dataTypeOf :: VerifiableIdentityAddress -> DataType
$cdataTypeOf :: VerifiableIdentityAddress -> DataType
toConstr :: VerifiableIdentityAddress -> Constr
$ctoConstr :: VerifiableIdentityAddress -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableIdentityAddress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VerifiableIdentityAddress
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerifiableIdentityAddress
-> c VerifiableIdentityAddress
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> VerifiableIdentityAddress
-> c VerifiableIdentityAddress
$cp1Data :: Typeable VerifiableIdentityAddress
Data)

instance FromJSON VerifiableIdentityAddress

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

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

instance FromJSON Version

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