{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -freduction-depth=328 #-}

module OryKratos.API
  ( -- * Client and Server
    Config (..),
    OryKratosBackend (..),
    createOryKratosClient,
    runOryKratosServer,
    runOryKratosMiddlewareServer,
    runOryKratosClient,
    runOryKratosClientWithManager,
    callOryKratos,
    OryKratosClient,
    OryKratosClientError (..),

    -- ** Servant
    OryKratosAPI,

    -- ** Plain WAI Application
    serverWaiApplicationOryKratos,
  )
where

import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT (..))
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Function ((&))
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import Data.UUID (UUID)
import GHC.Exts (IsString (..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Method (methodOptions)
import Network.Wai (Middleware)
import qualified Network.Wai.Handler.Warp as Warp
import OryKratos.Types
import Servant (ServerError, serve)
import Servant.API
import Servant.API.Verbs (StdMethod (..), Verb)
import Servant.Client
  ( ClientEnv,
    ClientError,
    Scheme (Http),
    client,
    mkClientEnv,
    parseBaseUrl,
  )
import Servant.Client.Core (baseUrlHost, baseUrlPort)
import Servant.Client.Internal.HttpClient (ClientM (..))
import Servant.Server (Application, Handler (..))
import Servant.Server.StaticFiles (serveDirectoryFileServer)
import Web.FormUrlEncoded
import Web.HttpApiData

-- | List of elements parsed from a query.
newtype QueryList (p :: CollectionFormat) a = QueryList
  { QueryList p a -> [a]
fromQueryList :: [a]
  }
  deriving stock (Functor (QueryList p)
Foldable (QueryList p)
Functor (QueryList p)
-> Foldable (QueryList p)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> QueryList p a -> f (QueryList p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    QueryList p (f a) -> f (QueryList p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> QueryList p a -> m (QueryList p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    QueryList p (m a) -> m (QueryList p a))
-> Traversable (QueryList p)
(a -> f b) -> QueryList p a -> f (QueryList p b)
forall (p :: CollectionFormat). Functor (QueryList p)
forall (p :: CollectionFormat). Foldable (QueryList p)
forall (p :: CollectionFormat) (m :: * -> *) a.
Monad m =>
QueryList p (m a) -> m (QueryList p a)
forall (p :: CollectionFormat) (f :: * -> *) a.
Applicative f =>
QueryList p (f a) -> f (QueryList p a)
forall (p :: CollectionFormat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryList p a -> m (QueryList p b)
forall (p :: CollectionFormat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
QueryList p (m a) -> m (QueryList p a)
forall (f :: * -> *) a.
Applicative f =>
QueryList p (f a) -> f (QueryList p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryList p a -> m (QueryList p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
sequence :: QueryList p (m a) -> m (QueryList p a)
$csequence :: forall (p :: CollectionFormat) (m :: * -> *) a.
Monad m =>
QueryList p (m a) -> m (QueryList p a)
mapM :: (a -> m b) -> QueryList p a -> m (QueryList p b)
$cmapM :: forall (p :: CollectionFormat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryList p a -> m (QueryList p b)
sequenceA :: QueryList p (f a) -> f (QueryList p a)
$csequenceA :: forall (p :: CollectionFormat) (f :: * -> *) a.
Applicative f =>
QueryList p (f a) -> f (QueryList p a)
traverse :: (a -> f b) -> QueryList p a -> f (QueryList p b)
$ctraverse :: forall (p :: CollectionFormat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryList p a -> f (QueryList p b)
$cp2Traversable :: forall (p :: CollectionFormat). Foldable (QueryList p)
$cp1Traversable :: forall (p :: CollectionFormat). Functor (QueryList p)
Traversable)
  deriving newtype (a -> QueryList p b -> QueryList p a
(a -> b) -> QueryList p a -> QueryList p b
(forall a b. (a -> b) -> QueryList p a -> QueryList p b)
-> (forall a b. a -> QueryList p b -> QueryList p a)
-> Functor (QueryList p)
forall a b. a -> QueryList p b -> QueryList p a
forall a b. (a -> b) -> QueryList p a -> QueryList p b
forall (p :: CollectionFormat) a b.
a -> QueryList p b -> QueryList p a
forall (p :: CollectionFormat) a b.
(a -> b) -> QueryList p a -> QueryList p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QueryList p b -> QueryList p a
$c<$ :: forall (p :: CollectionFormat) a b.
a -> QueryList p b -> QueryList p a
fmap :: (a -> b) -> QueryList p a -> QueryList p b
$cfmap :: forall (p :: CollectionFormat) a b.
(a -> b) -> QueryList p a -> QueryList p b
Functor, Functor (QueryList p)
a -> QueryList p a
Functor (QueryList p)
-> (forall a. a -> QueryList p a)
-> (forall a b.
    QueryList p (a -> b) -> QueryList p a -> QueryList p b)
-> (forall a b c.
    (a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c)
-> (forall a b. QueryList p a -> QueryList p b -> QueryList p b)
-> (forall a b. QueryList p a -> QueryList p b -> QueryList p a)
-> Applicative (QueryList p)
QueryList p a -> QueryList p b -> QueryList p b
QueryList p a -> QueryList p b -> QueryList p a
QueryList p (a -> b) -> QueryList p a -> QueryList p b
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
forall a. a -> QueryList p a
forall a b. QueryList p a -> QueryList p b -> QueryList p a
forall a b. QueryList p a -> QueryList p b -> QueryList p b
forall a b. QueryList p (a -> b) -> QueryList p a -> QueryList p b
forall a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
forall (p :: CollectionFormat). Functor (QueryList p)
forall (p :: CollectionFormat) a. a -> QueryList p a
forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p a
forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
forall (p :: CollectionFormat) a b.
QueryList p (a -> b) -> QueryList p a -> QueryList p b
forall (p :: CollectionFormat) a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: QueryList p a -> QueryList p b -> QueryList p a
$c<* :: forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p a
*> :: QueryList p a -> QueryList p b -> QueryList p b
$c*> :: forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
liftA2 :: (a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
$cliftA2 :: forall (p :: CollectionFormat) a b c.
(a -> b -> c) -> QueryList p a -> QueryList p b -> QueryList p c
<*> :: QueryList p (a -> b) -> QueryList p a -> QueryList p b
$c<*> :: forall (p :: CollectionFormat) a b.
QueryList p (a -> b) -> QueryList p a -> QueryList p b
pure :: a -> QueryList p a
$cpure :: forall (p :: CollectionFormat) a. a -> QueryList p a
$cp1Applicative :: forall (p :: CollectionFormat). Functor (QueryList p)
Applicative, Applicative (QueryList p)
a -> QueryList p a
Applicative (QueryList p)
-> (forall a b.
    QueryList p a -> (a -> QueryList p b) -> QueryList p b)
-> (forall a b. QueryList p a -> QueryList p b -> QueryList p b)
-> (forall a. a -> QueryList p a)
-> Monad (QueryList p)
QueryList p a -> (a -> QueryList p b) -> QueryList p b
QueryList p a -> QueryList p b -> QueryList p b
forall a. a -> QueryList p a
forall a b. QueryList p a -> QueryList p b -> QueryList p b
forall a b. QueryList p a -> (a -> QueryList p b) -> QueryList p b
forall (p :: CollectionFormat). Applicative (QueryList p)
forall (p :: CollectionFormat) a. a -> QueryList p a
forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
forall (p :: CollectionFormat) a b.
QueryList p a -> (a -> QueryList p b) -> QueryList p b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> QueryList p a
$creturn :: forall (p :: CollectionFormat) a. a -> QueryList p a
>> :: QueryList p a -> QueryList p b -> QueryList p b
$c>> :: forall (p :: CollectionFormat) a b.
QueryList p a -> QueryList p b -> QueryList p b
>>= :: QueryList p a -> (a -> QueryList p b) -> QueryList p b
$c>>= :: forall (p :: CollectionFormat) a b.
QueryList p a -> (a -> QueryList p b) -> QueryList p b
$cp1Monad :: forall (p :: CollectionFormat). Applicative (QueryList p)
Monad, a -> QueryList p a -> Bool
QueryList p m -> m
QueryList p a -> [a]
QueryList p a -> Bool
QueryList p a -> Int
QueryList p a -> a
QueryList p a -> a
QueryList p a -> a
QueryList p a -> a
(a -> m) -> QueryList p a -> m
(a -> m) -> QueryList p a -> m
(a -> b -> b) -> b -> QueryList p a -> b
(a -> b -> b) -> b -> QueryList p a -> b
(b -> a -> b) -> b -> QueryList p a -> b
(b -> a -> b) -> b -> QueryList p a -> b
(a -> a -> a) -> QueryList p a -> a
(a -> a -> a) -> QueryList p a -> a
(forall m. Monoid m => QueryList p m -> m)
-> (forall m a. Monoid m => (a -> m) -> QueryList p a -> m)
-> (forall m a. Monoid m => (a -> m) -> QueryList p a -> m)
-> (forall a b. (a -> b -> b) -> b -> QueryList p a -> b)
-> (forall a b. (a -> b -> b) -> b -> QueryList p a -> b)
-> (forall b a. (b -> a -> b) -> b -> QueryList p a -> b)
-> (forall b a. (b -> a -> b) -> b -> QueryList p a -> b)
-> (forall a. (a -> a -> a) -> QueryList p a -> a)
-> (forall a. (a -> a -> a) -> QueryList p a -> a)
-> (forall a. QueryList p a -> [a])
-> (forall a. QueryList p a -> Bool)
-> (forall a. QueryList p a -> Int)
-> (forall a. Eq a => a -> QueryList p a -> Bool)
-> (forall a. Ord a => QueryList p a -> a)
-> (forall a. Ord a => QueryList p a -> a)
-> (forall a. Num a => QueryList p a -> a)
-> (forall a. Num a => QueryList p a -> a)
-> Foldable (QueryList p)
forall a. Eq a => a -> QueryList p a -> Bool
forall a. Num a => QueryList p a -> a
forall a. Ord a => QueryList p a -> a
forall m. Monoid m => QueryList p m -> m
forall a. QueryList p a -> Bool
forall a. QueryList p a -> Int
forall a. QueryList p a -> [a]
forall a. (a -> a -> a) -> QueryList p a -> a
forall m a. Monoid m => (a -> m) -> QueryList p a -> m
forall b a. (b -> a -> b) -> b -> QueryList p a -> b
forall a b. (a -> b -> b) -> b -> QueryList p a -> b
forall (p :: CollectionFormat) a.
Eq a =>
a -> QueryList p a -> Bool
forall (p :: CollectionFormat) a. Num a => QueryList p a -> a
forall (p :: CollectionFormat) a. Ord a => QueryList p a -> a
forall (p :: CollectionFormat) m. Monoid m => QueryList p m -> m
forall (p :: CollectionFormat) a. QueryList p a -> Bool
forall (p :: CollectionFormat) a. QueryList p a -> Int
forall (p :: CollectionFormat) a. QueryList p a -> [a]
forall (p :: CollectionFormat) a.
(a -> a -> a) -> QueryList p a -> a
forall (p :: CollectionFormat) m a.
Monoid m =>
(a -> m) -> QueryList p a -> m
forall (p :: CollectionFormat) b a.
(b -> a -> b) -> b -> QueryList p a -> b
forall (p :: CollectionFormat) a b.
(a -> b -> b) -> b -> QueryList p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: QueryList p a -> a
$cproduct :: forall (p :: CollectionFormat) a. Num a => QueryList p a -> a
sum :: QueryList p a -> a
$csum :: forall (p :: CollectionFormat) a. Num a => QueryList p a -> a
minimum :: QueryList p a -> a
$cminimum :: forall (p :: CollectionFormat) a. Ord a => QueryList p a -> a
maximum :: QueryList p a -> a
$cmaximum :: forall (p :: CollectionFormat) a. Ord a => QueryList p a -> a
elem :: a -> QueryList p a -> Bool
$celem :: forall (p :: CollectionFormat) a.
Eq a =>
a -> QueryList p a -> Bool
length :: QueryList p a -> Int
$clength :: forall (p :: CollectionFormat) a. QueryList p a -> Int
null :: QueryList p a -> Bool
$cnull :: forall (p :: CollectionFormat) a. QueryList p a -> Bool
toList :: QueryList p a -> [a]
$ctoList :: forall (p :: CollectionFormat) a. QueryList p a -> [a]
foldl1 :: (a -> a -> a) -> QueryList p a -> a
$cfoldl1 :: forall (p :: CollectionFormat) a.
(a -> a -> a) -> QueryList p a -> a
foldr1 :: (a -> a -> a) -> QueryList p a -> a
$cfoldr1 :: forall (p :: CollectionFormat) a.
(a -> a -> a) -> QueryList p a -> a
foldl' :: (b -> a -> b) -> b -> QueryList p a -> b
$cfoldl' :: forall (p :: CollectionFormat) b a.
(b -> a -> b) -> b -> QueryList p a -> b
foldl :: (b -> a -> b) -> b -> QueryList p a -> b
$cfoldl :: forall (p :: CollectionFormat) b a.
(b -> a -> b) -> b -> QueryList p a -> b
foldr' :: (a -> b -> b) -> b -> QueryList p a -> b
$cfoldr' :: forall (p :: CollectionFormat) a b.
(a -> b -> b) -> b -> QueryList p a -> b
foldr :: (a -> b -> b) -> b -> QueryList p a -> b
$cfoldr :: forall (p :: CollectionFormat) a b.
(a -> b -> b) -> b -> QueryList p a -> b
foldMap' :: (a -> m) -> QueryList p a -> m
$cfoldMap' :: forall (p :: CollectionFormat) m a.
Monoid m =>
(a -> m) -> QueryList p a -> m
foldMap :: (a -> m) -> QueryList p a -> m
$cfoldMap :: forall (p :: CollectionFormat) m a.
Monoid m =>
(a -> m) -> QueryList p a -> m
fold :: QueryList p m -> m
$cfold :: forall (p :: CollectionFormat) m. Monoid m => QueryList p m -> m
Foldable)

-- | Formats in which a list can be encoded into a HTTP path.
data CollectionFormat
  = -- | CSV format for multiple parameters.
    CommaSeparated
  | -- | Also called "SSV"
    SpaceSeparated
  | -- | Also called "TSV"
    TabSeparated
  | -- | `value1|value2|value2`
    PipeSeparated
  | -- | Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params.
    MultiParamArray

instance FromHttpApiData a => FromHttpApiData (QueryList 'CommaSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'CommaSeparated a)
parseQueryParam = Char -> Text -> Either Text (QueryList 'CommaSeparated a)
forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
','

instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'TabSeparated a)
parseQueryParam = Char -> Text -> Either Text (QueryList 'TabSeparated a)
forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
'\t'

instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'SpaceSeparated a)
parseQueryParam = Char -> Text -> Either Text (QueryList 'SpaceSeparated a)
forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
' '

instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where
  parseQueryParam :: Text -> Either Text (QueryList 'PipeSeparated a)
parseQueryParam = Char -> Text -> Either Text (QueryList 'PipeSeparated a)
forall a (p :: CollectionFormat).
FromHttpApiData a =>
Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
'|'

instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where
  parseQueryParam :: Text -> Either Text (QueryList 'MultiParamArray a)
parseQueryParam = [Char] -> Text -> Either Text (QueryList 'MultiParamArray a)
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"unimplemented FromHttpApiData for MultiParamArray collection format"

parseSeparatedQueryList :: FromHttpApiData a => Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList :: Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList Char
char = ([a] -> QueryList p a)
-> Either Text [a] -> Either Text (QueryList p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> QueryList p a
forall (p :: CollectionFormat) a. [a] -> QueryList p a
QueryList (Either Text [a] -> Either Text (QueryList p a))
-> (Text -> Either Text [a]) -> Text -> Either Text (QueryList p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text a) -> [Text] -> Either Text [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam ([Text] -> Either Text [a])
-> (Text -> [Text]) -> Text -> Either Text [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
char)

instance ToHttpApiData a => ToHttpApiData (QueryList 'CommaSeparated a) where
  toQueryParam :: QueryList 'CommaSeparated a -> Text
toQueryParam = Char -> QueryList 'CommaSeparated a -> Text
forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
','

instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where
  toQueryParam :: QueryList 'TabSeparated a -> Text
toQueryParam = Char -> QueryList 'TabSeparated a -> Text
forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
'\t'

instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where
  toQueryParam :: QueryList 'SpaceSeparated a -> Text
toQueryParam = Char -> QueryList 'SpaceSeparated a -> Text
forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
' '

instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where
  toQueryParam :: QueryList 'PipeSeparated a -> Text
toQueryParam = Char -> QueryList 'PipeSeparated a -> Text
forall a (p :: CollectionFormat).
ToHttpApiData a =>
Char -> QueryList p a -> Text
formatSeparatedQueryList Char
'|'

instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
  toQueryParam :: QueryList 'MultiParamArray a -> Text
toQueryParam = [Char] -> QueryList 'MultiParamArray a -> Text
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"unimplemented ToHttpApiData for MultiParamArray collection format"

formatSeparatedQueryList :: ToHttpApiData a => Char -> QueryList p a -> Text
formatSeparatedQueryList :: Char -> QueryList p a -> Text
formatSeparatedQueryList Char
char = Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
char) ([Text] -> Text)
-> (QueryList p a -> [Text]) -> QueryList p a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam ([a] -> [Text])
-> (QueryList p a -> [a]) -> QueryList p a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryList p a -> [a]
forall (p :: CollectionFormat) a. QueryList p a -> [a]
fromQueryList

-- | Servant type-level API, generated from the OpenAPI spec for OryKratos.
type OryKratosAPI traits =
  "version" :> Verb 'GET 200 '[JSON] GetVersion200Response -- 'getVersion' route
    :<|> "health" :> "alive" :> Verb 'GET 200 '[JSON] IsAlive200Response -- 'isAlive' route
    :<|> "health" :> "ready" :> Verb 'GET 200 '[JSON] IsAlive200Response -- 'isReady' route
    :<|> "admin" :> "identities" :> ReqBody '[JSON] AdminCreateIdentityBody :> Verb 'POST 200 '[JSON] (Identity traits) -- 'adminCreateIdentity' route
    :<|> "admin" :> "recovery" :> "link" :> ReqBody '[JSON] AdminCreateSelfServiceRecoveryLinkBody :> Verb 'POST 200 '[JSON] SelfServiceRecoveryLink -- 'adminCreateSelfServiceRecoveryLink' route
    :<|> "admin" :> "identities" :> Capture "id" Text :> Verb 'DELETE 200 '[JSON] NoContent -- 'adminDeleteIdentity' route
    :<|> "admin" :> "identities" :> Capture "id" Text :> "sessions" :> Verb 'DELETE 200 '[JSON] NoContent -- 'adminDeleteIdentitySessions' route
    :<|> "admin" :> "sessions" :> Capture "id" Text :> "extend" :> Verb 'PATCH 200 '[JSON] (Session traits) -- 'adminExtendSession' route
    :<|> "admin" :> "identities" :> Capture "id" Text :> QueryParam "include_credential" (QueryList 'MultiParamArray (Text)) :> Verb 'GET 200 '[JSON] (Identity traits) -- 'adminGetIdentity' route
    :<|> "admin" :> "identities" :> QueryParam "per_page" Integer :> QueryParam "page" Integer :> Verb 'GET 200 '[JSON] [(Identity traits)] -- 'adminListIdentities' route
    :<|> "admin" :> "identities" :> Capture "id" Text :> "sessions" :> QueryParam "per_page" Integer :> QueryParam "page" Integer :> QueryParam "active" Bool :> Verb 'GET 200 '[JSON] [(Session traits)] -- 'adminListIdentitySessions' route
    :<|> "admin" :> "identities" :> Capture "id" Text :> ReqBody '[JSON] AdminUpdateIdentityBody :> Verb 'PUT 200 '[JSON] (Identity traits) -- 'adminUpdateIdentity' route
    :<|> "self-service" :> "logout" :> "browser" :> Header "cookie" Text :> Verb 'GET 200 '[JSON] SelfServiceLogoutUrl -- 'createSelfServiceLogoutFlowUrlForBrowsers' route
    :<|> "schemas" :> Capture "id" Text :> Verb 'GET 200 '[JSON] Value -- 'getJsonSchema' route
    :<|> "self-service" :> "errors" :> QueryParam "id" Text :> Verb 'GET 200 '[JSON] SelfServiceError -- 'getSelfServiceError' route
    :<|> "self-service" :> "login" :> "flows" :> QueryParam "id" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] SelfServiceLoginFlow -- 'getSelfServiceLoginFlow' route
    :<|> "self-service" :> "recovery" :> "flows" :> QueryParam "id" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] SelfServiceRecoveryFlow -- 'getSelfServiceRecoveryFlow' route
    :<|> "self-service" :> "registration" :> "flows" :> QueryParam "id" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] SelfServiceRegistrationFlow -- 'getSelfServiceRegistrationFlow' route
    :<|> "self-service" :> "settings" :> "flows" :> QueryParam "id" Text :> Header "X-Session-Token" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] (SelfServiceSettingsFlow traits) -- 'getSelfServiceSettingsFlow' route
    :<|> "self-service" :> "verification" :> "flows" :> QueryParam "id" Text :> Header "cookie" Text :> Verb 'GET 200 '[JSON] SelfServiceVerificationFlow -- 'getSelfServiceVerificationFlow' route
    :<|> ".well-known" :> "ory" :> "webauthn.js" :> Verb 'GET 200 '[JSON] Text -- 'getWebAuthnJavaScript' route
    :<|> "self-service" :> "login" :> "browser" :> QueryParam "refresh" Bool :> QueryParam "aal" Text :> QueryParam "return_to" Text :> Verb 'GET 200 '[JSON] SelfServiceLoginFlow -- 'initializeSelfServiceLoginFlowForBrowsers' route
    :<|> "self-service" :> "login" :> "api" :> QueryParam "refresh" Bool :> QueryParam "aal" Text :> Header "X-Session-Token" Text :> Verb 'GET 200 '[JSON] SelfServiceLoginFlow -- 'initializeSelfServiceLoginFlowWithoutBrowser' route
    :<|> "self-service" :> "recovery" :> "browser" :> QueryParam "return_to" Text :> Verb 'GET 200 '[JSON] SelfServiceRecoveryFlow -- 'initializeSelfServiceRecoveryFlowForBrowsers' route
    :<|> "self-service" :> "recovery" :> "api" :> Verb 'GET 200 '[JSON] SelfServiceRecoveryFlow -- 'initializeSelfServiceRecoveryFlowWithoutBrowser' route
    :<|> "self-service" :> "registration" :> "browser" :> QueryParam "return_to" Text :> Verb 'GET 200 '[JSON] SelfServiceRegistrationFlow -- 'initializeSelfServiceRegistrationFlowForBrowsers' route
    :<|> "self-service" :> "registration" :> "api" :> Verb 'GET 200 '[JSON] SelfServiceRegistrationFlow -- 'initializeSelfServiceRegistrationFlowWithoutBrowser' route
    :<|> "self-service" :> "settings" :> "browser" :> QueryParam "return_to" Text :> Verb 'GET 200 '[JSON] (SelfServiceSettingsFlow traits) -- 'initializeSelfServiceSettingsFlowForBrowsers' route
    :<|> "self-service" :> "settings" :> "api" :> Header "X-Session-Token" Text :> Verb 'GET 200 '[JSON] (SelfServiceSettingsFlow traits) -- 'initializeSelfServiceSettingsFlowWithoutBrowser' route
    :<|> "self-service" :> "verification" :> "browser" :> QueryParam "return_to" Text :> Verb 'GET 200 '[JSON] SelfServiceVerificationFlow -- 'initializeSelfServiceVerificationFlowForBrowsers' route
    :<|> "self-service" :> "verification" :> "api" :> Verb 'GET 200 '[JSON] SelfServiceVerificationFlow -- 'initializeSelfServiceVerificationFlowWithoutBrowser' route
    :<|> "schemas" :> QueryParam "per_page" Integer :> QueryParam "page" Integer :> Verb 'GET 200 '[JSON] [IdentitySchema] -- 'listIdentitySchemas' route
    :<|> "sessions" :> QueryParam "per_page" Integer :> QueryParam "page" Integer :> Header "X-Session-Token" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] [(Session traits)] -- 'listSessions' route
    :<|> "sessions" :> Capture "id" Text :> Verb 'DELETE 200 '[JSON] NoContent -- 'revokeSession' route
    :<|> "sessions" :> Header "X-Session-Token" Text :> Header "Cookie" Text :> Verb 'DELETE 200 '[JSON] RevokedSessions -- 'revokeSessions' route
    :<|> "self-service" :> "login" :> QueryParam "flow" Text :> ReqBody '[JSON] SubmitSelfServiceLoginFlowBody :> Header "X-Session-Token" Text :> Header "Cookie" Text :> Verb 'POST 200 '[JSON] (SuccessfulSelfServiceLoginWithoutBrowser traits) -- 'submitSelfServiceLoginFlow' route
    :<|> "self-service" :> "logout" :> QueryParam "token" Text :> QueryParam "return_to" Text :> Verb 'GET 200 '[JSON] NoContent -- 'submitSelfServiceLogoutFlow' route
    :<|> "self-service" :> "logout" :> "api" :> ReqBody '[JSON] SubmitSelfServiceLogoutFlowWithoutBrowserBody :> Verb 'DELETE 200 '[JSON] NoContent -- 'submitSelfServiceLogoutFlowWithoutBrowser' route
    :<|> "self-service" :> "recovery" :> QueryParam "flow" Text :> QueryParam "token" Text :> ReqBody '[JSON] SubmitSelfServiceRecoveryFlowBody :> Header "Cookie" Text :> Verb 'POST 200 '[JSON] SelfServiceRecoveryFlow -- 'submitSelfServiceRecoveryFlow' route
    :<|> "self-service" :> "registration" :> QueryParam "flow" Text :> ReqBody '[JSON] SubmitSelfServiceRegistrationFlowBody :> Header "Cookie" Text :> Verb 'POST 200 '[JSON] (SuccessfulSelfServiceRegistrationWithoutBrowser traits) -- 'submitSelfServiceRegistrationFlow' route
    :<|> "self-service" :> "settings" :> QueryParam "flow" Text :> ReqBody '[JSON] SubmitSelfServiceSettingsFlowBody :> Header "X-Session-Token" Text :> Header "Cookie" Text :> Verb 'POST 200 '[JSON] (SelfServiceSettingsFlow traits) -- 'submitSelfServiceSettingsFlow' route
    :<|> "self-service" :> "verification" :> QueryParam "flow" Text :> QueryParam "token" Text :> ReqBody '[JSON] SubmitSelfServiceVerificationFlowBody :> Header "Cookie" Text :> Verb 'POST 200 '[JSON] SelfServiceVerificationFlow -- 'submitSelfServiceVerificationFlow' route
    :<|> "sessions" :> "whoami" :> Header "X-Session-Token" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] (Session traits) -- 'toSession' route
    :<|> Raw

-- | Server or client configuration, specifying the host and port to query or serve on.
data Config = Config
  { -- | scheme://hostname:port/path, e.g. "http://localhost:8080/"
    Config -> [Char]
configUrl :: String
  }
  deriving stock (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Eq Config
Eq Config
-> (Config -> Config -> Ordering)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Config)
-> (Config -> Config -> Config)
-> Ord Config
Config -> Config -> Bool
Config -> Config -> Ordering
Config -> Config -> Config
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Config -> Config -> Config
$cmin :: Config -> Config -> Config
max :: Config -> Config -> Config
$cmax :: Config -> Config -> Config
>= :: Config -> Config -> Bool
$c>= :: Config -> Config -> Bool
> :: Config -> Config -> Bool
$c> :: Config -> Config -> Bool
<= :: Config -> Config -> Bool
$c<= :: Config -> Config -> Bool
< :: Config -> Config -> Bool
$c< :: Config -> Config -> Bool
compare :: Config -> Config -> Ordering
$ccompare :: Config -> Config -> Ordering
$cp1Ord :: Eq Config
Ord, Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
(Int -> Config -> ShowS)
-> (Config -> [Char]) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read)

-- | Custom exception type for our Prelude.errors.
newtype OryKratosClientError = OryKratosClientError ClientError
  deriving newtype (Int -> OryKratosClientError -> ShowS
[OryKratosClientError] -> ShowS
OryKratosClientError -> [Char]
(Int -> OryKratosClientError -> ShowS)
-> (OryKratosClientError -> [Char])
-> ([OryKratosClientError] -> ShowS)
-> Show OryKratosClientError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OryKratosClientError] -> ShowS
$cshowList :: [OryKratosClientError] -> ShowS
show :: OryKratosClientError -> [Char]
$cshow :: OryKratosClientError -> [Char]
showsPrec :: Int -> OryKratosClientError -> ShowS
$cshowsPrec :: Int -> OryKratosClientError -> ShowS
Show, Show OryKratosClientError
Typeable OryKratosClientError
Typeable OryKratosClientError
-> Show OryKratosClientError
-> (OryKratosClientError -> SomeException)
-> (SomeException -> Maybe OryKratosClientError)
-> (OryKratosClientError -> [Char])
-> Exception OryKratosClientError
SomeException -> Maybe OryKratosClientError
OryKratosClientError -> [Char]
OryKratosClientError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> Exception e
displayException :: OryKratosClientError -> [Char]
$cdisplayException :: OryKratosClientError -> [Char]
fromException :: SomeException -> Maybe OryKratosClientError
$cfromException :: SomeException -> Maybe OryKratosClientError
toException :: OryKratosClientError -> SomeException
$ctoException :: OryKratosClientError -> SomeException
$cp2Exception :: Show OryKratosClientError
$cp1Exception :: Typeable OryKratosClientError
Exception)

-- | Configuration, specifying the full url of the service.

-- | Backend for OryKratos.
-- The backend can be used both for the client and the server. The client generated from the OryKratos OpenAPI spec
-- is a backend that executes actions by sending HTTP requests (see @createOryKratosClient@). Alternatively, provided
-- a backend, the API can be served using @runOryKratosMiddlewareServer@.
data OryKratosBackend m traits = OryKratosBackend
  { -- | This endpoint returns the version of Ory Kratos.  If the service supports TLS Edge Termination, this endpoint does not require the `X-Forwarded-Proto` header to be set.  Be aware that if you are running multiple nodes of this service, the version will never refer to the cluster state, only to a single instance.
    OryKratosBackend m traits -> m GetVersion200Response
getVersion :: m GetVersion200Response,
    -- | This endpoint returns a HTTP 200 status code when Ory Kratos is accepting incoming HTTP requests. This status does currently not include checks whether the database connection is working.  If the service supports TLS Edge Termination, this endpoint does not require the `X-Forwarded-Proto` header to be set.  Be aware that if you are running multiple nodes of this service, the health status will never refer to the cluster state, only to a single instance.
    OryKratosBackend m traits -> m IsAlive200Response
isAlive :: m IsAlive200Response,
    -- | This endpoint returns a HTTP 200 status code when Ory Kratos is up running and the environment dependencies (e.g. the database) are responsive as well.  If the service supports TLS Edge Termination, this endpoint does not require the `X-Forwarded-Proto` header to be set.  Be aware that if you are running multiple nodes of Ory Kratos, the health status will never refer to the cluster state, only to a single instance.
    OryKratosBackend m traits -> m IsAlive200Response
isReady :: m IsAlive200Response,
    -- | This endpoint creates an identity. Learn how identities work in [Ory Kratos' User And Identity Model Documentation](https://www.ory.sh/docs/next/kratos/concepts/identity-user-model).
    OryKratosBackend m traits
-> AdminCreateIdentityBody -> m (Identity traits)
adminCreateIdentity :: AdminCreateIdentityBody -> m (Identity traits),
    -- | This endpoint creates a recovery link which should be given to the user in order for them to recover (or activate) their account.
    OryKratosBackend m traits
-> AdminCreateSelfServiceRecoveryLinkBody
-> m SelfServiceRecoveryLink
adminCreateSelfServiceRecoveryLink :: AdminCreateSelfServiceRecoveryLinkBody -> m SelfServiceRecoveryLink,
    -- | Calling this endpoint irrecoverably and permanently deletes the identity given its ID. This action can not be undone. This endpoint returns 204 when the identity was deleted or when the identity was not found, in which case it is assumed that is has been deleted already.  Learn how identities work in [Ory Kratos' User And Identity Model Documentation](https://www.ory.sh/docs/next/kratos/concepts/identity-user-model).
    OryKratosBackend m traits -> Text -> m NoContent
adminDeleteIdentity :: Text -> m NoContent,
    -- | This endpoint is useful for:  To forcefully logout Identity from all devices and sessions
    OryKratosBackend m traits -> Text -> m NoContent
adminDeleteIdentitySessions :: Text -> m NoContent,
    -- | Retrieve the session ID from the `/sessions/whoami` endpoint / `toSession` SDK method.
    OryKratosBackend m traits -> Text -> m (Session traits)
adminExtendSession :: Text -> m (Session traits),
    -- | Learn how identities work in [Ory Kratos' User And Identity Model Documentation](https://www.ory.sh/docs/next/kratos/concepts/identity-user-model).
    OryKratosBackend m traits
-> Text -> Maybe [Text] -> m (Identity traits)
adminGetIdentity :: Text -> Maybe [Text] -> m (Identity traits),
    -- | Lists all identities. Does not support search at the moment.  Learn how identities work in [Ory Kratos' User And Identity Model Documentation](https://www.ory.sh/docs/next/kratos/concepts/identity-user-model).
    OryKratosBackend m traits
-> Maybe Integer -> Maybe Integer -> m [Identity traits]
adminListIdentities :: Maybe Integer -> Maybe Integer -> m [(Identity traits)],
    -- | This endpoint is useful for:  Listing all sessions that belong to an Identity in an administrative context.
    OryKratosBackend m traits
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> m [Session traits]
adminListIdentitySessions :: Text -> Maybe Integer -> Maybe Integer -> Maybe Bool -> m [(Session traits)],
    -- | This endpoint updates an identity. The full identity payload (except credentials) is expected. This endpoint does not support patching.  Learn how identities work in [Ory Kratos' User And Identity Model Documentation](https://www.ory.sh/docs/next/kratos/concepts/identity-user-model).
    OryKratosBackend m traits
-> Text -> AdminUpdateIdentityBody -> m (Identity traits)
adminUpdateIdentity :: Text -> AdminUpdateIdentityBody -> m (Identity traits),
    -- | This endpoint initializes a browser-based user logout flow and a URL which can be used to log out the user.  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...). For API clients you can call the `/self-service/logout/api` URL directly with the Ory Session Token.  The URL is only valid for the currently signed in user. If no user is signed in, this endpoint returns a 401 Prelude.error.  When calling this endpoint from a backend, please ensure to properly forward the HTTP cookies.
    OryKratosBackend m traits -> Maybe Text -> m SelfServiceLogoutUrl
createSelfServiceLogoutFlowUrlForBrowsers :: Maybe Text -> m SelfServiceLogoutUrl,
    -- | Get a JSON Schema
    OryKratosBackend m traits -> Text -> m Value
getJsonSchema :: Text -> m Value,
    -- | This endpoint returns the Prelude.error associated with a user-facing self service Prelude.errors.  This endpoint supports stub values to help you implement the Prelude.error UI:  `?id=stub:500` - returns a stub 500 (Internal Server Error) Prelude.error.  More information can be found at [Ory Kratos User User Facing Error Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-facing-errors).
    OryKratosBackend m traits -> Maybe Text -> m SelfServiceError
getSelfServiceError :: Maybe Text -> m SelfServiceError,
    -- | This endpoint returns a login flow's context with, for example, Prelude.error details and other information.  Browser flows expect the anti-CSRF cookie to be included in the request's HTTP Cookie Header. For AJAX requests you must ensure that cookies are included in the request or requests will fail.  If you use the browser-flow for server-side apps, the services need to run on a common top-level-domain and you need to forward the incoming HTTP Cookie header to this endpoint:  ```js pseudo-code example router.get('/login', async function (req, res) { const flow = await client.getSelfServiceLoginFlow(req.header('cookie'), req.query['flow'])  res.render('login', flow) }) ```  This request may fail due to several reasons. The `error.id` can be one of:  `session_already_available`: The user is already signed in. `self_service_flow_expired`: The flow is expired and you should request a new one.  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
getSelfServiceLoginFlow :: Maybe Text -> Maybe Text -> m SelfServiceLoginFlow,
    -- | This endpoint returns a recovery flow's context with, for example, Prelude.error details and other information.  Browser flows expect the anti-CSRF cookie to be included in the request's HTTP Cookie Header. For AJAX requests you must ensure that cookies are included in the request or requests will fail.  If you use the browser-flow for server-side apps, the services need to run on a common top-level-domain and you need to forward the incoming HTTP Cookie header to this endpoint:  ```js pseudo-code example router.get('/recovery', async function (req, res) { const flow = await client.getSelfServiceRecoveryFlow(req.header('Cookie'), req.query['flow'])  res.render('recovery', flow) }) ```  More information can be found at [Ory Kratos Account Recovery Documentation](../self-service/flows/account-recovery).
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow
getSelfServiceRecoveryFlow :: Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow,
    -- | This endpoint returns a registration flow's context with, for example, Prelude.error details and other information.  Browser flows expect the anti-CSRF cookie to be included in the request's HTTP Cookie Header. For AJAX requests you must ensure that cookies are included in the request or requests will fail.  If you use the browser-flow for server-side apps, the services need to run on a common top-level-domain and you need to forward the incoming HTTP Cookie header to this endpoint:  ```js pseudo-code example router.get('/registration', async function (req, res) { const flow = await client.getSelfServiceRegistrationFlow(req.header('cookie'), req.query['flow'])  res.render('registration', flow) }) ```  This request may fail due to several reasons. The `error.id` can be one of:  `session_already_available`: The user is already signed in. `self_service_flow_expired`: The flow is expired and you should request a new one.  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow
getSelfServiceRegistrationFlow :: Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow,
    -- | When accessing this endpoint through Ory Kratos' Public API you must ensure that either the Ory Kratos Session Cookie or the Ory Kratos Session Token are set.  Depending on your configuration this endpoint might return a 403 Prelude.error if the session has a lower Authenticator Assurance Level (AAL) than is possible for the identity. This can happen if the identity has password + webauthn credentials (which would result in AAL2) but the session has only AAL1. If this Prelude.error occurs, ask the user to sign in with the second factor or change the configuration.  You can access this endpoint without credentials when using Ory Kratos' Admin API.  If this endpoint is called via an AJAX request, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `session_inactive`: No Ory Session was found - sign in a user first. `security_identity_mismatch`: The flow was interrupted with `session_refresh_required` but apparently some other identity logged in instead.  More information can be found at [Ory Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m traits
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
getSelfServiceSettingsFlow :: Maybe Text -> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits),
    -- | This endpoint returns a verification flow's context with, for example, Prelude.error details and other information.  Browser flows expect the anti-CSRF cookie to be included in the request's HTTP Cookie Header. For AJAX requests you must ensure that cookies are included in the request or requests will fail.  If you use the browser-flow for server-side apps, the services need to run on a common top-level-domain and you need to forward the incoming HTTP Cookie header to this endpoint:  ```js pseudo-code example router.get('/recovery', async function (req, res) { const flow = await client.getSelfServiceVerificationFlow(req.header('cookie'), req.query['flow'])  res.render('verification', flow) })  More information can be found at [Ory Kratos Email and Phone Verification Documentation](https://www.ory.sh/docs/kratos/selfservice/flows/verify-email-account-activation).
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow
getSelfServiceVerificationFlow :: Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow,
    -- | This endpoint provides JavaScript which is needed in order to perform WebAuthn login and registration.  If you are building a JavaScript Browser App (e.g. in ReactJS or AngularJS) you will need to load this file:  ```html <script src=\"https://public-kratos.example.org/.well-known/ory/webauthn.js\" type=\"script\" async /> ```  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits -> m Text
getWebAuthnJavaScript :: m Text,
    -- | This endpoint initializes a browser-based user login flow. This endpoint will set the appropriate cookies and anti-CSRF measures required for browser-based flows.  If this endpoint is opened as a link in the browser, it will be redirected to `selfservice.flows.login.ui_url` with the flow ID set as the query parameter `?flow=`. If a valid user session exists already, the browser will be redirected to `urls.default_redirect_url` unless the query parameter `?refresh=true` was set.  If this endpoint is called via an AJAX request, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_already_available`: The user is already signed in. `session_aal1_required`: Multi-factor auth (e.g. 2fa) was requested but the user has no session yet. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `security_identity_mismatch`: The requested `?return_to` address is not allowed to be used. Adjust this in the configuration!  This endpoint is NOT INTENDED for clients that do not have a browser (Chrome, Firefox, ...) as cookies are needed.  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
initializeSelfServiceLoginFlowForBrowsers :: Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow,
    -- | This endpoint initiates a login flow for API clients that do not use a browser, such as mobile devices, smart TVs, and so on.  If a valid provided session cookie or session token is provided, a 400 Bad Request Prelude.error will be returned unless the URL query parameter `?refresh=true` is set.  To fetch an existing login flow call `/self-service/login/flows?flow=<flow_id>`.  You MUST NOT use this endpoint in client-side (Single Page Apps, ReactJS, AngularJS) nor server-side (Java Server Pages, NodeJS, PHP, Golang, ...) browser applications. Using this endpoint in these applications will make you vulnerable to a variety of CSRF attacks, including CSRF login attacks.  In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_already_available`: The user is already signed in. `session_aal1_required`: Multi-factor auth (e.g. 2fa) was requested but the user has no session yet. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred.  This endpoint MUST ONLY be used in scenarios such as native mobile apps (React Native, Objective C, Swift, Java, ...).  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
initializeSelfServiceLoginFlowWithoutBrowser :: Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow,
    -- | This endpoint initializes a browser-based account recovery flow. Once initialized, the browser will be redirected to `selfservice.flows.recovery.ui_url` with the flow ID set as the query parameter `?flow=`. If a valid user session exists, the browser is returned to the configured return URL.  If this endpoint is called via an AJAX request, the response contains the recovery flow without any redirects or a 400 bad request Prelude.error if the user is already authenticated.  This endpoint is NOT INTENDED for clients that do not have a browser (Chrome, Firefox, ...) as cookies are needed.  More information can be found at [Ory Kratos Account Recovery Documentation](../self-service/flows/account-recovery).
    OryKratosBackend m traits
-> Maybe Text -> m SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowForBrowsers :: Maybe Text -> m SelfServiceRecoveryFlow,
    -- | This endpoint initiates a recovery flow for API clients such as mobile devices, smart TVs, and so on.  If a valid provided session cookie or session token is provided, a 400 Bad Request Prelude.error.  To fetch an existing recovery flow call `/self-service/recovery/flows?flow=<flow_id>`.  You MUST NOT use this endpoint in client-side (Single Page Apps, ReactJS, AngularJS) nor server-side (Java Server Pages, NodeJS, PHP, Golang, ...) browser applications. Using this endpoint in these applications will make you vulnerable to a variety of CSRF attacks.  This endpoint MUST ONLY be used in scenarios such as native mobile apps (React Native, Objective C, Swift, Java, ...).   More information can be found at [Ory Kratos Account Recovery Documentation](../self-service/flows/account-recovery).
    OryKratosBackend m traits -> m SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowWithoutBrowser :: m SelfServiceRecoveryFlow,
    -- | This endpoint initializes a browser-based user registration flow. This endpoint will set the appropriate cookies and anti-CSRF measures required for browser-based flows.  :::info  This endpoint is EXPERIMENTAL and subject to potential breaking changes in the future.  :::  If this endpoint is opened as a link in the browser, it will be redirected to `selfservice.flows.registration.ui_url` with the flow ID set as the query parameter `?flow=`. If a valid user session exists already, the browser will be redirected to `urls.default_redirect_url`.  If this endpoint is called via an AJAX request, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_already_available`: The user is already signed in. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `security_identity_mismatch`: The requested `?return_to` address is not allowed to be used. Adjust this in the configuration!  If this endpoint is called via an AJAX request, the response contains the registration flow without a redirect.  This endpoint is NOT INTENDED for clients that do not have a browser (Chrome, Firefox, ...) as cookies are needed.  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Text -> m SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowForBrowsers :: Maybe Text -> m SelfServiceRegistrationFlow,
    -- | This endpoint initiates a registration flow for API clients such as mobile devices, smart TVs, and so on.  If a valid provided session cookie or session token is provided, a 400 Bad Request Prelude.error will be returned unless the URL query parameter `?refresh=true` is set.  To fetch an existing registration flow call `/self-service/registration/flows?flow=<flow_id>`.  You MUST NOT use this endpoint in client-side (Single Page Apps, ReactJS, AngularJS) nor server-side (Java Server Pages, NodeJS, PHP, Golang, ...) browser applications. Using this endpoint in these applications will make you vulnerable to a variety of CSRF attacks.  In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_already_available`: The user is already signed in. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred.  This endpoint MUST ONLY be used in scenarios such as native mobile apps (React Native, Objective C, Swift, Java, ...).  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits -> m SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowWithoutBrowser :: m SelfServiceRegistrationFlow,
    -- | This endpoint initializes a browser-based user settings flow. Once initialized, the browser will be redirected to `selfservice.flows.settings.ui_url` with the flow ID set as the query parameter `?flow=`. If no valid Ory Kratos Session Cookie is included in the request, a login flow will be initialized.  If this endpoint is opened as a link in the browser, it will be redirected to `selfservice.flows.settings.ui_url` with the flow ID set as the query parameter `?flow=`. If no valid user session was set, the browser will be redirected to the login endpoint.  If this endpoint is called via an AJAX request, the response contains the settings flow without any redirects or a 401 forbidden Prelude.error if no valid session was set.  Depending on your configuration this endpoint might return a 403 Prelude.error if the session has a lower Authenticator Assurance Level (AAL) than is possible for the identity. This can happen if the identity has password + webauthn credentials (which would result in AAL2) but the session has only AAL1. If this Prelude.error occurs, ask the user to sign in with the second factor (happens automatically for server-side browser flows) or change the configuration.  If this endpoint is called via an AJAX request, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `session_inactive`: No Ory Session was found - sign in a user first. `security_identity_mismatch`: The requested `?return_to` address is not allowed to be used. Adjust this in the configuration!  This endpoint is NOT INTENDED for clients that do not have a browser (Chrome, Firefox, ...) as cookies are needed.  More information can be found at [Ory Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m traits
-> Maybe Text -> m (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowForBrowsers :: Maybe Text -> m (SelfServiceSettingsFlow traits),
    -- | This endpoint initiates a settings flow for API clients such as mobile devices, smart TVs, and so on. You must provide a valid Ory Kratos Session Token for this endpoint to respond with HTTP 200 OK.  To fetch an existing settings flow call `/self-service/settings/flows?flow=<flow_id>`.  You MUST NOT use this endpoint in client-side (Single Page Apps, ReactJS, AngularJS) nor server-side (Java Server Pages, NodeJS, PHP, Golang, ...) browser applications. Using this endpoint in these applications will make you vulnerable to a variety of CSRF attacks.  Depending on your configuration this endpoint might return a 403 Prelude.error if the session has a lower Authenticator Assurance Level (AAL) than is possible for the identity. This can happen if the identity has password + webauthn credentials (which would result in AAL2) but the session has only AAL1. If this Prelude.error occurs, ask the user to sign in with the second factor or change the configuration.  In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `session_inactive`: No Ory Session was found - sign in a user first.  This endpoint MUST ONLY be used in scenarios such as native mobile apps (React Native, Objective C, Swift, Java, ...).  More information can be found at [Ory Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m traits
-> Maybe Text -> m (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowWithoutBrowser :: Maybe Text -> m (SelfServiceSettingsFlow traits),
    -- | This endpoint initializes a browser-based account verification flow. Once initialized, the browser will be redirected to `selfservice.flows.verification.ui_url` with the flow ID set as the query parameter `?flow=`.  If this endpoint is called via an AJAX request, the response contains the recovery flow without any redirects.  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...).  More information can be found at [Ory Kratos Email and Phone Verification Documentation](https://www.ory.sh/docs/kratos/selfservice/flows/verify-email-account-activation).
    OryKratosBackend m traits
-> Maybe Text -> m SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowForBrowsers :: Maybe Text -> m SelfServiceVerificationFlow,
    -- | This endpoint initiates a verification flow for API clients such as mobile devices, smart TVs, and so on.  To fetch an existing verification flow call `/self-service/verification/flows?flow=<flow_id>`.  You MUST NOT use this endpoint in client-side (Single Page Apps, ReactJS, AngularJS) nor server-side (Java Server Pages, NodeJS, PHP, Golang, ...) browser applications. Using this endpoint in these applications will make you vulnerable to a variety of CSRF attacks.  This endpoint MUST ONLY be used in scenarios such as native mobile apps (React Native, Objective C, Swift, Java, ...).  More information can be found at [Ory Kratos Email and Phone Verification Documentation](https://www.ory.sh/docs/kratos/selfservice/flows/verify-email-account-activation).
    OryKratosBackend m traits -> m SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowWithoutBrowser :: m SelfServiceVerificationFlow,
    -- | Get all Identity Schemas
    OryKratosBackend m traits
-> Maybe Integer -> Maybe Integer -> m [IdentitySchema]
listIdentitySchemas :: Maybe Integer -> Maybe Integer -> m [IdentitySchema],
    -- | This endpoint is useful for:  Displaying all other sessions that belong to the logged-in user
    OryKratosBackend m traits
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> m [Session traits]
listSessions :: Maybe Integer -> Maybe Integer -> Maybe Text -> Maybe Text -> m [(Session traits)],
    -- | This endpoint is useful for:  To forcefully logout the current user from another device or session
    OryKratosBackend m traits -> Text -> m NoContent
revokeSession :: Text -> m NoContent,
    -- | This endpoint is useful for:  To forcefully logout the current user from all other devices and sessions
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m RevokedSessions
revokeSessions :: Maybe Text -> Maybe Text -> m RevokedSessions,
    -- | :::info  This endpoint is EXPERIMENTAL and subject to potential breaking changes in the future.  :::  Use this endpoint to complete a login flow. This endpoint behaves differently for API and browser flows.  API flows expect `application/json` to be sent in the body and responds with HTTP 200 and a application/json body with the session token on success; HTTP 410 if the original flow expired with the appropriate Prelude.error messages set and optionally a `use_flow_id` parameter in the body; HTTP 400 on form validation Prelude.errors.  Browser flows expect a Content-Type of `application/x-www-form-urlencoded` or `application/json` to be sent in the body and respond with a HTTP 303 redirect to the post/after login URL or the `return_to` value if it was set and if the login succeeded; a HTTP 303 redirect to the login UI URL with the flow ID containing the validation Prelude.errors otherwise.  Browser flows with an accept header of `application/json` will not redirect but instead respond with HTTP 200 and a application/json body with the signed in identity and a `Set-Cookie` header on success; HTTP 303 redirect to a fresh login flow if the original flow expired with the appropriate Prelude.error messages set; HTTP 400 on form validation Prelude.errors.  If this endpoint is called with `Accept: application/json` in the header, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_already_available`: The user is already signed in. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `security_identity_mismatch`: The requested `?return_to` address is not allowed to be used. Adjust this in the configuration! `browser_location_change_required`: Usually sent when an AJAX request indicates that the browser needs to open a specific URL. Most likely used in Social Sign In flows.  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> m (SuccessfulSelfServiceLoginWithoutBrowser traits)
submitSelfServiceLoginFlow :: Maybe Text -> SubmitSelfServiceLoginFlowBody -> Maybe Text -> Maybe Text -> m (SuccessfulSelfServiceLoginWithoutBrowser traits),
    -- | This endpoint logs out an identity in a self-service manner.  If the `Accept` HTTP header is not set to `application/json`, the browser will be redirected (HTTP 303 See Other) to the `return_to` parameter of the initial request or fall back to `urls.default_return_to`.  If the `Accept` HTTP header is set to `application/json`, a 204 No Content response will be sent on successful logout instead.  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...). For API clients you can call the `/self-service/logout/api` URL directly with the Ory Session Token.  More information can be found at [Ory Kratos User Logout Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-logout).
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m NoContent
submitSelfServiceLogoutFlow :: Maybe Text -> Maybe Text -> m NoContent,
    -- | Use this endpoint to log out an identity using an Ory Session Token. If the Ory Session Token was successfully revoked, the server returns a 204 No Content response. A 204 No Content response is also sent when the Ory Session Token has been revoked already before.  If the Ory Session Token is malformed or does not exist a 403 Forbidden response will be returned.  This endpoint does not remove any HTTP Cookies - use the Browser-Based Self-Service Logout Flow instead.
    OryKratosBackend m traits
-> SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent
submitSelfServiceLogoutFlowWithoutBrowser :: SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent,
    -- | Use this endpoint to complete a recovery flow. This endpoint behaves differently for API and browser flows and has several states:  `choose_method` expects `flow` (in the URL query) and `email` (in the body) to be sent and works with API- and Browser-initiated flows. For API clients and Browser clients with HTTP Header `Accept: application/json` it either returns a HTTP 200 OK when the form is valid and HTTP 400 OK when the form is invalid. and a HTTP 303 See Other redirect with a fresh recovery flow if the flow was otherwise invalid (e.g. expired). For Browser clients without HTTP Header `Accept` or with `Accept: text/*` it returns a HTTP 303 See Other redirect to the Recovery UI URL with the Recovery Flow ID appended. `sent_email` is the success state after `choose_method` for the `link` method and allows the user to request another recovery email. It works for both API and Browser-initiated flows and returns the same responses as the flow in `choose_method` state. `passed_challenge` expects a `token` to be sent in the URL query and given the nature of the flow (\"sending a recovery link\") does not have any API capabilities. The server responds with a HTTP 303 See Other redirect either to the Settings UI URL (if the link was valid) and instructs the user to update their password, or a redirect to the Recover UI URL with a new Recovery Flow ID which contains an Prelude.error message that the recovery link was invalid.  More information can be found at [Ory Kratos Account Recovery Documentation](../self-service/flows/account-recovery).
    OryKratosBackend m traits
-> Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> m SelfServiceRecoveryFlow
submitSelfServiceRecoveryFlow :: Maybe Text -> Maybe Text -> SubmitSelfServiceRecoveryFlowBody -> Maybe Text -> m SelfServiceRecoveryFlow,
    -- | Use this endpoint to complete a registration flow by sending an identity's traits and password. This endpoint behaves differently for API and browser flows.  API flows expect `application/json` to be sent in the body and respond with HTTP 200 and a application/json body with the created identity success - if the session hook is configured the `session` and `session_token` will also be included; HTTP 410 if the original flow expired with the appropriate Prelude.error messages set and optionally a `use_flow_id` parameter in the body; HTTP 400 on form validation Prelude.errors.  Browser flows expect a Content-Type of `application/x-www-form-urlencoded` or `application/json` to be sent in the body and respond with a HTTP 303 redirect to the post/after registration URL or the `return_to` value if it was set and if the registration succeeded; a HTTP 303 redirect to the registration UI URL with the flow ID containing the validation Prelude.errors otherwise.  Browser flows with an accept header of `application/json` will not redirect but instead respond with HTTP 200 and a application/json body with the signed in identity and a `Set-Cookie` header on success; HTTP 303 redirect to a fresh login flow if the original flow expired with the appropriate Prelude.error messages set; HTTP 400 on form validation Prelude.errors.  If this endpoint is called with `Accept: application/json` in the header, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_already_available`: The user is already signed in. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `security_identity_mismatch`: The requested `?return_to` address is not allowed to be used. Adjust this in the configuration! `browser_location_change_required`: Usually sent when an AJAX request indicates that the browser needs to open a specific URL. Most likely used in Social Sign In flows.  More information can be found at [Ory Kratos User Login](https://www.ory.sh/docs/kratos/self-service/flows/user-login) and [User Registration Documentation](https://www.ory.sh/docs/kratos/self-service/flows/user-registration).
    OryKratosBackend m traits
-> Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
submitSelfServiceRegistrationFlow :: Maybe Text -> SubmitSelfServiceRegistrationFlowBody -> Maybe Text -> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits),
    -- | Use this endpoint to complete a settings flow by sending an identity's updated password. This endpoint behaves differently for API and browser flows.  API-initiated flows expect `application/json` to be sent in the body and respond with HTTP 200 and an application/json body with the session token on success; HTTP 303 redirect to a fresh settings flow if the original flow expired with the appropriate Prelude.error messages set; HTTP 400 on form validation Prelude.errors. HTTP 401 when the endpoint is called without a valid session token. HTTP 403 when `selfservice.flows.settings.privileged_session_max_age` was reached or the session's AAL is too low. Implies that the user needs to re-authenticate.  Browser flows without HTTP Header `Accept` or with `Accept: text/*` respond with a HTTP 303 redirect to the post/after settings URL or the `return_to` value if it was set and if the flow succeeded; a HTTP 303 redirect to the Settings UI URL with the flow ID containing the validation Prelude.errors otherwise. a HTTP 303 redirect to the login endpoint when `selfservice.flows.settings.privileged_session_max_age` was reached or the session's AAL is too low.  Browser flows with HTTP Header `Accept: application/json` respond with HTTP 200 and a application/json body with the signed in identity and a `Set-Cookie` header on success; HTTP 303 redirect to a fresh login flow if the original flow expired with the appropriate Prelude.error messages set; HTTP 401 when the endpoint is called without a valid session cookie. HTTP 403 when the page is accessed without a session cookie or the session's AAL is too low. HTTP 400 on form validation Prelude.errors.  Depending on your configuration this endpoint might return a 403 Prelude.error if the session has a lower Authenticator Assurance Level (AAL) than is possible for the identity. This can happen if the identity has password + webauthn credentials (which would result in AAL2) but the session has only AAL1. If this Prelude.error occurs, ask the user to sign in with the second factor (happens automatically for server-side browser flows) or change the configuration.  If this endpoint is called with a `Accept: application/json` HTTP header, the response contains the flow without a redirect. In the case of an Prelude.error, the `error.id` of the JSON response body can be one of:  `session_refresh_required`: The identity requested to change something that needs a privileged session. Redirect the identity to the login init endpoint with query parameters `?refresh=true&return_to=<the-current-browser-url>`, or initiate a refresh login flow otherwise. `security_csrf_violation`: Unable to fetch the flow because a CSRF violation occurred. `session_inactive`: No Ory Session was found - sign in a user first. `security_identity_mismatch`: The flow was interrupted with `session_refresh_required` but apparently some other identity logged in instead. `security_identity_mismatch`: The requested `?return_to` address is not allowed to be used. Adjust this in the configuration! `browser_location_change_required`: Usually sent when an AJAX request indicates that the browser needs to open a specific URL. Most likely used in Social Sign In flows.  More information can be found at [Ory Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m traits
-> Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
submitSelfServiceSettingsFlow :: Maybe Text -> SubmitSelfServiceSettingsFlowBody -> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits),
    -- | Use this endpoint to complete a verification flow. This endpoint behaves differently for API and browser flows and has several states:  `choose_method` expects `flow` (in the URL query) and `email` (in the body) to be sent and works with API- and Browser-initiated flows. For API clients and Browser clients with HTTP Header `Accept: application/json` it either returns a HTTP 200 OK when the form is valid and HTTP 400 OK when the form is invalid and a HTTP 303 See Other redirect with a fresh verification flow if the flow was otherwise invalid (e.g. expired). For Browser clients without HTTP Header `Accept` or with `Accept: text/*` it returns a HTTP 303 See Other redirect to the Verification UI URL with the Verification Flow ID appended. `sent_email` is the success state after `choose_method` when using the `link` method and allows the user to request another verification email. It works for both API and Browser-initiated flows and returns the same responses as the flow in `choose_method` state. `passed_challenge` expects a `token` to be sent in the URL query and given the nature of the flow (\"sending a verification link\") does not have any API capabilities. The server responds with a HTTP 303 See Other redirect either to the Settings UI URL (if the link was valid) and instructs the user to update their password, or a redirect to the Verification UI URL with a new Verification Flow ID which contains an Prelude.error message that the verification link was invalid.  More information can be found at [Ory Kratos Email and Phone Verification Documentation](https://www.ory.sh/docs/kratos/selfservice/flows/verify-email-account-activation).
    OryKratosBackend m traits
-> Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> m SelfServiceVerificationFlow
submitSelfServiceVerificationFlow :: Maybe Text -> Maybe Text -> SubmitSelfServiceVerificationFlowBody -> Maybe Text -> m SelfServiceVerificationFlow,
    -- | Uses the HTTP Headers in the GET request to determine (e.g. by using checking the cookies) who is authenticated. Returns a session object in the body or 401 if the credentials are invalid or no credentials were sent. Additionally when the request it successful it adds the user ID to the 'X-Kratos-Authenticated-Identity-Id' header in the response.  If you call this endpoint from a server-side application, you must forward the HTTP Cookie Header to this endpoint:  ```js pseudo-code example router.get('/protected-endpoint', async function (req, res) { const session = await client.toSession(undefined, req.header('cookie'))  console.log(session) }) ```  When calling this endpoint from a non-browser application (e.g. mobile app) you must include the session token:  ```js pseudo-code example ... const session = await client.toSession(\"the-session-token\")  console.log(session) ```  Depending on your configuration this endpoint might return a 403 status code if the session has a lower Authenticator Assurance Level (AAL) than is possible for the identity. This can happen if the identity has password + webauthn credentials (which would result in AAL2) but the session has only AAL1. If this Prelude.error occurs, ask the user to sign in with the second factor or change the configuration.  This endpoint is useful for:  AJAX calls. Remember to send credentials and set up CORS correctly! Reverse proxies and API Gateways Server-side calls - use the `X-Session-Token` header!  This endpoint authenticates users by checking  if the `Cookie` HTTP header was set containing an Ory Kratos Session Cookie; if the `Authorization: bearer <ory-session-token>` HTTP header was set with a valid Ory Kratos Session Token; if the `X-Session-Token` HTTP header was set with a valid Ory Kratos Session Token.  If none of these headers are set or the cooke or token are invalid, the endpoint returns a HTTP 401 status code.  As explained above, this request may fail due to several reasons. The `error.id` can be one of:  `session_inactive`: No active session was found in the request (e.g. no Ory Session Cookie / Ory Session Token). `session_aal2_required`: An active session was found but it does not fulfil the Authenticator Assurance Level, implying that the session must (e.g.) authenticate the second factor.
    OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m (Session traits)
toSession :: Maybe Text -> Maybe Text -> m (Session traits)
  }

newtype OryKratosClient a = OryKratosClient
  { OryKratosClient a -> ClientEnv -> ExceptT ClientError IO a
runClient :: ClientEnv -> ExceptT ClientError IO a
  }
  deriving stock (a -> OryKratosClient b -> OryKratosClient a
(a -> b) -> OryKratosClient a -> OryKratosClient b
(forall a b. (a -> b) -> OryKratosClient a -> OryKratosClient b)
-> (forall a b. a -> OryKratosClient b -> OryKratosClient a)
-> Functor OryKratosClient
forall a b. a -> OryKratosClient b -> OryKratosClient a
forall a b. (a -> b) -> OryKratosClient a -> OryKratosClient b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OryKratosClient b -> OryKratosClient a
$c<$ :: forall a b. a -> OryKratosClient b -> OryKratosClient a
fmap :: (a -> b) -> OryKratosClient a -> OryKratosClient b
$cfmap :: forall a b. (a -> b) -> OryKratosClient a -> OryKratosClient b
Functor)

instance Applicative OryKratosClient where
  pure :: a -> OryKratosClient a
pure a
x = (ClientEnv -> ExceptT ClientError IO a) -> OryKratosClient a
forall a.
(ClientEnv -> ExceptT ClientError IO a) -> OryKratosClient a
OryKratosClient (\ClientEnv
_ -> a -> ExceptT ClientError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  (OryKratosClient ClientEnv -> ExceptT ClientError IO (a -> b)
f) <*> :: OryKratosClient (a -> b) -> OryKratosClient a -> OryKratosClient b
<*> (OryKratosClient ClientEnv -> ExceptT ClientError IO a
x) =
    (ClientEnv -> ExceptT ClientError IO b) -> OryKratosClient b
forall a.
(ClientEnv -> ExceptT ClientError IO a) -> OryKratosClient a
OryKratosClient (\ClientEnv
env -> ClientEnv -> ExceptT ClientError IO (a -> b)
f ClientEnv
env ExceptT ClientError IO (a -> b)
-> ExceptT ClientError IO a -> ExceptT ClientError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientEnv -> ExceptT ClientError IO a
x ClientEnv
env)

instance Monad OryKratosClient where
  (OryKratosClient ClientEnv -> ExceptT ClientError IO a
a) >>= :: OryKratosClient a -> (a -> OryKratosClient b) -> OryKratosClient b
>>= a -> OryKratosClient b
f =
    (ClientEnv -> ExceptT ClientError IO b) -> OryKratosClient b
forall a.
(ClientEnv -> ExceptT ClientError IO a) -> OryKratosClient a
OryKratosClient
      ( \ClientEnv
env -> do
          a
value <- ClientEnv -> ExceptT ClientError IO a
a ClientEnv
env
          OryKratosClient b -> ClientEnv -> ExceptT ClientError IO b
forall a.
OryKratosClient a -> ClientEnv -> ExceptT ClientError IO a
runClient (a -> OryKratosClient b
f a
value) ClientEnv
env
      )

instance MonadIO OryKratosClient where
  liftIO :: IO a -> OryKratosClient a
liftIO IO a
io = (ClientEnv -> ExceptT ClientError IO a) -> OryKratosClient a
forall a.
(ClientEnv -> ExceptT ClientError IO a) -> OryKratosClient a
OryKratosClient (\ClientEnv
_ -> IO a -> ExceptT ClientError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io)

createOryKratosClient :: forall traits. (FromJSON traits) => OryKratosBackend OryKratosClient traits
createOryKratosClient :: OryKratosBackend OryKratosClient traits
createOryKratosClient = OryKratosBackend :: forall (m :: * -> *) traits.
m GetVersion200Response
-> m IsAlive200Response
-> m IsAlive200Response
-> (AdminCreateIdentityBody -> m (Identity traits))
-> (AdminCreateSelfServiceRecoveryLinkBody
    -> m SelfServiceRecoveryLink)
-> (Text -> m NoContent)
-> (Text -> m NoContent)
-> (Text -> m (Session traits))
-> (Text -> Maybe [Text] -> m (Identity traits))
-> (Maybe Integer -> Maybe Integer -> m [Identity traits])
-> (Text
    -> Maybe Integer
    -> Maybe Integer
    -> Maybe Bool
    -> m [Session traits])
-> (Text -> AdminUpdateIdentityBody -> m (Identity traits))
-> (Maybe Text -> m SelfServiceLogoutUrl)
-> (Text -> m Value)
-> (Maybe Text -> m SelfServiceError)
-> (Maybe Text -> Maybe Text -> m SelfServiceLoginFlow)
-> (Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow)
-> (Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow)
-> (Maybe Text
    -> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits))
-> (Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow)
-> m Text
-> (Maybe Bool
    -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow)
-> (Maybe Bool
    -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow)
-> (Maybe Text -> m SelfServiceRecoveryFlow)
-> m SelfServiceRecoveryFlow
-> (Maybe Text -> m SelfServiceRegistrationFlow)
-> m SelfServiceRegistrationFlow
-> (Maybe Text -> m (SelfServiceSettingsFlow traits))
-> (Maybe Text -> m (SelfServiceSettingsFlow traits))
-> (Maybe Text -> m SelfServiceVerificationFlow)
-> m SelfServiceVerificationFlow
-> (Maybe Integer -> Maybe Integer -> m [IdentitySchema])
-> (Maybe Integer
    -> Maybe Integer -> Maybe Text -> Maybe Text -> m [Session traits])
-> (Text -> m NoContent)
-> (Maybe Text -> Maybe Text -> m RevokedSessions)
-> (Maybe Text
    -> SubmitSelfServiceLoginFlowBody
    -> Maybe Text
    -> Maybe Text
    -> m (SuccessfulSelfServiceLoginWithoutBrowser traits))
-> (Maybe Text -> Maybe Text -> m NoContent)
-> (SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent)
-> (Maybe Text
    -> Maybe Text
    -> SubmitSelfServiceRecoveryFlowBody
    -> Maybe Text
    -> m SelfServiceRecoveryFlow)
-> (Maybe Text
    -> SubmitSelfServiceRegistrationFlowBody
    -> Maybe Text
    -> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits))
-> (Maybe Text
    -> SubmitSelfServiceSettingsFlowBody
    -> Maybe Text
    -> Maybe Text
    -> m (SelfServiceSettingsFlow traits))
-> (Maybe Text
    -> Maybe Text
    -> SubmitSelfServiceVerificationFlowBody
    -> Maybe Text
    -> m SelfServiceVerificationFlow)
-> (Maybe Text -> Maybe Text -> m (Session traits))
-> OryKratosBackend m traits
OryKratosBackend {OryKratosClient Text
OryKratosClient IsAlive200Response
OryKratosClient GetVersion200Response
OryKratosClient SelfServiceVerificationFlow
OryKratosClient SelfServiceRegistrationFlow
OryKratosClient SelfServiceRecoveryFlow
Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
Maybe Integer -> Maybe Integer -> OryKratosClient [IdentitySchema]
Maybe Integer -> Maybe Integer -> OryKratosClient [Identity traits]
Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> OryKratosClient [Session traits]
Maybe Text -> OryKratosClient SelfServiceVerificationFlow
Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
Maybe Text -> OryKratosClient SelfServiceLogoutUrl
Maybe Text -> OryKratosClient SelfServiceError
Maybe Text -> Maybe Text -> OryKratosClient NoContent
Maybe Text -> Maybe Text -> OryKratosClient RevokedSessions
Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceVerificationFlow
Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
Maybe Text -> Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
Maybe Text -> Maybe Text -> OryKratosClient (Session traits)
Maybe Text
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceVerificationFlow
Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceRecoveryFlow
Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceLoginWithoutBrowser traits)
Text -> OryKratosClient Value
Text -> OryKratosClient NoContent
Text -> OryKratosClient (Session traits)
Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> OryKratosClient [Session traits]
Text -> Maybe [Text] -> OryKratosClient (Identity traits)
Text
-> AdminUpdateIdentityBody -> OryKratosClient (Identity traits)
SubmitSelfServiceLogoutFlowWithoutBrowserBody
-> OryKratosClient NoContent
AdminCreateSelfServiceRecoveryLinkBody
-> OryKratosClient SelfServiceRecoveryLink
AdminCreateIdentityBody -> OryKratosClient (Identity traits)
toSession :: Maybe Text -> Maybe Text -> OryKratosClient (Session traits)
submitSelfServiceVerificationFlow :: Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceVerificationFlow
submitSelfServiceSettingsFlow :: Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
submitSelfServiceRegistrationFlow :: Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
submitSelfServiceRecoveryFlow :: Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceRecoveryFlow
submitSelfServiceLogoutFlowWithoutBrowser :: SubmitSelfServiceLogoutFlowWithoutBrowserBody
-> OryKratosClient NoContent
submitSelfServiceLogoutFlow :: Maybe Text -> Maybe Text -> OryKratosClient NoContent
submitSelfServiceLoginFlow :: Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceLoginWithoutBrowser traits)
revokeSessions :: Maybe Text -> Maybe Text -> OryKratosClient RevokedSessions
revokeSession :: Text -> OryKratosClient NoContent
listSessions :: Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> OryKratosClient [Session traits]
listIdentitySchemas :: Maybe Integer -> Maybe Integer -> OryKratosClient [IdentitySchema]
initializeSelfServiceVerificationFlowWithoutBrowser :: OryKratosClient SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowForBrowsers :: Maybe Text -> OryKratosClient SelfServiceVerificationFlow
initializeSelfServiceSettingsFlowWithoutBrowser :: Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowForBrowsers :: Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
initializeSelfServiceRegistrationFlowWithoutBrowser :: OryKratosClient SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowForBrowsers :: Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
initializeSelfServiceRecoveryFlowWithoutBrowser :: OryKratosClient SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowForBrowsers :: Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
initializeSelfServiceLoginFlowWithoutBrowser :: Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
initializeSelfServiceLoginFlowForBrowsers :: Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
getWebAuthnJavaScript :: OryKratosClient Text
getSelfServiceVerificationFlow :: Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceVerificationFlow
getSelfServiceSettingsFlow :: Maybe Text
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
getSelfServiceRegistrationFlow :: Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
getSelfServiceRecoveryFlow :: Maybe Text -> Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
getSelfServiceLoginFlow :: Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
getSelfServiceError :: Maybe Text -> OryKratosClient SelfServiceError
getJsonSchema :: Text -> OryKratosClient Value
createSelfServiceLogoutFlowUrlForBrowsers :: Maybe Text -> OryKratosClient SelfServiceLogoutUrl
adminUpdateIdentity :: Text
-> AdminUpdateIdentityBody -> OryKratosClient (Identity traits)
adminListIdentitySessions :: Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> OryKratosClient [Session traits]
adminListIdentities :: Maybe Integer -> Maybe Integer -> OryKratosClient [Identity traits]
adminGetIdentity :: Text -> Maybe [Text] -> OryKratosClient (Identity traits)
adminExtendSession :: Text -> OryKratosClient (Session traits)
adminDeleteIdentitySessions :: Text -> OryKratosClient NoContent
adminDeleteIdentity :: Text -> OryKratosClient NoContent
adminCreateSelfServiceRecoveryLink :: AdminCreateSelfServiceRecoveryLinkBody
-> OryKratosClient SelfServiceRecoveryLink
adminCreateIdentity :: AdminCreateIdentityBody -> OryKratosClient (Identity traits)
isReady :: OryKratosClient IsAlive200Response
isAlive :: OryKratosClient IsAlive200Response
getVersion :: OryKratosClient GetVersion200Response
$sel:toSession:OryKratosBackend :: Maybe Text -> Maybe Text -> OryKratosClient (Session traits)
$sel:submitSelfServiceVerificationFlow:OryKratosBackend :: Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceVerificationFlow
$sel:submitSelfServiceSettingsFlow:OryKratosBackend :: Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
$sel:submitSelfServiceRegistrationFlow:OryKratosBackend :: Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
$sel:submitSelfServiceRecoveryFlow:OryKratosBackend :: Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceRecoveryFlow
$sel:submitSelfServiceLogoutFlowWithoutBrowser:OryKratosBackend :: SubmitSelfServiceLogoutFlowWithoutBrowserBody
-> OryKratosClient NoContent
$sel:submitSelfServiceLogoutFlow:OryKratosBackend :: Maybe Text -> Maybe Text -> OryKratosClient NoContent
$sel:submitSelfServiceLoginFlow:OryKratosBackend :: Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceLoginWithoutBrowser traits)
$sel:revokeSessions:OryKratosBackend :: Maybe Text -> Maybe Text -> OryKratosClient RevokedSessions
$sel:revokeSession:OryKratosBackend :: Text -> OryKratosClient NoContent
$sel:listSessions:OryKratosBackend :: Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> OryKratosClient [Session traits]
$sel:listIdentitySchemas:OryKratosBackend :: Maybe Integer -> Maybe Integer -> OryKratosClient [IdentitySchema]
$sel:initializeSelfServiceVerificationFlowWithoutBrowser:OryKratosBackend :: OryKratosClient SelfServiceVerificationFlow
$sel:initializeSelfServiceVerificationFlowForBrowsers:OryKratosBackend :: Maybe Text -> OryKratosClient SelfServiceVerificationFlow
$sel:initializeSelfServiceSettingsFlowWithoutBrowser:OryKratosBackend :: Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
$sel:initializeSelfServiceSettingsFlowForBrowsers:OryKratosBackend :: Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
$sel:initializeSelfServiceRegistrationFlowWithoutBrowser:OryKratosBackend :: OryKratosClient SelfServiceRegistrationFlow
$sel:initializeSelfServiceRegistrationFlowForBrowsers:OryKratosBackend :: Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
$sel:initializeSelfServiceRecoveryFlowWithoutBrowser:OryKratosBackend :: OryKratosClient SelfServiceRecoveryFlow
$sel:initializeSelfServiceRecoveryFlowForBrowsers:OryKratosBackend :: Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
$sel:initializeSelfServiceLoginFlowWithoutBrowser:OryKratosBackend :: Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
$sel:initializeSelfServiceLoginFlowForBrowsers:OryKratosBackend :: Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
$sel:getWebAuthnJavaScript:OryKratosBackend :: OryKratosClient Text
$sel:getSelfServiceVerificationFlow:OryKratosBackend :: Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceVerificationFlow
$sel:getSelfServiceSettingsFlow:OryKratosBackend :: Maybe Text
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
$sel:getSelfServiceRegistrationFlow:OryKratosBackend :: Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
$sel:getSelfServiceRecoveryFlow:OryKratosBackend :: Maybe Text -> Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
$sel:getSelfServiceLoginFlow:OryKratosBackend :: Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
$sel:getSelfServiceError:OryKratosBackend :: Maybe Text -> OryKratosClient SelfServiceError
$sel:getJsonSchema:OryKratosBackend :: Text -> OryKratosClient Value
$sel:createSelfServiceLogoutFlowUrlForBrowsers:OryKratosBackend :: Maybe Text -> OryKratosClient SelfServiceLogoutUrl
$sel:adminUpdateIdentity:OryKratosBackend :: Text
-> AdminUpdateIdentityBody -> OryKratosClient (Identity traits)
$sel:adminListIdentitySessions:OryKratosBackend :: Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> OryKratosClient [Session traits]
$sel:adminListIdentities:OryKratosBackend :: Maybe Integer -> Maybe Integer -> OryKratosClient [Identity traits]
$sel:adminGetIdentity:OryKratosBackend :: Text -> Maybe [Text] -> OryKratosClient (Identity traits)
$sel:adminExtendSession:OryKratosBackend :: Text -> OryKratosClient (Session traits)
$sel:adminDeleteIdentitySessions:OryKratosBackend :: Text -> OryKratosClient NoContent
$sel:adminDeleteIdentity:OryKratosBackend :: Text -> OryKratosClient NoContent
$sel:adminCreateSelfServiceRecoveryLink:OryKratosBackend :: AdminCreateSelfServiceRecoveryLinkBody
-> OryKratosClient SelfServiceRecoveryLink
$sel:adminCreateIdentity:OryKratosBackend :: AdminCreateIdentityBody -> OryKratosClient (Identity traits)
$sel:isReady:OryKratosBackend :: OryKratosClient IsAlive200Response
$sel:isAlive:OryKratosBackend :: OryKratosClient IsAlive200Response
$sel:getVersion:OryKratosBackend :: OryKratosClient GetVersion200Response
..}
  where
    ( (ClientM GetVersion200Response
-> OryKratosClient GetVersion200Response
coerce -> OryKratosClient GetVersion200Response
getVersion)
        :<|> (ClientM IsAlive200Response -> OryKratosClient IsAlive200Response
coerce -> OryKratosClient IsAlive200Response
isAlive)
        :<|> (ClientM IsAlive200Response -> OryKratosClient IsAlive200Response
coerce -> OryKratosClient IsAlive200Response
isReady)
        :<|> ((AdminCreateIdentityBody -> ClientM (Identity traits))
-> AdminCreateIdentityBody -> OryKratosClient (Identity traits)
coerce -> AdminCreateIdentityBody -> OryKratosClient (Identity traits)
adminCreateIdentity)
        :<|> ((AdminCreateSelfServiceRecoveryLinkBody
 -> ClientM SelfServiceRecoveryLink)
-> AdminCreateSelfServiceRecoveryLinkBody
-> OryKratosClient SelfServiceRecoveryLink
coerce -> AdminCreateSelfServiceRecoveryLinkBody
-> OryKratosClient SelfServiceRecoveryLink
adminCreateSelfServiceRecoveryLink)
        :<|> ((Text -> ClientM NoContent) -> Text -> OryKratosClient NoContent
coerce -> Text -> OryKratosClient NoContent
adminDeleteIdentity)
        :<|> ((Text -> ClientM NoContent) -> Text -> OryKratosClient NoContent
coerce -> Text -> OryKratosClient NoContent
adminDeleteIdentitySessions)
        :<|> ((Text -> ClientM (Session traits))
-> Text -> OryKratosClient (Session traits)
coerce -> Text -> OryKratosClient (Session traits)
adminExtendSession)
        :<|> ((Text
 -> Maybe (QueryList 'MultiParamArray Text)
 -> ClientM (Identity traits))
-> Text -> Maybe [Text] -> OryKratosClient (Identity traits)
coerce -> Text -> Maybe [Text] -> OryKratosClient (Identity traits)
adminGetIdentity)
        :<|> ((Maybe Integer -> Maybe Integer -> ClientM [Identity traits])
-> Maybe Integer
-> Maybe Integer
-> OryKratosClient [Identity traits]
coerce -> Maybe Integer -> Maybe Integer -> OryKratosClient [Identity traits]
adminListIdentities)
        :<|> ((Text
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Bool
 -> ClientM [Session traits])
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> OryKratosClient [Session traits]
coerce -> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> OryKratosClient [Session traits]
adminListIdentitySessions)
        :<|> ((Text -> AdminUpdateIdentityBody -> ClientM (Identity traits))
-> Text
-> AdminUpdateIdentityBody
-> OryKratosClient (Identity traits)
coerce -> Text
-> AdminUpdateIdentityBody -> OryKratosClient (Identity traits)
adminUpdateIdentity)
        :<|> ((Maybe Text -> ClientM SelfServiceLogoutUrl)
-> Maybe Text -> OryKratosClient SelfServiceLogoutUrl
coerce -> Maybe Text -> OryKratosClient SelfServiceLogoutUrl
createSelfServiceLogoutFlowUrlForBrowsers)
        :<|> ((Text -> ClientM Value) -> Text -> OryKratosClient Value
coerce -> Text -> OryKratosClient Value
getJsonSchema)
        :<|> ((Maybe Text -> ClientM SelfServiceError)
-> Maybe Text -> OryKratosClient SelfServiceError
coerce -> Maybe Text -> OryKratosClient SelfServiceError
getSelfServiceError)
        :<|> ((Maybe Text -> Maybe Text -> ClientM SelfServiceLoginFlow)
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
coerce -> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
getSelfServiceLoginFlow)
        :<|> ((Maybe Text -> Maybe Text -> ClientM SelfServiceRecoveryFlow)
-> Maybe Text
-> Maybe Text
-> OryKratosClient SelfServiceRecoveryFlow
coerce -> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
getSelfServiceRecoveryFlow)
        :<|> ((Maybe Text -> Maybe Text -> ClientM SelfServiceRegistrationFlow)
-> Maybe Text
-> Maybe Text
-> OryKratosClient SelfServiceRegistrationFlow
coerce -> Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
getSelfServiceRegistrationFlow)
        :<|> ((Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ClientM (SelfServiceSettingsFlow traits))
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
coerce -> Maybe Text
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
getSelfServiceSettingsFlow)
        :<|> ((Maybe Text -> Maybe Text -> ClientM SelfServiceVerificationFlow)
-> Maybe Text
-> Maybe Text
-> OryKratosClient SelfServiceVerificationFlow
coerce -> Maybe Text
-> Maybe Text -> OryKratosClient SelfServiceVerificationFlow
getSelfServiceVerificationFlow)
        :<|> (ClientM Text -> OryKratosClient Text
coerce -> OryKratosClient Text
getWebAuthnJavaScript)
        :<|> ((Maybe Bool
 -> Maybe Text -> Maybe Text -> ClientM SelfServiceLoginFlow)
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> OryKratosClient SelfServiceLoginFlow
coerce -> Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
initializeSelfServiceLoginFlowForBrowsers)
        :<|> ((Maybe Bool
 -> Maybe Text -> Maybe Text -> ClientM SelfServiceLoginFlow)
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> OryKratosClient SelfServiceLoginFlow
coerce -> Maybe Bool
-> Maybe Text -> Maybe Text -> OryKratosClient SelfServiceLoginFlow
initializeSelfServiceLoginFlowWithoutBrowser)
        :<|> ((Maybe Text -> ClientM SelfServiceRecoveryFlow)
-> Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
coerce -> Maybe Text -> OryKratosClient SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowForBrowsers)
        :<|> (ClientM SelfServiceRecoveryFlow
-> OryKratosClient SelfServiceRecoveryFlow
coerce -> OryKratosClient SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowWithoutBrowser)
        :<|> ((Maybe Text -> ClientM SelfServiceRegistrationFlow)
-> Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
coerce -> Maybe Text -> OryKratosClient SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowForBrowsers)
        :<|> (ClientM SelfServiceRegistrationFlow
-> OryKratosClient SelfServiceRegistrationFlow
coerce -> OryKratosClient SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowWithoutBrowser)
        :<|> ((Maybe Text -> ClientM (SelfServiceSettingsFlow traits))
-> Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
coerce -> Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowForBrowsers)
        :<|> ((Maybe Text -> ClientM (SelfServiceSettingsFlow traits))
-> Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
coerce -> Maybe Text -> OryKratosClient (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowWithoutBrowser)
        :<|> ((Maybe Text -> ClientM SelfServiceVerificationFlow)
-> Maybe Text -> OryKratosClient SelfServiceVerificationFlow
coerce -> Maybe Text -> OryKratosClient SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowForBrowsers)
        :<|> (ClientM SelfServiceVerificationFlow
-> OryKratosClient SelfServiceVerificationFlow
coerce -> OryKratosClient SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowWithoutBrowser)
        :<|> ((Maybe Integer -> Maybe Integer -> ClientM [IdentitySchema])
-> Maybe Integer
-> Maybe Integer
-> OryKratosClient [IdentitySchema]
coerce -> Maybe Integer -> Maybe Integer -> OryKratosClient [IdentitySchema]
listIdentitySchemas)
        :<|> ((Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> ClientM [Session traits])
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> OryKratosClient [Session traits]
coerce -> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> OryKratosClient [Session traits]
listSessions)
        :<|> ((Text -> ClientM NoContent) -> Text -> OryKratosClient NoContent
coerce -> Text -> OryKratosClient NoContent
revokeSession)
        :<|> ((Maybe Text -> Maybe Text -> ClientM RevokedSessions)
-> Maybe Text -> Maybe Text -> OryKratosClient RevokedSessions
coerce -> Maybe Text -> Maybe Text -> OryKratosClient RevokedSessions
revokeSessions)
        :<|> ((Maybe Text
 -> SubmitSelfServiceLoginFlowBody
 -> Maybe Text
 -> Maybe Text
 -> ClientM (SuccessfulSelfServiceLoginWithoutBrowser traits))
-> Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceLoginWithoutBrowser traits)
coerce -> Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceLoginWithoutBrowser traits)
submitSelfServiceLoginFlow)
        :<|> ((Maybe Text -> Maybe Text -> ClientM NoContent)
-> Maybe Text -> Maybe Text -> OryKratosClient NoContent
coerce -> Maybe Text -> Maybe Text -> OryKratosClient NoContent
submitSelfServiceLogoutFlow)
        :<|> ((SubmitSelfServiceLogoutFlowWithoutBrowserBody
 -> ClientM NoContent)
-> SubmitSelfServiceLogoutFlowWithoutBrowserBody
-> OryKratosClient NoContent
coerce -> SubmitSelfServiceLogoutFlowWithoutBrowserBody
-> OryKratosClient NoContent
submitSelfServiceLogoutFlowWithoutBrowser)
        :<|> ((Maybe Text
 -> Maybe Text
 -> SubmitSelfServiceRecoveryFlowBody
 -> Maybe Text
 -> ClientM SelfServiceRecoveryFlow)
-> Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceRecoveryFlow
coerce -> Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceRecoveryFlow
submitSelfServiceRecoveryFlow)
        :<|> ((Maybe Text
 -> SubmitSelfServiceRegistrationFlowBody
 -> Maybe Text
 -> ClientM
      (SuccessfulSelfServiceRegistrationWithoutBrowser traits))
-> Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
coerce -> Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> OryKratosClient
     (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
submitSelfServiceRegistrationFlow)
        :<|> ((Maybe Text
 -> SubmitSelfServiceSettingsFlowBody
 -> Maybe Text
 -> Maybe Text
 -> ClientM (SelfServiceSettingsFlow traits))
-> Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
coerce -> Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> OryKratosClient (SelfServiceSettingsFlow traits)
submitSelfServiceSettingsFlow)
        :<|> ((Maybe Text
 -> Maybe Text
 -> SubmitSelfServiceVerificationFlowBody
 -> Maybe Text
 -> ClientM SelfServiceVerificationFlow)
-> Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceVerificationFlow
coerce -> Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> OryKratosClient SelfServiceVerificationFlow
submitSelfServiceVerificationFlow)
        :<|> ((Maybe Text -> Maybe Text -> ClientM (Session traits))
-> Maybe Text -> Maybe Text -> OryKratosClient (Session traits)
coerce -> Maybe Text -> Maybe Text -> OryKratosClient (Session traits)
toSession)
        :<|> ByteString -> ClientM Response
_
      ) = Proxy (OryKratosAPI traits) -> Client ClientM (OryKratosAPI traits)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy (OryKratosAPI traits)
forall k (t :: k). Proxy t
Proxy :: Proxy (OryKratosAPI traits))

-- | Run requests in the OryKratosClient monad.
runOryKratosClient :: Config -> OryKratosClient a -> ExceptT ClientError IO a
runOryKratosClient :: Config -> OryKratosClient a -> ExceptT ClientError IO a
runOryKratosClient Config
clientConfig OryKratosClient a
cl = do
  Manager
manager <- IO Manager -> ExceptT ClientError IO Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> ExceptT ClientError IO Manager)
-> IO Manager -> ExceptT ClientError IO Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  Manager -> Config -> OryKratosClient a -> ExceptT ClientError IO a
forall a.
Manager -> Config -> OryKratosClient a -> ExceptT ClientError IO a
runOryKratosClientWithManager Manager
manager Config
clientConfig OryKratosClient a
cl

-- | Run requests in the OryKratosClient monad using a custom manager.
runOryKratosClientWithManager :: Manager -> Config -> OryKratosClient a -> ExceptT ClientError IO a
runOryKratosClientWithManager :: Manager -> Config -> OryKratosClient a -> ExceptT ClientError IO a
runOryKratosClientWithManager Manager
manager Config {[Char]
configUrl :: [Char]
$sel:configUrl:Config :: Config -> [Char]
..} OryKratosClient a
cl = do
  BaseUrl
url <- [Char] -> ExceptT ClientError IO BaseUrl
forall (m :: * -> *). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl [Char]
configUrl
  OryKratosClient a -> ClientEnv -> ExceptT ClientError IO a
forall a.
OryKratosClient a -> ClientEnv -> ExceptT ClientError IO a
runClient OryKratosClient a
cl (ClientEnv -> ExceptT ClientError IO a)
-> ClientEnv -> ExceptT ClientError IO a
forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager BaseUrl
url

-- | Like @runClient@, but returns the response or throws
--   a OryKratosClientError
callOryKratos ::
  (MonadIO m, MonadThrow m) =>
  ClientEnv ->
  OryKratosClient a ->
  m a
callOryKratos :: ClientEnv -> OryKratosClient a -> m a
callOryKratos ClientEnv
env OryKratosClient a
f = do
  Either ClientError a
res <- IO (Either ClientError a) -> m (Either ClientError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError a) -> m (Either ClientError a))
-> IO (Either ClientError a) -> m (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ ExceptT ClientError IO a -> IO (Either ClientError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ClientError IO a -> IO (Either ClientError a))
-> ExceptT ClientError IO a -> IO (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ OryKratosClient a -> ClientEnv -> ExceptT ClientError IO a
forall a.
OryKratosClient a -> ClientEnv -> ExceptT ClientError IO a
runClient OryKratosClient a
f ClientEnv
env
  case Either ClientError a
res of
    Left ClientError
err -> OryKratosClientError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientError -> OryKratosClientError
OryKratosClientError ClientError
err)
    Right a
response -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
response

requestMiddlewareId :: Application -> Application
requestMiddlewareId :: Application -> Application
requestMiddlewareId Application
a = Application
a

-- | Run the OryKratos server at the provided host and port.
runOryKratosServer ::
  (MonadIO m, MonadThrow m, ToJSON traits) =>
  Config ->
  OryKratosBackend (ExceptT ServerError IO) traits ->
  m ()
runOryKratosServer :: Config -> OryKratosBackend (ExceptT ServerError IO) traits -> m ()
runOryKratosServer Config
config OryKratosBackend (ExceptT ServerError IO) traits
backend = Config
-> (Application -> Application)
-> OryKratosBackend (ExceptT ServerError IO) traits
-> m ()
forall (m :: * -> *) traits.
(MonadIO m, MonadThrow m, ToJSON traits) =>
Config
-> (Application -> Application)
-> OryKratosBackend (ExceptT ServerError IO) traits
-> m ()
runOryKratosMiddlewareServer Config
config Application -> Application
requestMiddlewareId OryKratosBackend (ExceptT ServerError IO) traits
backend

-- | Run the OryKratos server at the provided host and port.
runOryKratosMiddlewareServer ::
  (MonadIO m, MonadThrow m, ToJSON traits) =>
  Config ->
  Middleware ->
  OryKratosBackend (ExceptT ServerError IO) traits ->
  m ()
runOryKratosMiddlewareServer :: Config
-> (Application -> Application)
-> OryKratosBackend (ExceptT ServerError IO) traits
-> m ()
runOryKratosMiddlewareServer Config {[Char]
configUrl :: [Char]
$sel:configUrl:Config :: Config -> [Char]
..} Application -> Application
middleware OryKratosBackend (ExceptT ServerError IO) traits
backend = do
  BaseUrl
url <- [Char] -> m BaseUrl
forall (m :: * -> *). MonadThrow m => [Char] -> m BaseUrl
parseBaseUrl [Char]
configUrl
  let warpSettings :: Settings
warpSettings =
        Settings
Warp.defaultSettings
          Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& Int -> Settings -> Settings
Warp.setPort (BaseUrl -> Int
baseUrlPort BaseUrl
url)
          Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& HostPreference -> Settings -> Settings
Warp.setHost ([Char] -> HostPreference
forall a. IsString a => [Char] -> a
fromString ([Char] -> HostPreference) -> [Char] -> HostPreference
forall a b. (a -> b) -> a -> b
$ BaseUrl -> [Char]
baseUrlHost BaseUrl
url)
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Settings -> Application -> IO ()
Warp.runSettings Settings
warpSettings (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$ Application -> Application
middleware (Application -> Application) -> Application -> Application
forall a b. (a -> b) -> a -> b
$ OryKratosBackend (ExceptT ServerError IO) traits -> Application
forall traits.
ToJSON traits =>
OryKratosBackend (ExceptT ServerError IO) traits -> Application
serverWaiApplicationOryKratos OryKratosBackend (ExceptT ServerError IO) traits
backend

-- | Plain "Network.Wai" Application for the OryKratos server.
--
-- Can be used to implement e.g. tests that call the API without a full webserver.
serverWaiApplicationOryKratos :: forall traits. (ToJSON traits) => OryKratosBackend (ExceptT ServerError IO) traits -> Application
serverWaiApplicationOryKratos :: OryKratosBackend (ExceptT ServerError IO) traits -> Application
serverWaiApplicationOryKratos OryKratosBackend (ExceptT ServerError IO) traits
backend = Proxy (OryKratosAPI traits)
-> Server (OryKratosAPI traits) -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy (OryKratosAPI traits)
forall k (t :: k). Proxy t
Proxy :: Proxy (OryKratosAPI traits)) (OryKratosBackend (ExceptT ServerError IO) traits
-> Handler GetVersion200Response
   :<|> (Handler IsAlive200Response
         :<|> (Handler IsAlive200Response
               :<|> ((AdminCreateIdentityBody -> Handler (Identity traits))
                     :<|> ((AdminCreateSelfServiceRecoveryLinkBody
                            -> Handler SelfServiceRecoveryLink)
                           :<|> ((Text -> Handler NoContent)
                                 :<|> ((Text -> Handler NoContent)
                                       :<|> ((Text -> Handler (Session traits))
                                             :<|> ((Text
                                                    -> Maybe (QueryList 'MultiParamArray Text)
                                                    -> Handler (Identity traits))
                                                   :<|> ((Maybe Integer
                                                          -> Maybe Integer
                                                          -> Handler [Identity traits])
                                                         :<|> ((Text
                                                                -> Maybe Integer
                                                                -> Maybe Integer
                                                                -> Maybe Bool
                                                                -> Handler [Session traits])
                                                               :<|> ((Text
                                                                      -> AdminUpdateIdentityBody
                                                                      -> Handler (Identity traits))
                                                                     :<|> ((Maybe Text
                                                                            -> Handler
                                                                                 SelfServiceLogoutUrl)
                                                                           :<|> ((Text
                                                                                  -> Handler Value)
                                                                                 :<|> ((Maybe Text
                                                                                        -> Handler
                                                                                             SelfServiceError)
                                                                                       :<|> ((Maybe
                                                                                                Text
                                                                                              -> Maybe
                                                                                                   Text
                                                                                              -> Handler
                                                                                                   SelfServiceLoginFlow)
                                                                                             :<|> ((Maybe
                                                                                                      Text
                                                                                                    -> Maybe
                                                                                                         Text
                                                                                                    -> Handler
                                                                                                         SelfServiceRecoveryFlow)
                                                                                                   :<|> ((Maybe
                                                                                                            Text
                                                                                                          -> Maybe
                                                                                                               Text
                                                                                                          -> Handler
                                                                                                               SelfServiceRegistrationFlow)
                                                                                                         :<|> ((Maybe
                                                                                                                  Text
                                                                                                                -> Maybe
                                                                                                                     Text
                                                                                                                -> Maybe
                                                                                                                     Text
                                                                                                                -> Handler
                                                                                                                     (SelfServiceSettingsFlow
                                                                                                                        traits))
                                                                                                               :<|> ((Maybe
                                                                                                                        Text
                                                                                                                      -> Maybe
                                                                                                                           Text
                                                                                                                      -> Handler
                                                                                                                           SelfServiceVerificationFlow)
                                                                                                                     :<|> (Handler
                                                                                                                             Text
                                                                                                                           :<|> ((Maybe
                                                                                                                                    Bool
                                                                                                                                  -> Maybe
                                                                                                                                       Text
                                                                                                                                  -> Maybe
                                                                                                                                       Text
                                                                                                                                  -> Handler
                                                                                                                                       SelfServiceLoginFlow)
                                                                                                                                 :<|> ((Maybe
                                                                                                                                          Bool
                                                                                                                                        -> Maybe
                                                                                                                                             Text
                                                                                                                                        -> Maybe
                                                                                                                                             Text
                                                                                                                                        -> Handler
                                                                                                                                             SelfServiceLoginFlow)
                                                                                                                                       :<|> ((Maybe
                                                                                                                                                Text
                                                                                                                                              -> Handler
                                                                                                                                                   SelfServiceRecoveryFlow)
                                                                                                                                             :<|> (Handler
                                                                                                                                                     SelfServiceRecoveryFlow
                                                                                                                                                   :<|> ((Maybe
                                                                                                                                                            Text
                                                                                                                                                          -> Handler
                                                                                                                                                               SelfServiceRegistrationFlow)
                                                                                                                                                         :<|> (Handler
                                                                                                                                                                 SelfServiceRegistrationFlow
                                                                                                                                                               :<|> ((Maybe
                                                                                                                                                                        Text
                                                                                                                                                                      -> Handler
                                                                                                                                                                           (SelfServiceSettingsFlow
                                                                                                                                                                              traits))
                                                                                                                                                                     :<|> ((Maybe
                                                                                                                                                                              Text
                                                                                                                                                                            -> Handler
                                                                                                                                                                                 (SelfServiceSettingsFlow
                                                                                                                                                                                    traits))
                                                                                                                                                                           :<|> ((Maybe
                                                                                                                                                                                    Text
                                                                                                                                                                                  -> Handler
                                                                                                                                                                                       SelfServiceVerificationFlow)
                                                                                                                                                                                 :<|> (Handler
                                                                                                                                                                                         SelfServiceVerificationFlow
                                                                                                                                                                                       :<|> ((Maybe
                                                                                                                                                                                                Integer
                                                                                                                                                                                              -> Maybe
                                                                                                                                                                                                   Integer
                                                                                                                                                                                              -> Handler
                                                                                                                                                                                                   [IdentitySchema])
                                                                                                                                                                                             :<|> ((Maybe
                                                                                                                                                                                                      Integer
                                                                                                                                                                                                    -> Maybe
                                                                                                                                                                                                         Integer
                                                                                                                                                                                                    -> Maybe
                                                                                                                                                                                                         Text
                                                                                                                                                                                                    -> Maybe
                                                                                                                                                                                                         Text
                                                                                                                                                                                                    -> Handler
                                                                                                                                                                                                         [Session
                                                                                                                                                                                                            traits])
                                                                                                                                                                                                   :<|> ((Text
                                                                                                                                                                                                          -> Handler
                                                                                                                                                                                                               NoContent)
                                                                                                                                                                                                         :<|> ((Maybe
                                                                                                                                                                                                                  Text
                                                                                                                                                                                                                -> Maybe
                                                                                                                                                                                                                     Text
                                                                                                                                                                                                                -> Handler
                                                                                                                                                                                                                     RevokedSessions)
                                                                                                                                                                                                               :<|> ((Maybe
                                                                                                                                                                                                                        Text
                                                                                                                                                                                                                      -> SubmitSelfServiceLoginFlowBody
                                                                                                                                                                                                                      -> Maybe
                                                                                                                                                                                                                           Text
                                                                                                                                                                                                                      -> Maybe
                                                                                                                                                                                                                           Text
                                                                                                                                                                                                                      -> Handler
                                                                                                                                                                                                                           (SuccessfulSelfServiceLoginWithoutBrowser
                                                                                                                                                                                                                              traits))
                                                                                                                                                                                                                     :<|> ((Maybe
                                                                                                                                                                                                                              Text
                                                                                                                                                                                                                            -> Maybe
                                                                                                                                                                                                                                 Text
                                                                                                                                                                                                                            -> Handler
                                                                                                                                                                                                                                 NoContent)
                                                                                                                                                                                                                           :<|> ((SubmitSelfServiceLogoutFlowWithoutBrowserBody
                                                                                                                                                                                                                                  -> Handler
                                                                                                                                                                                                                                       NoContent)
                                                                                                                                                                                                                                 :<|> ((Maybe
                                                                                                                                                                                                                                          Text
                                                                                                                                                                                                                                        -> Maybe
                                                                                                                                                                                                                                             Text
                                                                                                                                                                                                                                        -> SubmitSelfServiceRecoveryFlowBody
                                                                                                                                                                                                                                        -> Maybe
                                                                                                                                                                                                                                             Text
                                                                                                                                                                                                                                        -> Handler
                                                                                                                                                                                                                                             SelfServiceRecoveryFlow)
                                                                                                                                                                                                                                       :<|> ((Maybe
                                                                                                                                                                                                                                                Text
                                                                                                                                                                                                                                              -> SubmitSelfServiceRegistrationFlowBody
                                                                                                                                                                                                                                              -> Maybe
                                                                                                                                                                                                                                                   Text
                                                                                                                                                                                                                                              -> Handler
                                                                                                                                                                                                                                                   (SuccessfulSelfServiceRegistrationWithoutBrowser
                                                                                                                                                                                                                                                      traits))
                                                                                                                                                                                                                                             :<|> ((Maybe
                                                                                                                                                                                                                                                      Text
                                                                                                                                                                                                                                                    -> SubmitSelfServiceSettingsFlowBody
                                                                                                                                                                                                                                                    -> Maybe
                                                                                                                                                                                                                                                         Text
                                                                                                                                                                                                                                                    -> Maybe
                                                                                                                                                                                                                                                         Text
                                                                                                                                                                                                                                                    -> Handler
                                                                                                                                                                                                                                                         (SelfServiceSettingsFlow
                                                                                                                                                                                                                                                            traits))
                                                                                                                                                                                                                                                   :<|> ((Maybe
                                                                                                                                                                                                                                                            Text
                                                                                                                                                                                                                                                          -> Maybe
                                                                                                                                                                                                                                                               Text
                                                                                                                                                                                                                                                          -> SubmitSelfServiceVerificationFlowBody
                                                                                                                                                                                                                                                          -> Maybe
                                                                                                                                                                                                                                                               Text
                                                                                                                                                                                                                                                          -> Handler
                                                                                                                                                                                                                                                               SelfServiceVerificationFlow)
                                                                                                                                                                                                                                                         :<|> ((Maybe
                                                                                                                                                                                                                                                                  Text
                                                                                                                                                                                                                                                                -> Maybe
                                                                                                                                                                                                                                                                     Text
                                                                                                                                                                                                                                                                -> Handler
                                                                                                                                                                                                                                                                     (Session
                                                                                                                                                                                                                                                                        traits))
                                                                                                                                                                                                                                                               :<|> Tagged
                                                                                                                                                                                                                                                                      Handler
                                                                                                                                                                                                                                                                      Application))))))))))))))))))))))))))))))))))))))))))
forall a (m :: * -> *) a a a traits a a a a a a a a a a a a a a a a
       a a a a a a a a a a a a a a a a a a a a a a a (m :: * -> *).
(Coercible a (m GetVersion200Response),
 Coercible a (m IsAlive200Response),
 Coercible a (m IsAlive200Response),
 Coercible a (AdminCreateIdentityBody -> m (Identity traits)),
 Coercible
   a
   (AdminCreateSelfServiceRecoveryLinkBody
    -> m SelfServiceRecoveryLink),
 Coercible a (Text -> m NoContent),
 Coercible a (Text -> m NoContent),
 Coercible a (Text -> m (Session traits)),
 Coercible a (Text -> Maybe [Text] -> m (Identity traits)),
 Coercible
   a (Maybe Integer -> Maybe Integer -> m [Identity traits]),
 Coercible
   a
   (Text
    -> Maybe Integer
    -> Maybe Integer
    -> Maybe Bool
    -> m [Session traits]),
 Coercible
   a (Text -> AdminUpdateIdentityBody -> m (Identity traits)),
 Coercible a (Maybe Text -> m SelfServiceLogoutUrl),
 Coercible a (Text -> m Value),
 Coercible a (Maybe Text -> m SelfServiceError),
 Coercible a (Maybe Text -> Maybe Text -> m SelfServiceLoginFlow),
 Coercible
   a (Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow),
 Coercible
   a (Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow),
 Coercible
   a
   (Maybe Text
    -> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits)),
 Coercible
   a (Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow),
 Coercible a (m Text),
 Coercible
   a
   (Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow),
 Coercible
   a
   (Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow),
 Coercible a (Maybe Text -> m SelfServiceRecoveryFlow),
 Coercible a (m SelfServiceRecoveryFlow),
 Coercible a (Maybe Text -> m SelfServiceRegistrationFlow),
 Coercible a (m SelfServiceRegistrationFlow),
 Coercible a (Maybe Text -> m (SelfServiceSettingsFlow traits)),
 Coercible a (Maybe Text -> m (SelfServiceSettingsFlow traits)),
 Coercible a (Maybe Text -> m SelfServiceVerificationFlow),
 Coercible a (m SelfServiceVerificationFlow),
 Coercible a (Maybe Integer -> Maybe Integer -> m [IdentitySchema]),
 Coercible
   a
   (Maybe Integer
    -> Maybe Integer
    -> Maybe Text
    -> Maybe Text
    -> m [Session traits]),
 Coercible a (Text -> m NoContent),
 Coercible a (Maybe Text -> Maybe Text -> m RevokedSessions),
 Coercible
   a
   (Maybe Text
    -> SubmitSelfServiceLoginFlowBody
    -> Maybe Text
    -> Maybe Text
    -> m (SuccessfulSelfServiceLoginWithoutBrowser traits)),
 Coercible a (Maybe Text -> Maybe Text -> m NoContent),
 Coercible
   a (SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent),
 Coercible
   a
   (Maybe Text
    -> Maybe Text
    -> SubmitSelfServiceRecoveryFlowBody
    -> Maybe Text
    -> m SelfServiceRecoveryFlow),
 Coercible
   a
   (Maybe Text
    -> SubmitSelfServiceRegistrationFlowBody
    -> Maybe Text
    -> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits)),
 Coercible
   a
   (Maybe Text
    -> SubmitSelfServiceSettingsFlowBody
    -> Maybe Text
    -> Maybe Text
    -> m (SelfServiceSettingsFlow traits)),
 Coercible
   a
   (Maybe Text
    -> Maybe Text
    -> SubmitSelfServiceVerificationFlowBody
    -> Maybe Text
    -> m SelfServiceVerificationFlow),
 Coercible a (Maybe Text -> Maybe Text -> m (Session traits))) =>
OryKratosBackend m traits
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                                                                               :<|> Tagged
                                                                                                                                                                                                                                                                      m
                                                                                                                                                                                                                                                                      Application))))))))))))))))))))))))))))))))))))))))))
serverFromBackend OryKratosBackend (ExceptT ServerError IO) traits
backend)
  where
    serverFromBackend :: OryKratosBackend m traits
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                                                                               :<|> Tagged
                                                                                                                                                                                                                                                                      m
                                                                                                                                                                                                                                                                      Application))))))))))))))))))))))))))))))))))))))))))
serverFromBackend OryKratosBackend {m Text
m IsAlive200Response
m GetVersion200Response
m SelfServiceVerificationFlow
m SelfServiceRegistrationFlow
m SelfServiceRecoveryFlow
Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
Maybe Integer -> Maybe Integer -> m [IdentitySchema]
Maybe Integer -> Maybe Integer -> m [Identity traits]
Maybe Integer
-> Maybe Integer -> Maybe Text -> Maybe Text -> m [Session traits]
Maybe Text -> m SelfServiceVerificationFlow
Maybe Text -> m (SelfServiceSettingsFlow traits)
Maybe Text -> m SelfServiceRegistrationFlow
Maybe Text -> m SelfServiceRecoveryFlow
Maybe Text -> m SelfServiceLogoutUrl
Maybe Text -> m SelfServiceError
Maybe Text -> Maybe Text -> m NoContent
Maybe Text -> Maybe Text -> m RevokedSessions
Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow
Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow
Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow
Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
Maybe Text -> Maybe Text -> m (Session traits)
Maybe Text
-> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits)
Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> m SelfServiceVerificationFlow
Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> m SelfServiceRecoveryFlow
Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> m (SuccessfulSelfServiceLoginWithoutBrowser traits)
Text -> m Value
Text -> m NoContent
Text -> m (Session traits)
Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> m [Session traits]
Text -> Maybe [Text] -> m (Identity traits)
Text -> AdminUpdateIdentityBody -> m (Identity traits)
SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent
AdminCreateSelfServiceRecoveryLinkBody -> m SelfServiceRecoveryLink
AdminCreateIdentityBody -> m (Identity traits)
toSession :: Maybe Text -> Maybe Text -> m (Session traits)
submitSelfServiceVerificationFlow :: Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> m SelfServiceVerificationFlow
submitSelfServiceSettingsFlow :: Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
submitSelfServiceRegistrationFlow :: Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
submitSelfServiceRecoveryFlow :: Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> m SelfServiceRecoveryFlow
submitSelfServiceLogoutFlowWithoutBrowser :: SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent
submitSelfServiceLogoutFlow :: Maybe Text -> Maybe Text -> m NoContent
submitSelfServiceLoginFlow :: Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> m (SuccessfulSelfServiceLoginWithoutBrowser traits)
revokeSessions :: Maybe Text -> Maybe Text -> m RevokedSessions
revokeSession :: Text -> m NoContent
listSessions :: Maybe Integer
-> Maybe Integer -> Maybe Text -> Maybe Text -> m [Session traits]
listIdentitySchemas :: Maybe Integer -> Maybe Integer -> m [IdentitySchema]
initializeSelfServiceVerificationFlowWithoutBrowser :: m SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowForBrowsers :: Maybe Text -> m SelfServiceVerificationFlow
initializeSelfServiceSettingsFlowWithoutBrowser :: Maybe Text -> m (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowForBrowsers :: Maybe Text -> m (SelfServiceSettingsFlow traits)
initializeSelfServiceRegistrationFlowWithoutBrowser :: m SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowForBrowsers :: Maybe Text -> m SelfServiceRegistrationFlow
initializeSelfServiceRecoveryFlowWithoutBrowser :: m SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowForBrowsers :: Maybe Text -> m SelfServiceRecoveryFlow
initializeSelfServiceLoginFlowWithoutBrowser :: Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
initializeSelfServiceLoginFlowForBrowsers :: Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
getWebAuthnJavaScript :: m Text
getSelfServiceVerificationFlow :: Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow
getSelfServiceSettingsFlow :: Maybe Text
-> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits)
getSelfServiceRegistrationFlow :: Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow
getSelfServiceRecoveryFlow :: Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow
getSelfServiceLoginFlow :: Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
getSelfServiceError :: Maybe Text -> m SelfServiceError
getJsonSchema :: Text -> m Value
createSelfServiceLogoutFlowUrlForBrowsers :: Maybe Text -> m SelfServiceLogoutUrl
adminUpdateIdentity :: Text -> AdminUpdateIdentityBody -> m (Identity traits)
adminListIdentitySessions :: Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> m [Session traits]
adminListIdentities :: Maybe Integer -> Maybe Integer -> m [Identity traits]
adminGetIdentity :: Text -> Maybe [Text] -> m (Identity traits)
adminExtendSession :: Text -> m (Session traits)
adminDeleteIdentitySessions :: Text -> m NoContent
adminDeleteIdentity :: Text -> m NoContent
adminCreateSelfServiceRecoveryLink :: AdminCreateSelfServiceRecoveryLinkBody -> m SelfServiceRecoveryLink
adminCreateIdentity :: AdminCreateIdentityBody -> m (Identity traits)
isReady :: m IsAlive200Response
isAlive :: m IsAlive200Response
getVersion :: m GetVersion200Response
$sel:toSession:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m (Session traits)
$sel:submitSelfServiceVerificationFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> m SelfServiceVerificationFlow
$sel:submitSelfServiceSettingsFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
$sel:submitSelfServiceRegistrationFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
$sel:submitSelfServiceRecoveryFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> m SelfServiceRecoveryFlow
$sel:submitSelfServiceLogoutFlowWithoutBrowser:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent
$sel:submitSelfServiceLogoutFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m NoContent
$sel:submitSelfServiceLoginFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> m (SuccessfulSelfServiceLoginWithoutBrowser traits)
$sel:revokeSessions:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m RevokedSessions
$sel:revokeSession:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Text -> m NoContent
$sel:listSessions:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> m [Session traits]
$sel:listIdentitySchemas:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Integer -> Maybe Integer -> m [IdentitySchema]
$sel:initializeSelfServiceVerificationFlowWithoutBrowser:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> m SelfServiceVerificationFlow
$sel:initializeSelfServiceVerificationFlowForBrowsers:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> m SelfServiceVerificationFlow
$sel:initializeSelfServiceSettingsFlowWithoutBrowser:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> m (SelfServiceSettingsFlow traits)
$sel:initializeSelfServiceSettingsFlowForBrowsers:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> m (SelfServiceSettingsFlow traits)
$sel:initializeSelfServiceRegistrationFlowWithoutBrowser:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> m SelfServiceRegistrationFlow
$sel:initializeSelfServiceRegistrationFlowForBrowsers:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> m SelfServiceRegistrationFlow
$sel:initializeSelfServiceRecoveryFlowWithoutBrowser:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> m SelfServiceRecoveryFlow
$sel:initializeSelfServiceRecoveryFlowForBrowsers:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> m SelfServiceRecoveryFlow
$sel:initializeSelfServiceLoginFlowWithoutBrowser:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
$sel:initializeSelfServiceLoginFlowForBrowsers:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
$sel:getWebAuthnJavaScript:OryKratosBackend :: forall (m :: * -> *) traits. OryKratosBackend m traits -> m Text
$sel:getSelfServiceVerificationFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow
$sel:getSelfServiceSettingsFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
$sel:getSelfServiceRegistrationFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow
$sel:getSelfServiceRecoveryFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow
$sel:getSelfServiceLoginFlow:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
$sel:getSelfServiceError:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Maybe Text -> m SelfServiceError
$sel:getJsonSchema:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Text -> m Value
$sel:createSelfServiceLogoutFlowUrlForBrowsers:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Maybe Text -> m SelfServiceLogoutUrl
$sel:adminUpdateIdentity:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Text -> AdminUpdateIdentityBody -> m (Identity traits)
$sel:adminListIdentitySessions:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> m [Session traits]
$sel:adminListIdentities:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Maybe Integer -> Maybe Integer -> m [Identity traits]
$sel:adminGetIdentity:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> Text -> Maybe [Text] -> m (Identity traits)
$sel:adminExtendSession:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Text -> m (Session traits)
$sel:adminDeleteIdentitySessions:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Text -> m NoContent
$sel:adminDeleteIdentity:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> Text -> m NoContent
$sel:adminCreateSelfServiceRecoveryLink:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> AdminCreateSelfServiceRecoveryLinkBody
-> m SelfServiceRecoveryLink
$sel:adminCreateIdentity:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits
-> AdminCreateIdentityBody -> m (Identity traits)
$sel:isReady:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> m IsAlive200Response
$sel:isAlive:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> m IsAlive200Response
$sel:getVersion:OryKratosBackend :: forall (m :: * -> *) traits.
OryKratosBackend m traits -> m GetVersion200Response
..} =
      ( m GetVersion200Response -> a
coerce m GetVersion200Response
getVersion
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> (a
                                                                                                                                                                                                                            :<|> (a
                                                                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                                                                          :<|> Tagged
                                                                                                                                                                                                                                                                 m
                                                                                                                                                                                                                                                                 Application))))))))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                                                                               :<|> Tagged
                                                                                                                                                                                                                                                                      m
                                                                                                                                                                                                                                                                      Application))))))))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> m IsAlive200Response -> a
coerce m IsAlive200Response
isAlive
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> (a
                                                                                                                                                                                                                            :<|> (a
                                                                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                                                                    :<|> Tagged
                                                                                                                                                                                                                                                           m
                                                                                                                                                                                                                                                           Application)))))))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                                                                         :<|> Tagged
                                                                                                                                                                                                                                                                m
                                                                                                                                                                                                                                                                Application)))))))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> m IsAlive200Response -> a
coerce m IsAlive200Response
isReady
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> (a
                                                                                                                                                                                                                            :<|> (a
                                                                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                                                                              :<|> Tagged
                                                                                                                                                                                                                                                     m
                                                                                                                                                                                                                                                     Application))))))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                                                                   :<|> Tagged
                                                                                                                                                                                                                                                          m
                                                                                                                                                                                                                                                          Application))))))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (AdminCreateIdentityBody -> m (Identity traits)) -> a
coerce AdminCreateIdentityBody -> m (Identity traits)
adminCreateIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> (a
                                                                                                                                                                                                                            :<|> (a
                                                                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                                                                        :<|> Tagged
                                                                                                                                                                                                                                               m
                                                                                                                                                                                                                                               Application)))))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                                                                             :<|> Tagged
                                                                                                                                                                                                                                                    m
                                                                                                                                                                                                                                                    Application)))))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (AdminCreateSelfServiceRecoveryLinkBody
 -> m SelfServiceRecoveryLink)
-> a
coerce AdminCreateSelfServiceRecoveryLinkBody -> m SelfServiceRecoveryLink
adminCreateSelfServiceRecoveryLink
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> (a
                                                                                                                                                                                                                            :<|> (a
                                                                                                                                                                                                                                  :<|> Tagged
                                                                                                                                                                                                                                         m
                                                                                                                                                                                                                                         Application))))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                                                                       :<|> Tagged
                                                                                                                                                                                                                                              m
                                                                                                                                                                                                                                              Application))))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> m NoContent) -> a
coerce Text -> m NoContent
adminDeleteIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> (a
                                                                                                                                                                                                                            :<|> Tagged
                                                                                                                                                                                                                                   m
                                                                                                                                                                                                                                   Application)))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> (a
                                                                                                                                                                                                                                 :<|> Tagged
                                                                                                                                                                                                                                        m
                                                                                                                                                                                                                                        Application)))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> m NoContent) -> a
coerce Text -> m NoContent
adminDeleteIdentitySessions
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> (a
                                                                                                                                                                                                                      :<|> Tagged
                                                                                                                                                                                                                             m
                                                                                                                                                                                                                             Application))))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> (a
                                                                                                                                                                                                                           :<|> Tagged
                                                                                                                                                                                                                                  m
                                                                                                                                                                                                                                  Application))))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> m (Session traits)) -> a
coerce Text -> m (Session traits)
adminExtendSession
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> (a
                                                                                                                                                                                                                :<|> Tagged
                                                                                                                                                                                                                       m
                                                                                                                                                                                                                       Application)))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> (a
                                                                                                                                                                                                                     :<|> Tagged
                                                                                                                                                                                                                            m
                                                                                                                                                                                                                            Application)))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> Maybe [Text] -> m (Identity traits)) -> a
coerce Text -> Maybe [Text] -> m (Identity traits)
adminGetIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> (a
                                                                                                                                                                                                          :<|> Tagged
                                                                                                                                                                                                                 m
                                                                                                                                                                                                                 Application))))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> (a
                                                                                                                                                                                                               :<|> Tagged
                                                                                                                                                                                                                      m
                                                                                                                                                                                                                      Application))))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Integer -> Maybe Integer -> m [Identity traits]) -> a
coerce Maybe Integer -> Maybe Integer -> m [Identity traits]
adminListIdentities
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> (a
                                                                                                                                                                                                    :<|> Tagged
                                                                                                                                                                                                           m
                                                                                                                                                                                                           Application)))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> (a
                                                                                                                                                                                                         :<|> Tagged
                                                                                                                                                                                                                m
                                                                                                                                                                                                                Application)))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Bool
 -> m [Session traits])
-> a
coerce Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> m [Session traits]
adminListIdentitySessions
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> (a
                                                                                                                                                                                              :<|> Tagged
                                                                                                                                                                                                     m
                                                                                                                                                                                                     Application))))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> (a
                                                                                                                                                                                                   :<|> Tagged
                                                                                                                                                                                                          m
                                                                                                                                                                                                          Application))))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> AdminUpdateIdentityBody -> m (Identity traits)) -> a
coerce Text -> AdminUpdateIdentityBody -> m (Identity traits)
adminUpdateIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> (a
                                                                                                                                                                                        :<|> Tagged
                                                                                                                                                                                               m
                                                                                                                                                                                               Application)))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> (a
                                                                                                                                                                                             :<|> Tagged
                                                                                                                                                                                                    m
                                                                                                                                                                                                    Application)))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m SelfServiceLogoutUrl) -> a
coerce Maybe Text -> m SelfServiceLogoutUrl
createSelfServiceLogoutFlowUrlForBrowsers
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> (a
                                                                                                                                                                                  :<|> Tagged
                                                                                                                                                                                         m
                                                                                                                                                                                         Application))))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> (a
                                                                                                                                                                                       :<|> Tagged
                                                                                                                                                                                              m
                                                                                                                                                                                              Application))))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> m Value) -> a
coerce Text -> m Value
getJsonSchema
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> (a
                                                                                                                                                                            :<|> Tagged
                                                                                                                                                                                   m
                                                                                                                                                                                   Application)))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> (a
                                                                                                                                                                                 :<|> Tagged
                                                                                                                                                                                        m
                                                                                                                                                                                        Application)))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m SelfServiceError) -> a
coerce Maybe Text -> m SelfServiceError
getSelfServiceError
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> (a
                                                                                                                                                                      :<|> Tagged
                                                                                                                                                                             m
                                                                                                                                                                             Application))))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> (a
                                                                                                                                                                           :<|> Tagged
                                                                                                                                                                                  m
                                                                                                                                                                                  Application))))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m SelfServiceLoginFlow) -> a
coerce Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
getSelfServiceLoginFlow
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> (a
                                                                                                                                                                :<|> Tagged
                                                                                                                                                                       m
                                                                                                                                                                       Application)))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> (a
                                                                                                                                                                     :<|> Tagged
                                                                                                                                                                            m
                                                                                                                                                                            Application)))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow) -> a
coerce Maybe Text -> Maybe Text -> m SelfServiceRecoveryFlow
getSelfServiceRecoveryFlow
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> (a
                                                                                                                                                          :<|> Tagged
                                                                                                                                                                 m
                                                                                                                                                                 Application))))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> (a
                                                                                                                                                               :<|> Tagged
                                                                                                                                                                      m
                                                                                                                                                                      Application))))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow) -> a
coerce Maybe Text -> Maybe Text -> m SelfServiceRegistrationFlow
getSelfServiceRegistrationFlow
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> (a
                                                                                                                                                    :<|> Tagged
                                                                                                                                                           m
                                                                                                                                                           Application)))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> (a
                                                                                                                                                         :<|> Tagged
                                                                                                                                                                m
                                                                                                                                                                Application)))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text
 -> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits))
-> a
coerce Maybe Text
-> Maybe Text -> Maybe Text -> m (SelfServiceSettingsFlow traits)
getSelfServiceSettingsFlow
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> (a
                                                                                                                                              :<|> Tagged
                                                                                                                                                     m
                                                                                                                                                     Application))))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> (a
                                                                                                                                                   :<|> Tagged
                                                                                                                                                          m
                                                                                                                                                          Application))))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow) -> a
coerce Maybe Text -> Maybe Text -> m SelfServiceVerificationFlow
getSelfServiceVerificationFlow
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> (a
                                                                                                                                        :<|> Tagged
                                                                                                                                               m
                                                                                                                                               Application)))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> (a
                                                                                                                                             :<|> Tagged
                                                                                                                                                    m
                                                                                                                                                    Application)))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> m Text -> a
coerce m Text
getWebAuthnJavaScript
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> (a
                                                                                                                                  :<|> Tagged
                                                                                                                                         m
                                                                                                                                         Application))))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> (a
                                                                                                                                       :<|> Tagged
                                                                                                                                              m
                                                                                                                                              Application))))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow)
-> a
coerce Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
initializeSelfServiceLoginFlowForBrowsers
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> (a
                                                                                                                            :<|> Tagged
                                                                                                                                   m
                                                                                                                                   Application)))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> (a
                                                                                                                                 :<|> Tagged
                                                                                                                                        m
                                                                                                                                        Application)))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow)
-> a
coerce Maybe Bool -> Maybe Text -> Maybe Text -> m SelfServiceLoginFlow
initializeSelfServiceLoginFlowWithoutBrowser
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> (a
                                                                                                                      :<|> Tagged
                                                                                                                             m
                                                                                                                             Application))))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> (a
                                                                                                                           :<|> Tagged
                                                                                                                                  m
                                                                                                                                  Application))))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m SelfServiceRecoveryFlow) -> a
coerce Maybe Text -> m SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowForBrowsers
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> (a
                                                                                                                :<|> Tagged
                                                                                                                       m
                                                                                                                       Application)))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> (a
                                                                                                                     :<|> Tagged
                                                                                                                            m
                                                                                                                            Application)))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> m SelfServiceRecoveryFlow -> a
coerce m SelfServiceRecoveryFlow
initializeSelfServiceRecoveryFlowWithoutBrowser
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> (a
                                                                                                          :<|> Tagged
                                                                                                                 m
                                                                                                                 Application))))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> (a
                                                                                                               :<|> Tagged
                                                                                                                      m
                                                                                                                      Application))))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m SelfServiceRegistrationFlow) -> a
coerce Maybe Text -> m SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowForBrowsers
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> (a
                                                                                                    :<|> Tagged
                                                                                                           m
                                                                                                           Application)))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> (a
                                                                                                         :<|> Tagged
                                                                                                                m
                                                                                                                Application)))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> m SelfServiceRegistrationFlow -> a
coerce m SelfServiceRegistrationFlow
initializeSelfServiceRegistrationFlowWithoutBrowser
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> (a
                                                                                              :<|> Tagged
                                                                                                     m
                                                                                                     Application))))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> (a
                                                                                                   :<|> Tagged
                                                                                                          m
                                                                                                          Application))))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m (SelfServiceSettingsFlow traits)) -> a
coerce Maybe Text -> m (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowForBrowsers
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> (a
                                                                                        :<|> Tagged
                                                                                               m
                                                                                               Application)))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> (a
                                                                                             :<|> Tagged
                                                                                                    m
                                                                                                    Application)))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m (SelfServiceSettingsFlow traits)) -> a
coerce Maybe Text -> m (SelfServiceSettingsFlow traits)
initializeSelfServiceSettingsFlowWithoutBrowser
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> (a
                                                                                  :<|> Tagged
                                                                                         m
                                                                                         Application))))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> (a
                                                                                       :<|> Tagged
                                                                                              m
                                                                                              Application))))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> m SelfServiceVerificationFlow) -> a
coerce Maybe Text -> m SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowForBrowsers
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (a
                                                                            :<|> Tagged
                                                                                   m
                                                                                   Application)))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (a
                                                                                 :<|> Tagged
                                                                                        m
                                                                                        Application)))))))))))))
forall a b. a -> b -> a :<|> b
:<|> m SelfServiceVerificationFlow -> a
coerce m SelfServiceVerificationFlow
initializeSelfServiceVerificationFlowWithoutBrowser
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> Tagged
                                                                             m
                                                                             Application))))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> Tagged
                                                                                  m
                                                                                  Application))))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Integer -> Maybe Integer -> m [IdentitySchema]) -> a
coerce Maybe Integer -> Maybe Integer -> m [IdentitySchema]
listIdentitySchemas
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> Tagged m Application)))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> Tagged
                                                                            m Application)))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Integer
 -> Maybe Integer -> Maybe Text -> Maybe Text -> m [Session traits])
-> a
coerce Maybe Integer
-> Maybe Integer -> Maybe Text -> Maybe Text -> m [Session traits]
listSessions
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a :<|> Tagged m Application))))))))))
forall a b. a -> b -> a :<|> b
:<|> (Text -> m NoContent) -> a
coerce Text -> m NoContent
revokeSession
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m RevokedSessions) -> a
coerce Maybe Text -> Maybe Text -> m RevokedSessions
revokeSessions
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text
 -> SubmitSelfServiceLoginFlowBody
 -> Maybe Text
 -> Maybe Text
 -> m (SuccessfulSelfServiceLoginWithoutBrowser traits))
-> a
coerce Maybe Text
-> SubmitSelfServiceLoginFlowBody
-> Maybe Text
-> Maybe Text
-> m (SuccessfulSelfServiceLoginWithoutBrowser traits)
submitSelfServiceLoginFlow
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m NoContent) -> a
coerce Maybe Text -> Maybe Text -> m NoContent
submitSelfServiceLogoutFlow
          a
-> (a
    :<|> (a
          :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))))
-> a
   :<|> (a
         :<|> (a
               :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))))
forall a b. a -> b -> a :<|> b
:<|> (SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent) -> a
coerce SubmitSelfServiceLogoutFlowWithoutBrowserBody -> m NoContent
submitSelfServiceLogoutFlowWithoutBrowser
          a
-> (a
    :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))))
-> a
   :<|> (a
         :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text
 -> Maybe Text
 -> SubmitSelfServiceRecoveryFlowBody
 -> Maybe Text
 -> m SelfServiceRecoveryFlow)
-> a
coerce Maybe Text
-> Maybe Text
-> SubmitSelfServiceRecoveryFlowBody
-> Maybe Text
-> m SelfServiceRecoveryFlow
submitSelfServiceRecoveryFlow
          a
-> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))
-> a :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text
 -> SubmitSelfServiceRegistrationFlowBody
 -> Maybe Text
 -> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits))
-> a
coerce Maybe Text
-> SubmitSelfServiceRegistrationFlowBody
-> Maybe Text
-> m (SuccessfulSelfServiceRegistrationWithoutBrowser traits)
submitSelfServiceRegistrationFlow
          a
-> (a :<|> (a :<|> (a :<|> Tagged m Application)))
-> a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text
 -> SubmitSelfServiceSettingsFlowBody
 -> Maybe Text
 -> Maybe Text
 -> m (SelfServiceSettingsFlow traits))
-> a
coerce Maybe Text
-> SubmitSelfServiceSettingsFlowBody
-> Maybe Text
-> Maybe Text
-> m (SelfServiceSettingsFlow traits)
submitSelfServiceSettingsFlow
          a
-> (a :<|> (a :<|> Tagged m Application))
-> a :<|> (a :<|> (a :<|> Tagged m Application))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text
 -> Maybe Text
 -> SubmitSelfServiceVerificationFlowBody
 -> Maybe Text
 -> m SelfServiceVerificationFlow)
-> a
coerce Maybe Text
-> Maybe Text
-> SubmitSelfServiceVerificationFlowBody
-> Maybe Text
-> m SelfServiceVerificationFlow
submitSelfServiceVerificationFlow
          a
-> (a :<|> Tagged m Application)
-> a :<|> (a :<|> Tagged m Application)
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m (Session traits)) -> a
coerce Maybe Text -> Maybe Text -> m (Session traits)
toSession
          a -> Tagged m Application -> a :<|> Tagged m Application
forall a b. a -> b -> a :<|> b
:<|> [Char] -> ServerT Raw m
forall (m :: * -> *). [Char] -> ServerT Raw m
serveDirectoryFileServer [Char]
"static"
      )