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

    -- ** Servant
    OryKratosAPI,
  )
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 (Value)
import Data.Coerce (coerce)
import Data.Function ((&))
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Exts (IsString (..))
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.Wai (Middleware)
import qualified Network.Wai.Handler.Warp as Warp
import OryKratos.Types hiding (error)
import Servant (ServerError, serve)
import Servant.API
import Servant.Client
  ( ClientEnv,
    ClientError,
    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 Prelude

-- | 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
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
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 =
  "identities" :> ReqBody '[JSON] CreateIdentity :> Verb 'POST 200 '[JSON] Identity -- 'createIdentity' route
    :<|> "recovery" :> "link" :> ReqBody '[JSON] CreateRecoveryLink :> Verb 'POST 200 '[JSON] RecoveryLink -- 'createRecoveryLink' route
    :<|> "identities" :> Capture "id" Text :> Verb 'DELETE 200 '[JSON] () -- 'deleteIdentity' route
    :<|> "identities" :> Capture "id" Text :> Verb 'GET 200 '[JSON] Identity -- 'getIdentity' route
    :<|> "schemas" :> Capture "id" Text :> Verb 'GET 200 '[JSON] Value -- 'getSchema' route
    :<|> "self-service" :> "errors" :> QueryParam "error" Text :> Verb 'GET 200 '[JSON] ErrorContainer -- 'getSelfServiceError' route
    :<|> "self-service" :> "login" :> "flows" :> QueryParam "id" Text :> Verb 'GET 200 '[JSON] LoginFlow -- 'getSelfServiceLoginFlow' route
    :<|> "self-service" :> "recovery" :> "flows" :> QueryParam "id" Text :> Verb 'GET 200 '[JSON] RecoveryFlow -- 'getSelfServiceRecoveryFlow' route
    :<|> "self-service" :> "registration" :> "flows" :> QueryParam "id" Text :> Verb 'GET 200 '[JSON] RegistrationFlow -- 'getSelfServiceRegistrationFlow' route
    :<|> "self-service" :> "settings" :> "flows" :> QueryParam "id" Text :> Verb 'GET 200 '[JSON] SettingsFlow -- 'getSelfServiceSettingsFlow' route
    :<|> "self-service" :> "verification" :> "flows" :> QueryParam "id" Text :> Verb 'GET 200 '[JSON] VerificationFlow -- 'getSelfServiceVerificationFlow' route
    :<|> "identities" :> QueryParam "per_page" Integer :> QueryParam "page" Integer :> Verb 'GET 200 '[JSON] [Identity] -- 'listIdentities' route
    :<|> "metrics" :> "prometheus" :> Verb 'GET 200 '[JSON] () -- 'prometheus' route
    :<|> "identities" :> Capture "id" Text :> ReqBody '[JSON] UpdateIdentity :> Verb 'PUT 200 '[JSON] Identity -- 'updateIdentity' route
    :<|> "health" :> "alive" :> Verb 'GET 200 '[JSON] HealthStatus -- 'isInstanceAlive' route
    :<|> "health" :> "ready" :> Verb 'GET 200 '[JSON] HealthStatus -- 'isInstanceReady' route
    :<|> "self-service" :> "browser" :> "flows" :> "registration" :> "strategies" :> "oidc" :> "settings" :> "connections" :> Verb 'POST 200 '[JSON] () -- 'completeSelfServiceBrowserSettingsOIDCSettingsFlow' route
    :<|> "self-service" :> "login" :> "methods" :> "password" :> QueryParam "flow" Text :> ReqBody '[JSON] CompleteSelfServiceLoginFlowWithPasswordMethod :> Verb 'POST 200 '[JSON] LoginViaApiResponse -- 'completeSelfServiceLoginFlowWithPasswordMethod' route
    :<|> "self-service" :> "recovery" :> "methods" :> "link" :> QueryParam "token" Text :> QueryParam "flow" Text :> ReqBody '[JSON] CompleteSelfServiceRecoveryFlowWithLinkMethod :> Verb 'POST 200 '[JSON] () -- 'completeSelfServiceRecoveryFlowWithLinkMethod' route
    :<|> "self-service" :> "registration" :> "methods" :> "password" :> QueryParam "flow" Text :> ReqBody '[JSON] Value :> Verb 'POST 200 '[JSON] RegistrationViaApiResponse -- 'completeSelfServiceRegistrationFlowWithPasswordMethod' route
    :<|> "self-service" :> "settings" :> "methods" :> "password" :> QueryParam "flow" Text :> ReqBody '[JSON] CompleteSelfServiceSettingsFlowWithPasswordMethod :> Verb 'POST 200 '[JSON] SettingsViaApiResponse -- 'completeSelfServiceSettingsFlowWithPasswordMethod' route
    :<|> "self-service" :> "settings" :> "methods" :> "profile" :> QueryParam "flow" Text :> ReqBody '[JSON] Value :> Verb 'POST 200 '[JSON] SettingsFlow -- 'completeSelfServiceSettingsFlowWithProfileMethod' route
    :<|> "self-service" :> "verification" :> "methods" :> "link" :> QueryParam "token" Text :> QueryParam "flow" Text :> ReqBody '[JSON] CompleteSelfServiceVerificationFlowWithLinkMethod :> Verb 'POST 200 '[JSON] () -- 'completeSelfServiceVerificationFlowWithLinkMethod' route
    :<|> "self-service" :> "browser" :> "flows" :> "logout" :> Verb 'GET 200 '[JSON] () -- 'initializeSelfServiceBrowserLogoutFlow' route
    :<|> "self-service" :> "login" :> "api" :> QueryParam "refresh" Bool :> Verb 'GET 200 '[JSON] LoginFlow -- 'initializeSelfServiceLoginViaAPIFlow' route
    :<|> "self-service" :> "login" :> "browser" :> Verb 'GET 200 '[JSON] () -- 'initializeSelfServiceLoginViaBrowserFlow' route
    :<|> "self-service" :> "recovery" :> "api" :> Verb 'GET 200 '[JSON] RecoveryFlow -- 'initializeSelfServiceRecoveryViaAPIFlow' route
    :<|> "self-service" :> "recovery" :> "browser" :> Verb 'GET 200 '[JSON] () -- 'initializeSelfServiceRecoveryViaBrowserFlow' route
    :<|> "self-service" :> "registration" :> "api" :> Verb 'GET 200 '[JSON] RegistrationFlow -- 'initializeSelfServiceRegistrationViaAPIFlow' route
    :<|> "self-service" :> "registration" :> "browser" :> Verb 'GET 200 '[JSON] () -- 'initializeSelfServiceRegistrationViaBrowserFlow' route
    :<|> "self-service" :> "settings" :> "api" :> Verb 'GET 200 '[JSON] SettingsFlow -- 'initializeSelfServiceSettingsViaAPIFlow' route
    :<|> "self-service" :> "settings" :> "browser" :> Verb 'GET 200 '[JSON] () -- 'initializeSelfServiceSettingsViaBrowserFlow' route
    :<|> "self-service" :> "verification" :> "api" :> Verb 'GET 200 '[JSON] VerificationFlow -- 'initializeSelfServiceVerificationViaAPIFlow' route
    :<|> "self-service" :> "verification" :> "browser" :> Verb 'GET 200 '[JSON] () -- 'initializeSelfServiceVerificationViaBrowserFlow' route
    :<|> "sessions" :> ReqBody '[JSON] RevokeSession :> Verb 'DELETE 200 '[JSON] () -- 'revokeSession' route
    :<|> "sessions" :> "whoami" :> QueryParam "Authorization" Text :> Header "Cookie" Text :> Verb 'GET 200 '[JSON] Session -- 'whoami' route
    :<|> "version" :> Verb 'GET 200 '[JSON] Version -- 'getVersion' 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 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 = OryKratosBackend
  { -- | This endpoint creates an identity. It is NOT possible to set an identity's credentials (password, ...) using this method! A way to achieve that will be introduced in the future.  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 -> CreateIdentity -> m Identity
createIdentity :: CreateIdentity -> m Identity,
    -- | 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 -> CreateRecoveryLink -> m RecoveryLink
createRecoveryLink :: CreateRecoveryLink -> m RecoveryLink,
    -- | 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 -> Text -> m ()
deleteIdentity :: Text -> m (),
    -- | 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 -> Text -> m Identity
getIdentity :: Text -> m Identity,
    -- | Get a Traits Schema Definition
    OryKratosBackend m -> Text -> m Value
getSchema :: Text -> m Value,
    -- | This endpoint returns the error associated with a user-facing self service errors.  This endpoint supports stub values to help you implement the error UI:  `?error=stub:500` - returns a stub 500 (Internal Server Error) 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 -> Maybe Text -> m ErrorContainer
getSelfServiceError :: Maybe Text -> m ErrorContainer,
    -- | This endpoint returns a login flow's context with, for example, error details and other information.  More information can be found at [ORY Kratos User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m -> Maybe Text -> m LoginFlow
getSelfServiceLoginFlow :: Maybe Text -> m LoginFlow,
    -- | This endpoint returns a recovery flow's context with, for example, error details and other information.  More information can be found at [ORY Kratos Account Recovery Documentation](../self-service/flows/account-recovery.mdx).
    OryKratosBackend m -> Maybe Text -> m RecoveryFlow
getSelfServiceRecoveryFlow :: Maybe Text -> m RecoveryFlow,
    -- | This endpoint returns a registration flow's context with, for example, error details and other information.  More information can be found at [ORY Kratos User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m -> Maybe Text -> m RegistrationFlow
getSelfServiceRegistrationFlow :: Maybe Text -> m RegistrationFlow,
    -- | 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. The public endpoint does not return 404 status codes but instead 403 or 500 to improve data privacy.  You can access this endpoint without credentials when using ORY Kratos' Admin API.  More information can be found at [ORY Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m -> Maybe Text -> m SettingsFlow
getSelfServiceSettingsFlow :: Maybe Text -> m SettingsFlow,
    -- | This endpoint returns a verification flow's context with, for example, error details and other information.  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 -> Maybe Text -> m VerificationFlow
getSelfServiceVerificationFlow :: Maybe Text -> m VerificationFlow,
    -- | 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
-> Maybe Integer -> Maybe Integer -> m [Identity]
listIdentities :: Maybe Integer -> Maybe Integer -> m [Identity],
    -- | ``` metadata: annotations: prometheus.io/port: \"4434\" prometheus.io/path: \"/metrics/prometheus\" ```
    OryKratosBackend m -> m ()
prometheus :: m (),
    -- | This endpoint updates an identity. It is NOT possible to set an identity's credentials (password, ...) using this method! A way to achieve that will be introduced in the future.  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 -> Text -> UpdateIdentity -> m Identity
updateIdentity :: Text -> UpdateIdentity -> m Identity,
    -- | This endpoint returns a 200 status code when the HTTP server is up running. 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 -> m HealthStatus
isInstanceAlive :: m HealthStatus,
    -- | This endpoint returns a 200 status code when the HTTP server 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 this service, the health status will never refer to the cluster state, only to a single instance.
    OryKratosBackend m -> m HealthStatus
isInstanceReady :: m HealthStatus,
    -- | This endpoint completes a browser-based settings flow. This is usually achieved by POSTing data to this endpoint.  > This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...) and HTML Forms.  More information can be found at [ORY Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m -> m ()
completeSelfServiceBrowserSettingsOIDCSettingsFlow :: m (),
    -- | Use this endpoint to complete a login flow by sending an identity's identifier and password. 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 302 redirect to a fresh login flow if the original flow expired with the appropriate error messages set; HTTP 400 on form validation errors.  Browser flows expect `application/x-www-form-urlencoded` to be sent in the body and responds with a HTTP 302 redirect to the post/after login URL or the `return_to` value if it was set and if the login succeeded; a HTTP 302 redirect to the login UI URL with the flow ID containing the validation errors otherwise.  More information can be found at [ORY Kratos User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m
-> Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m LoginViaApiResponse
completeSelfServiceLoginFlowWithPasswordMethod :: Maybe Text -> CompleteSelfServiceLoginFlowWithPasswordMethod -> m LoginViaApiResponse,
    -- | Use this endpoint to complete a recovery flow using the link method. 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 it either returns a HTTP 200 OK when the form is valid and HTTP 400 OK when the form is invalid and a HTTP 302 Found redirect with a fresh recovery flow if the flow was otherwise invalid (e.g. expired). For Browser clients it returns a HTTP 302 Found redirect to the Recovery UI URL with the Recovery Flow ID appended. `sent_email` is the success state after `choose_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 302 Found 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 error message that the recovery link was invalid.  More information can be found at [ORY Kratos Account Recovery Documentation](../self-service/flows/account-recovery.mdx).
    OryKratosBackend m
-> Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m ()
completeSelfServiceRecoveryFlowWithLinkMethod :: Maybe Text -> Maybe Text -> CompleteSelfServiceRecoveryFlowWithLinkMethod -> m (),
    -- | 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 302 redirect to a fresh registration flow if the original flow expired with the appropriate error messages set; HTTP 400 on form validation errors.  Browser flows expect `application/x-www-form-urlencoded` to be sent in the body and responds with a HTTP 302 redirect to the post/after registration URL or the `return_to` value if it was set and if the registration succeeded; a HTTP 302 redirect to the registration UI URL with the flow ID containing the validation errors otherwise.  More information can be found at [ORY Kratos User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m
-> Maybe Text -> Value -> m RegistrationViaApiResponse
completeSelfServiceRegistrationFlowWithPasswordMethod :: Maybe Text -> Value -> m RegistrationViaApiResponse,
    -- | 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 302 redirect to a fresh settings flow if the original flow expired with the appropriate error messages set; HTTP 400 on form validation 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. Implies that the user needs to re-authenticate.  Browser flows expect `application/x-www-form-urlencoded` to be sent in the body and responds with a HTTP 302 redirect to the post/after settings URL or the `return_to` value if it was set and if the flow succeeded; a HTTP 302 redirect to the Settings UI URL with the flow ID containing the validation errors otherwise. a HTTP 302 redirect to the login endpoint when `selfservice.flows.settings.privileged_session_max_age` was reached.  More information can be found at [ORY Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m
-> Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m SettingsViaApiResponse
completeSelfServiceSettingsFlowWithPasswordMethod :: Maybe Text -> CompleteSelfServiceSettingsFlowWithPasswordMethod -> m SettingsViaApiResponse,
    -- | Use this endpoint to complete a settings flow by sending an identity's updated traits. 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 302 redirect to a fresh settings flow if the original flow expired with the appropriate error messages set; HTTP 400 on form validation 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 and a sensitive field was updated (e.g. recovery email). Implies that the user needs to re-authenticate.  Browser flows expect `application/x-www-form-urlencoded` to be sent in the body and responds with a HTTP 302 redirect to the post/after settings URL or the `return_to` value if it was set and if the flow succeeded; a HTTP 302 redirect to the settings UI URL with the flow ID containing the validation errors otherwise. a HTTP 302 redirect to the login endpoint when `selfservice.flows.settings.privileged_session_max_age` was reached.  More information can be found at [ORY Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m -> Maybe Text -> Value -> m SettingsFlow
completeSelfServiceSettingsFlowWithProfileMethod :: Maybe Text -> Value -> m SettingsFlow,
    -- | Use this endpoint to complete a verification flow using the link method. 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 it either returns a HTTP 200 OK when the form is valid and HTTP 400 OK when the form is invalid and a HTTP 302 Found redirect with a fresh verification flow if the flow was otherwise invalid (e.g. expired). For Browser clients it returns a HTTP 302 Found redirect to the Verification UI URL with the Verification Flow ID appended. `sent_email` is the success state after `choose_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 302 Found 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 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
-> Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m ()
completeSelfServiceVerificationFlowWithLinkMethod :: Maybe Text -> Maybe Text -> CompleteSelfServiceVerificationFlowWithLinkMethod -> m (),
    -- | This endpoint initializes a logout flow.  > This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...).  On successful logout, the browser will be redirected (HTTP 302 Found) to the `return_to` parameter of the initial request or fall back to `urls.default_return_to`.  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 -> m ()
initializeSelfServiceBrowserLogoutFlow :: m (),
    -- | This endpoint initiates a login 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 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>`.  :::warning  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.  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 and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m -> Maybe Bool -> m LoginFlow
initializeSelfServiceLoginViaAPIFlow :: Maybe Bool -> m LoginFlow,
    -- | This endpoint initializes a browser-based user login flow. Once initialized, the browser 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.  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...).  More information can be found at [ORY Kratos User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m -> m ()
initializeSelfServiceLoginViaBrowserFlow :: m (),
    -- | 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 error.  To fetch an existing recovery flow call `/self-service/recovery/flows?flow=<flow_id>`.  :::warning  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.mdx).
    OryKratosBackend m -> m RecoveryFlow
initializeSelfServiceRecoveryViaAPIFlow :: m RecoveryFlow,
    -- | 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.  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...).  More information can be found at [ORY Kratos Account Recovery Documentation](../self-service/flows/account-recovery.mdx).
    OryKratosBackend m -> m ()
initializeSelfServiceRecoveryViaBrowserFlow :: m (),
    -- | 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 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>`.  :::warning  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 User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m -> m RegistrationFlow
initializeSelfServiceRegistrationViaAPIFlow :: m RegistrationFlow,
    -- | This endpoint initializes a browser-based user registration flow. Once initialized, the browser 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` unless the query parameter `?refresh=true` was set.  :::note  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...).  :::  More information can be found at [ORY Kratos User Login and User Registration Documentation](https://www.ory.sh/docs/next/kratos/self-service/flows/user-login-user-registration).
    OryKratosBackend m -> m ()
initializeSelfServiceRegistrationViaBrowserFlow :: m (),
    -- | 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>`.  :::warning  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 User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m -> m SettingsFlow
initializeSelfServiceSettingsViaAPIFlow :: m SettingsFlow,
    -- | 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.  :::note  This endpoint is NOT INTENDED for API clients and only works with browsers (Chrome, Firefox, ...).  :::  More information can be found at [ORY Kratos User Settings & Profile Management Documentation](../self-service/flows/user-settings).
    OryKratosBackend m -> m ()
initializeSelfServiceSettingsViaBrowserFlow :: m (),
    -- | 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>`.  :::warning  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 -> m VerificationFlow
initializeSelfServiceVerificationViaAPIFlow :: m VerificationFlow,
    -- | 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=`.  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 -> m ()
initializeSelfServiceVerificationViaBrowserFlow :: m (),
    -- | Use this endpoint to revoke a session using its token. This endpoint is particularly useful for API clients such as mobile apps to log the user out of the system and invalidate the session.  This endpoint does not remove any HTTP Cookies - use the Self-Service Logout Flow instead.
    OryKratosBackend m -> RevokeSession -> m ()
revokeSession :: RevokeSession -> m (),
    -- | 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.  This endpoint is useful for reverse proxies and API Gateways.
    OryKratosBackend m -> Maybe Text -> Maybe Text -> m Session
whoami :: Maybe Text -> Maybe Text -> m Session,
    -- | This endpoint returns the service version typically notated using semantic versioning.  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 -> m Version
getVersion :: m Version
  }

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 :: OryKratosBackend OryKratosClient
createOryKratosClient :: OryKratosBackend OryKratosClient
createOryKratosClient = OryKratosBackend :: forall (m :: * -> *).
(CreateIdentity -> m Identity)
-> (CreateRecoveryLink -> m RecoveryLink)
-> (Text -> m ())
-> (Text -> m Identity)
-> (Text -> m Value)
-> (Maybe Text -> m ErrorContainer)
-> (Maybe Text -> m LoginFlow)
-> (Maybe Text -> m RecoveryFlow)
-> (Maybe Text -> m RegistrationFlow)
-> (Maybe Text -> m SettingsFlow)
-> (Maybe Text -> m VerificationFlow)
-> (Maybe Integer -> Maybe Integer -> m [Identity])
-> m ()
-> (Text -> UpdateIdentity -> m Identity)
-> m HealthStatus
-> m HealthStatus
-> m ()
-> (Maybe Text
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> m LoginViaApiResponse)
-> (Maybe Text
    -> Maybe Text
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> m ())
-> (Maybe Text -> Value -> m RegistrationViaApiResponse)
-> (Maybe Text
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> m SettingsViaApiResponse)
-> (Maybe Text -> Value -> m SettingsFlow)
-> (Maybe Text
    -> Maybe Text
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> m ())
-> m ()
-> (Maybe Bool -> m LoginFlow)
-> m ()
-> m RecoveryFlow
-> m ()
-> m RegistrationFlow
-> m ()
-> m SettingsFlow
-> m ()
-> m VerificationFlow
-> m ()
-> (RevokeSession -> m ())
-> (Maybe Text -> Maybe Text -> m Session)
-> m Version
-> OryKratosBackend m
OryKratosBackend {OryKratosClient ()
OryKratosClient Version
OryKratosClient HealthStatus
OryKratosClient VerificationFlow
OryKratosClient SettingsFlow
OryKratosClient RegistrationFlow
OryKratosClient RecoveryFlow
Maybe Bool -> OryKratosClient LoginFlow
Maybe Integer -> Maybe Integer -> OryKratosClient [Identity]
Maybe Text -> OryKratosClient ErrorContainer
Maybe Text -> OryKratosClient VerificationFlow
Maybe Text -> OryKratosClient SettingsFlow
Maybe Text -> OryKratosClient RegistrationFlow
Maybe Text -> OryKratosClient RecoveryFlow
Maybe Text -> OryKratosClient LoginFlow
Maybe Text -> Maybe Text -> OryKratosClient Session
Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> OryKratosClient ()
Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> OryKratosClient ()
Maybe Text -> Value -> OryKratosClient SettingsFlow
Maybe Text -> Value -> OryKratosClient RegistrationViaApiResponse
Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> OryKratosClient SettingsViaApiResponse
Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> OryKratosClient LoginViaApiResponse
Text -> OryKratosClient ()
Text -> OryKratosClient Value
Text -> OryKratosClient Identity
Text -> UpdateIdentity -> OryKratosClient Identity
RevokeSession -> OryKratosClient ()
CreateRecoveryLink -> OryKratosClient RecoveryLink
CreateIdentity -> OryKratosClient Identity
getVersion :: OryKratosClient Version
whoami :: Maybe Text -> Maybe Text -> OryKratosClient Session
revokeSession :: RevokeSession -> OryKratosClient ()
initializeSelfServiceVerificationViaBrowserFlow :: OryKratosClient ()
initializeSelfServiceVerificationViaAPIFlow :: OryKratosClient VerificationFlow
initializeSelfServiceSettingsViaBrowserFlow :: OryKratosClient ()
initializeSelfServiceSettingsViaAPIFlow :: OryKratosClient SettingsFlow
initializeSelfServiceRegistrationViaBrowserFlow :: OryKratosClient ()
initializeSelfServiceRegistrationViaAPIFlow :: OryKratosClient RegistrationFlow
initializeSelfServiceRecoveryViaBrowserFlow :: OryKratosClient ()
initializeSelfServiceRecoveryViaAPIFlow :: OryKratosClient RecoveryFlow
initializeSelfServiceLoginViaBrowserFlow :: OryKratosClient ()
initializeSelfServiceLoginViaAPIFlow :: Maybe Bool -> OryKratosClient LoginFlow
initializeSelfServiceBrowserLogoutFlow :: OryKratosClient ()
completeSelfServiceVerificationFlowWithLinkMethod :: Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> OryKratosClient ()
completeSelfServiceSettingsFlowWithProfileMethod :: Maybe Text -> Value -> OryKratosClient SettingsFlow
completeSelfServiceSettingsFlowWithPasswordMethod :: Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> OryKratosClient SettingsViaApiResponse
completeSelfServiceRegistrationFlowWithPasswordMethod :: Maybe Text -> Value -> OryKratosClient RegistrationViaApiResponse
completeSelfServiceRecoveryFlowWithLinkMethod :: Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> OryKratosClient ()
completeSelfServiceLoginFlowWithPasswordMethod :: Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> OryKratosClient LoginViaApiResponse
completeSelfServiceBrowserSettingsOIDCSettingsFlow :: OryKratosClient ()
isInstanceReady :: OryKratosClient HealthStatus
isInstanceAlive :: OryKratosClient HealthStatus
updateIdentity :: Text -> UpdateIdentity -> OryKratosClient Identity
prometheus :: OryKratosClient ()
listIdentities :: Maybe Integer -> Maybe Integer -> OryKratosClient [Identity]
getSelfServiceVerificationFlow :: Maybe Text -> OryKratosClient VerificationFlow
getSelfServiceSettingsFlow :: Maybe Text -> OryKratosClient SettingsFlow
getSelfServiceRegistrationFlow :: Maybe Text -> OryKratosClient RegistrationFlow
getSelfServiceRecoveryFlow :: Maybe Text -> OryKratosClient RecoveryFlow
getSelfServiceLoginFlow :: Maybe Text -> OryKratosClient LoginFlow
getSelfServiceError :: Maybe Text -> OryKratosClient ErrorContainer
getSchema :: Text -> OryKratosClient Value
getIdentity :: Text -> OryKratosClient Identity
deleteIdentity :: Text -> OryKratosClient ()
createRecoveryLink :: CreateRecoveryLink -> OryKratosClient RecoveryLink
createIdentity :: CreateIdentity -> OryKratosClient Identity
$sel:getVersion:OryKratosBackend :: OryKratosClient Version
$sel:whoami:OryKratosBackend :: Maybe Text -> Maybe Text -> OryKratosClient Session
$sel:revokeSession:OryKratosBackend :: RevokeSession -> OryKratosClient ()
$sel:initializeSelfServiceVerificationViaBrowserFlow:OryKratosBackend :: OryKratosClient ()
$sel:initializeSelfServiceVerificationViaAPIFlow:OryKratosBackend :: OryKratosClient VerificationFlow
$sel:initializeSelfServiceSettingsViaBrowserFlow:OryKratosBackend :: OryKratosClient ()
$sel:initializeSelfServiceSettingsViaAPIFlow:OryKratosBackend :: OryKratosClient SettingsFlow
$sel:initializeSelfServiceRegistrationViaBrowserFlow:OryKratosBackend :: OryKratosClient ()
$sel:initializeSelfServiceRegistrationViaAPIFlow:OryKratosBackend :: OryKratosClient RegistrationFlow
$sel:initializeSelfServiceRecoveryViaBrowserFlow:OryKratosBackend :: OryKratosClient ()
$sel:initializeSelfServiceRecoveryViaAPIFlow:OryKratosBackend :: OryKratosClient RecoveryFlow
$sel:initializeSelfServiceLoginViaBrowserFlow:OryKratosBackend :: OryKratosClient ()
$sel:initializeSelfServiceLoginViaAPIFlow:OryKratosBackend :: Maybe Bool -> OryKratosClient LoginFlow
$sel:initializeSelfServiceBrowserLogoutFlow:OryKratosBackend :: OryKratosClient ()
$sel:completeSelfServiceVerificationFlowWithLinkMethod:OryKratosBackend :: Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> OryKratosClient ()
$sel:completeSelfServiceSettingsFlowWithProfileMethod:OryKratosBackend :: Maybe Text -> Value -> OryKratosClient SettingsFlow
$sel:completeSelfServiceSettingsFlowWithPasswordMethod:OryKratosBackend :: Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> OryKratosClient SettingsViaApiResponse
$sel:completeSelfServiceRegistrationFlowWithPasswordMethod:OryKratosBackend :: Maybe Text -> Value -> OryKratosClient RegistrationViaApiResponse
$sel:completeSelfServiceRecoveryFlowWithLinkMethod:OryKratosBackend :: Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> OryKratosClient ()
$sel:completeSelfServiceLoginFlowWithPasswordMethod:OryKratosBackend :: Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> OryKratosClient LoginViaApiResponse
$sel:completeSelfServiceBrowserSettingsOIDCSettingsFlow:OryKratosBackend :: OryKratosClient ()
$sel:isInstanceReady:OryKratosBackend :: OryKratosClient HealthStatus
$sel:isInstanceAlive:OryKratosBackend :: OryKratosClient HealthStatus
$sel:updateIdentity:OryKratosBackend :: Text -> UpdateIdentity -> OryKratosClient Identity
$sel:prometheus:OryKratosBackend :: OryKratosClient ()
$sel:listIdentities:OryKratosBackend :: Maybe Integer -> Maybe Integer -> OryKratosClient [Identity]
$sel:getSelfServiceVerificationFlow:OryKratosBackend :: Maybe Text -> OryKratosClient VerificationFlow
$sel:getSelfServiceSettingsFlow:OryKratosBackend :: Maybe Text -> OryKratosClient SettingsFlow
$sel:getSelfServiceRegistrationFlow:OryKratosBackend :: Maybe Text -> OryKratosClient RegistrationFlow
$sel:getSelfServiceRecoveryFlow:OryKratosBackend :: Maybe Text -> OryKratosClient RecoveryFlow
$sel:getSelfServiceLoginFlow:OryKratosBackend :: Maybe Text -> OryKratosClient LoginFlow
$sel:getSelfServiceError:OryKratosBackend :: Maybe Text -> OryKratosClient ErrorContainer
$sel:getSchema:OryKratosBackend :: Text -> OryKratosClient Value
$sel:getIdentity:OryKratosBackend :: Text -> OryKratosClient Identity
$sel:deleteIdentity:OryKratosBackend :: Text -> OryKratosClient ()
$sel:createRecoveryLink:OryKratosBackend :: CreateRecoveryLink -> OryKratosClient RecoveryLink
$sel:createIdentity:OryKratosBackend :: CreateIdentity -> OryKratosClient Identity
..}
  where
    ( ((CreateIdentity -> ClientM Identity)
-> CreateIdentity -> OryKratosClient Identity
coerce -> CreateIdentity -> OryKratosClient Identity
createIdentity)
        :<|> ((CreateRecoveryLink -> ClientM RecoveryLink)
-> CreateRecoveryLink -> OryKratosClient RecoveryLink
coerce -> CreateRecoveryLink -> OryKratosClient RecoveryLink
createRecoveryLink)
        :<|> ((Text -> ClientM ()) -> Text -> OryKratosClient ()
coerce -> Text -> OryKratosClient ()
deleteIdentity)
        :<|> ((Text -> ClientM Identity) -> Text -> OryKratosClient Identity
coerce -> Text -> OryKratosClient Identity
getIdentity)
        :<|> ((Text -> ClientM Value) -> Text -> OryKratosClient Value
coerce -> Text -> OryKratosClient Value
getSchema)
        :<|> ((Maybe Text -> ClientM ErrorContainer)
-> Maybe Text -> OryKratosClient ErrorContainer
coerce -> Maybe Text -> OryKratosClient ErrorContainer
getSelfServiceError)
        :<|> ((Maybe Text -> ClientM LoginFlow)
-> Maybe Text -> OryKratosClient LoginFlow
coerce -> Maybe Text -> OryKratosClient LoginFlow
getSelfServiceLoginFlow)
        :<|> ((Maybe Text -> ClientM RecoveryFlow)
-> Maybe Text -> OryKratosClient RecoveryFlow
coerce -> Maybe Text -> OryKratosClient RecoveryFlow
getSelfServiceRecoveryFlow)
        :<|> ((Maybe Text -> ClientM RegistrationFlow)
-> Maybe Text -> OryKratosClient RegistrationFlow
coerce -> Maybe Text -> OryKratosClient RegistrationFlow
getSelfServiceRegistrationFlow)
        :<|> ((Maybe Text -> ClientM SettingsFlow)
-> Maybe Text -> OryKratosClient SettingsFlow
coerce -> Maybe Text -> OryKratosClient SettingsFlow
getSelfServiceSettingsFlow)
        :<|> ((Maybe Text -> ClientM VerificationFlow)
-> Maybe Text -> OryKratosClient VerificationFlow
coerce -> Maybe Text -> OryKratosClient VerificationFlow
getSelfServiceVerificationFlow)
        :<|> ((Maybe Integer -> Maybe Integer -> ClientM [Identity])
-> Maybe Integer -> Maybe Integer -> OryKratosClient [Identity]
coerce -> Maybe Integer -> Maybe Integer -> OryKratosClient [Identity]
listIdentities)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
prometheus)
        :<|> ((Text -> UpdateIdentity -> ClientM Identity)
-> Text -> UpdateIdentity -> OryKratosClient Identity
coerce -> Text -> UpdateIdentity -> OryKratosClient Identity
updateIdentity)
        :<|> (ClientM HealthStatus -> OryKratosClient HealthStatus
coerce -> OryKratosClient HealthStatus
isInstanceAlive)
        :<|> (ClientM HealthStatus -> OryKratosClient HealthStatus
coerce -> OryKratosClient HealthStatus
isInstanceReady)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
completeSelfServiceBrowserSettingsOIDCSettingsFlow)
        :<|> ((Maybe Text
 -> CompleteSelfServiceLoginFlowWithPasswordMethod
 -> ClientM LoginViaApiResponse)
-> Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> OryKratosClient LoginViaApiResponse
coerce -> Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> OryKratosClient LoginViaApiResponse
completeSelfServiceLoginFlowWithPasswordMethod)
        :<|> ((Maybe Text
 -> Maybe Text
 -> CompleteSelfServiceRecoveryFlowWithLinkMethod
 -> ClientM ())
-> Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> OryKratosClient ()
coerce -> Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> OryKratosClient ()
completeSelfServiceRecoveryFlowWithLinkMethod)
        :<|> ((Maybe Text -> Value -> ClientM RegistrationViaApiResponse)
-> Maybe Text
-> Value
-> OryKratosClient RegistrationViaApiResponse
coerce -> Maybe Text -> Value -> OryKratosClient RegistrationViaApiResponse
completeSelfServiceRegistrationFlowWithPasswordMethod)
        :<|> ((Maybe Text
 -> CompleteSelfServiceSettingsFlowWithPasswordMethod
 -> ClientM SettingsViaApiResponse)
-> Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> OryKratosClient SettingsViaApiResponse
coerce -> Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> OryKratosClient SettingsViaApiResponse
completeSelfServiceSettingsFlowWithPasswordMethod)
        :<|> ((Maybe Text -> Value -> ClientM SettingsFlow)
-> Maybe Text -> Value -> OryKratosClient SettingsFlow
coerce -> Maybe Text -> Value -> OryKratosClient SettingsFlow
completeSelfServiceSettingsFlowWithProfileMethod)
        :<|> ((Maybe Text
 -> Maybe Text
 -> CompleteSelfServiceVerificationFlowWithLinkMethod
 -> ClientM ())
-> Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> OryKratosClient ()
coerce -> Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> OryKratosClient ()
completeSelfServiceVerificationFlowWithLinkMethod)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
initializeSelfServiceBrowserLogoutFlow)
        :<|> ((Maybe Bool -> ClientM LoginFlow)
-> Maybe Bool -> OryKratosClient LoginFlow
coerce -> Maybe Bool -> OryKratosClient LoginFlow
initializeSelfServiceLoginViaAPIFlow)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
initializeSelfServiceLoginViaBrowserFlow)
        :<|> (ClientM RecoveryFlow -> OryKratosClient RecoveryFlow
coerce -> OryKratosClient RecoveryFlow
initializeSelfServiceRecoveryViaAPIFlow)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
initializeSelfServiceRecoveryViaBrowserFlow)
        :<|> (ClientM RegistrationFlow -> OryKratosClient RegistrationFlow
coerce -> OryKratosClient RegistrationFlow
initializeSelfServiceRegistrationViaAPIFlow)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
initializeSelfServiceRegistrationViaBrowserFlow)
        :<|> (ClientM SettingsFlow -> OryKratosClient SettingsFlow
coerce -> OryKratosClient SettingsFlow
initializeSelfServiceSettingsViaAPIFlow)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
initializeSelfServiceSettingsViaBrowserFlow)
        :<|> (ClientM VerificationFlow -> OryKratosClient VerificationFlow
coerce -> OryKratosClient VerificationFlow
initializeSelfServiceVerificationViaAPIFlow)
        :<|> (ClientM () -> OryKratosClient ()
coerce -> OryKratosClient ()
initializeSelfServiceVerificationViaBrowserFlow)
        :<|> ((RevokeSession -> ClientM ())
-> RevokeSession -> OryKratosClient ()
coerce -> RevokeSession -> OryKratosClient ()
revokeSession)
        :<|> ((Maybe Text -> Maybe Text -> ClientM Session)
-> Maybe Text -> Maybe Text -> OryKratosClient Session
coerce -> Maybe Text -> Maybe Text -> OryKratosClient Session
whoami)
        :<|> (ClientM Version -> OryKratosClient Version
coerce -> OryKratosClient Version
getVersion)
        :<|> ByteString -> ClientM Response
_
      ) = Proxy OryKratosAPI -> Client ClientM OryKratosAPI
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy OryKratosAPI
forall k (t :: k). Proxy t
Proxy :: Proxy OryKratosAPI)

-- | 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) =>
  Config ->
  OryKratosBackend (ExceptT ServerError IO) ->
  m ()
runOryKratosServer :: Config -> OryKratosBackend (ExceptT ServerError IO) -> m ()
runOryKratosServer Config
config =
  Config
-> (Application -> Application)
-> OryKratosBackend (ExceptT ServerError IO)
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Config
-> (Application -> Application)
-> OryKratosBackend (ExceptT ServerError IO)
-> m ()
runOryKratosMiddlewareServer Config
config Application -> Application
requestMiddlewareId

-- | Run the OryKratos server at the provided host and port.
runOryKratosMiddlewareServer ::
  (MonadIO m, MonadThrow m) =>
  Config ->
  Middleware ->
  OryKratosBackend (ExceptT ServerError IO) ->
  m ()
runOryKratosMiddlewareServer :: Config
-> (Application -> Application)
-> OryKratosBackend (ExceptT ServerError IO)
-> m ()
runOryKratosMiddlewareServer Config {[Char]
configUrl :: [Char]
$sel:configUrl:Config :: Config -> [Char]
..} Application -> Application
middleware OryKratosBackend (ExceptT ServerError IO)
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
$ Proxy OryKratosAPI -> Server OryKratosAPI -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy OryKratosAPI
forall k (t :: k). Proxy t
Proxy :: Proxy OryKratosAPI) (OryKratosBackend (ExceptT ServerError IO)
-> (CreateIdentity -> Handler Identity)
   :<|> ((CreateRecoveryLink -> Handler RecoveryLink)
         :<|> ((Text -> Handler ())
               :<|> ((Text -> Handler Identity)
                     :<|> ((Text -> Handler Value)
                           :<|> ((Maybe Text -> Handler ErrorContainer)
                                 :<|> ((Maybe Text -> Handler LoginFlow)
                                       :<|> ((Maybe Text -> Handler RecoveryFlow)
                                             :<|> ((Maybe Text -> Handler RegistrationFlow)
                                                   :<|> ((Maybe Text -> Handler SettingsFlow)
                                                         :<|> ((Maybe Text
                                                                -> Handler VerificationFlow)
                                                               :<|> ((Maybe Integer
                                                                      -> Maybe Integer
                                                                      -> Handler [Identity])
                                                                     :<|> (Handler ()
                                                                           :<|> ((Text
                                                                                  -> UpdateIdentity
                                                                                  -> Handler
                                                                                       Identity)
                                                                                 :<|> (Handler
                                                                                         HealthStatus
                                                                                       :<|> (Handler
                                                                                               HealthStatus
                                                                                             :<|> (Handler
                                                                                                     ()
                                                                                                   :<|> ((Maybe
                                                                                                            Text
                                                                                                          -> CompleteSelfServiceLoginFlowWithPasswordMethod
                                                                                                          -> Handler
                                                                                                               LoginViaApiResponse)
                                                                                                         :<|> ((Maybe
                                                                                                                  Text
                                                                                                                -> Maybe
                                                                                                                     Text
                                                                                                                -> CompleteSelfServiceRecoveryFlowWithLinkMethod
                                                                                                                -> Handler
                                                                                                                     ())
                                                                                                               :<|> ((Maybe
                                                                                                                        Text
                                                                                                                      -> Value
                                                                                                                      -> Handler
                                                                                                                           RegistrationViaApiResponse)
                                                                                                                     :<|> ((Maybe
                                                                                                                              Text
                                                                                                                            -> CompleteSelfServiceSettingsFlowWithPasswordMethod
                                                                                                                            -> Handler
                                                                                                                                 SettingsViaApiResponse)
                                                                                                                           :<|> ((Maybe
                                                                                                                                    Text
                                                                                                                                  -> Value
                                                                                                                                  -> Handler
                                                                                                                                       SettingsFlow)
                                                                                                                                 :<|> ((Maybe
                                                                                                                                          Text
                                                                                                                                        -> Maybe
                                                                                                                                             Text
                                                                                                                                        -> CompleteSelfServiceVerificationFlowWithLinkMethod
                                                                                                                                        -> Handler
                                                                                                                                             ())
                                                                                                                                       :<|> (Handler
                                                                                                                                               ()
                                                                                                                                             :<|> ((Maybe
                                                                                                                                                      Bool
                                                                                                                                                    -> Handler
                                                                                                                                                         LoginFlow)
                                                                                                                                                   :<|> (Handler
                                                                                                                                                           ()
                                                                                                                                                         :<|> (Handler
                                                                                                                                                                 RecoveryFlow
                                                                                                                                                               :<|> (Handler
                                                                                                                                                                       ()
                                                                                                                                                                     :<|> (Handler
                                                                                                                                                                             RegistrationFlow
                                                                                                                                                                           :<|> (Handler
                                                                                                                                                                                   ()
                                                                                                                                                                                 :<|> (Handler
                                                                                                                                                                                         SettingsFlow
                                                                                                                                                                                       :<|> (Handler
                                                                                                                                                                                               ()
                                                                                                                                                                                             :<|> (Handler
                                                                                                                                                                                                     VerificationFlow
                                                                                                                                                                                                   :<|> (Handler
                                                                                                                                                                                                           ()
                                                                                                                                                                                                         :<|> ((RevokeSession
                                                                                                                                                                                                                -> Handler
                                                                                                                                                                                                                     ())
                                                                                                                                                                                                               :<|> ((Maybe
                                                                                                                                                                                                                        Text
                                                                                                                                                                                                                      -> Maybe
                                                                                                                                                                                                                           Text
                                                                                                                                                                                                                      -> Handler
                                                                                                                                                                                                                           Session)
                                                                                                                                                                                                                     :<|> (Handler
                                                                                                                                                                                                                             Version
                                                                                                                                                                                                                           :<|> Tagged
                                                                                                                                                                                                                                  Handler
                                                                                                                                                                                                                                  Application))))))))))))))))))))))))))))))))))))
forall a (m :: * -> *) a a a a a a a a a a a a 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 (CreateIdentity -> m Identity),
 Coercible a (CreateRecoveryLink -> m RecoveryLink),
 Coercible a (Text -> m ()), Coercible a (Text -> m Identity),
 Coercible a (Text -> m Value),
 Coercible a (Maybe Text -> m ErrorContainer),
 Coercible a (Maybe Text -> m LoginFlow),
 Coercible a (Maybe Text -> m RecoveryFlow),
 Coercible a (Maybe Text -> m RegistrationFlow),
 Coercible a (Maybe Text -> m SettingsFlow),
 Coercible a (Maybe Text -> m VerificationFlow),
 Coercible a (Maybe Integer -> Maybe Integer -> m [Identity]),
 Coercible a (m ()),
 Coercible a (Text -> UpdateIdentity -> m Identity),
 Coercible a (m HealthStatus), Coercible a (m HealthStatus),
 Coercible a (m ()),
 Coercible
   a
   (Maybe Text
    -> CompleteSelfServiceLoginFlowWithPasswordMethod
    -> m LoginViaApiResponse),
 Coercible
   a
   (Maybe Text
    -> Maybe Text
    -> CompleteSelfServiceRecoveryFlowWithLinkMethod
    -> m ()),
 Coercible a (Maybe Text -> Value -> m RegistrationViaApiResponse),
 Coercible
   a
   (Maybe Text
    -> CompleteSelfServiceSettingsFlowWithPasswordMethod
    -> m SettingsViaApiResponse),
 Coercible a (Maybe Text -> Value -> m SettingsFlow),
 Coercible
   a
   (Maybe Text
    -> Maybe Text
    -> CompleteSelfServiceVerificationFlowWithLinkMethod
    -> m ()),
 Coercible a (m ()), Coercible a (Maybe Bool -> m LoginFlow),
 Coercible a (m ()), Coercible a (m RecoveryFlow),
 Coercible a (m ()), Coercible a (m RegistrationFlow),
 Coercible a (m ()), Coercible a (m SettingsFlow),
 Coercible a (m ()), Coercible a (m VerificationFlow),
 Coercible a (m ()), Coercible a (RevokeSession -> m ()),
 Coercible a (Maybe Text -> Maybe Text -> m Session),
 Coercible a (m Version)) =>
OryKratosBackend m
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (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)
backend)
  where
    serverFromBackend :: OryKratosBackend m
-> a
   :<|> (a
         :<|> (a
               :<|> (a
                     :<|> (a
                           :<|> (a
                                 :<|> (a
                                       :<|> (a
                                             :<|> (a
                                                   :<|> (a
                                                         :<|> (a
                                                               :<|> (a
                                                                     :<|> (a
                                                                           :<|> (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 ()
m Version
m HealthStatus
m VerificationFlow
m SettingsFlow
m RegistrationFlow
m RecoveryFlow
Maybe Bool -> m LoginFlow
Maybe Integer -> Maybe Integer -> m [Identity]
Maybe Text -> m ErrorContainer
Maybe Text -> m VerificationFlow
Maybe Text -> m SettingsFlow
Maybe Text -> m RegistrationFlow
Maybe Text -> m RecoveryFlow
Maybe Text -> m LoginFlow
Maybe Text -> Maybe Text -> m Session
Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m ()
Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m ()
Maybe Text -> Value -> m SettingsFlow
Maybe Text -> Value -> m RegistrationViaApiResponse
Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m SettingsViaApiResponse
Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m LoginViaApiResponse
Text -> m ()
Text -> m Value
Text -> m Identity
Text -> UpdateIdentity -> m Identity
RevokeSession -> m ()
CreateRecoveryLink -> m RecoveryLink
CreateIdentity -> m Identity
getVersion :: m Version
whoami :: Maybe Text -> Maybe Text -> m Session
revokeSession :: RevokeSession -> m ()
initializeSelfServiceVerificationViaBrowserFlow :: m ()
initializeSelfServiceVerificationViaAPIFlow :: m VerificationFlow
initializeSelfServiceSettingsViaBrowserFlow :: m ()
initializeSelfServiceSettingsViaAPIFlow :: m SettingsFlow
initializeSelfServiceRegistrationViaBrowserFlow :: m ()
initializeSelfServiceRegistrationViaAPIFlow :: m RegistrationFlow
initializeSelfServiceRecoveryViaBrowserFlow :: m ()
initializeSelfServiceRecoveryViaAPIFlow :: m RecoveryFlow
initializeSelfServiceLoginViaBrowserFlow :: m ()
initializeSelfServiceLoginViaAPIFlow :: Maybe Bool -> m LoginFlow
initializeSelfServiceBrowserLogoutFlow :: m ()
completeSelfServiceVerificationFlowWithLinkMethod :: Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m ()
completeSelfServiceSettingsFlowWithProfileMethod :: Maybe Text -> Value -> m SettingsFlow
completeSelfServiceSettingsFlowWithPasswordMethod :: Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m SettingsViaApiResponse
completeSelfServiceRegistrationFlowWithPasswordMethod :: Maybe Text -> Value -> m RegistrationViaApiResponse
completeSelfServiceRecoveryFlowWithLinkMethod :: Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m ()
completeSelfServiceLoginFlowWithPasswordMethod :: Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m LoginViaApiResponse
completeSelfServiceBrowserSettingsOIDCSettingsFlow :: m ()
isInstanceReady :: m HealthStatus
isInstanceAlive :: m HealthStatus
updateIdentity :: Text -> UpdateIdentity -> m Identity
prometheus :: m ()
listIdentities :: Maybe Integer -> Maybe Integer -> m [Identity]
getSelfServiceVerificationFlow :: Maybe Text -> m VerificationFlow
getSelfServiceSettingsFlow :: Maybe Text -> m SettingsFlow
getSelfServiceRegistrationFlow :: Maybe Text -> m RegistrationFlow
getSelfServiceRecoveryFlow :: Maybe Text -> m RecoveryFlow
getSelfServiceLoginFlow :: Maybe Text -> m LoginFlow
getSelfServiceError :: Maybe Text -> m ErrorContainer
getSchema :: Text -> m Value
getIdentity :: Text -> m Identity
deleteIdentity :: Text -> m ()
createRecoveryLink :: CreateRecoveryLink -> m RecoveryLink
createIdentity :: CreateIdentity -> m Identity
$sel:getVersion:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m Version
$sel:whoami:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> Maybe Text -> m Session
$sel:revokeSession:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> RevokeSession -> m ()
$sel:initializeSelfServiceVerificationViaBrowserFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:initializeSelfServiceVerificationViaAPIFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m VerificationFlow
$sel:initializeSelfServiceSettingsViaBrowserFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:initializeSelfServiceSettingsViaAPIFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m SettingsFlow
$sel:initializeSelfServiceRegistrationViaBrowserFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:initializeSelfServiceRegistrationViaAPIFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m RegistrationFlow
$sel:initializeSelfServiceRecoveryViaBrowserFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:initializeSelfServiceRecoveryViaAPIFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m RecoveryFlow
$sel:initializeSelfServiceLoginViaBrowserFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:initializeSelfServiceLoginViaAPIFlow:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Bool -> m LoginFlow
$sel:initializeSelfServiceBrowserLogoutFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:completeSelfServiceVerificationFlowWithLinkMethod:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m
-> Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m ()
$sel:completeSelfServiceSettingsFlowWithProfileMethod:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> Value -> m SettingsFlow
$sel:completeSelfServiceSettingsFlowWithPasswordMethod:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m
-> Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m SettingsViaApiResponse
$sel:completeSelfServiceRegistrationFlowWithPasswordMethod:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m
-> Maybe Text -> Value -> m RegistrationViaApiResponse
$sel:completeSelfServiceRecoveryFlowWithLinkMethod:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m
-> Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m ()
$sel:completeSelfServiceLoginFlowWithPasswordMethod:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m
-> Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m LoginViaApiResponse
$sel:completeSelfServiceBrowserSettingsOIDCSettingsFlow:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:isInstanceReady:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m HealthStatus
$sel:isInstanceAlive:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m HealthStatus
$sel:updateIdentity:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Text -> UpdateIdentity -> m Identity
$sel:prometheus:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> m ()
$sel:listIdentities:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m
-> Maybe Integer -> Maybe Integer -> m [Identity]
$sel:getSelfServiceVerificationFlow:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> m VerificationFlow
$sel:getSelfServiceSettingsFlow:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> m SettingsFlow
$sel:getSelfServiceRegistrationFlow:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> m RegistrationFlow
$sel:getSelfServiceRecoveryFlow:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> m RecoveryFlow
$sel:getSelfServiceLoginFlow:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> m LoginFlow
$sel:getSelfServiceError:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> Maybe Text -> m ErrorContainer
$sel:getSchema:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> Text -> m Value
$sel:getIdentity:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> Text -> m Identity
$sel:deleteIdentity:OryKratosBackend :: forall (m :: * -> *). OryKratosBackend m -> Text -> m ()
$sel:createRecoveryLink:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> CreateRecoveryLink -> m RecoveryLink
$sel:createIdentity:OryKratosBackend :: forall (m :: * -> *).
OryKratosBackend m -> CreateIdentity -> m Identity
..} =
       (CreateIdentity -> m Identity) -> a
coerce CreateIdentity -> m Identity
createIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (a
                                                                      :<|> (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
:<|> (CreateRecoveryLink -> m RecoveryLink) -> a
coerce CreateRecoveryLink -> m RecoveryLink
createRecoveryLink
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (a
                                                                :<|> (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 -> m ()) -> a
coerce Text -> m ()
deleteIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (a
                                                          :<|> (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
:<|> (Text -> m Identity) -> a
coerce Text -> m Identity
getIdentity
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (a
                                                    :<|> (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 -> m Value) -> a
coerce Text -> m Value
getSchema
          a
-> (a
    :<|> (a
          :<|> (a
                :<|> (a
                      :<|> (a
                            :<|> (a
                                  :<|> (a
                                        :<|> (a
                                              :<|> (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
:<|> (Maybe Text -> m ErrorContainer) -> a
coerce Maybe Text -> m ErrorContainer
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
                                                                                                                                                                      :<|> (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 LoginFlow) -> a
coerce Maybe Text -> m LoginFlow
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
                                                                                                                                                                :<|> (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
:<|> (Maybe Text -> m RecoveryFlow) -> a
coerce Maybe Text -> m RecoveryFlow
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
                                                                                                                                                          :<|> (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 RegistrationFlow) -> a
coerce Maybe Text -> m RegistrationFlow
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
                                                                                                                                                    :<|> (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 -> m SettingsFlow) -> a
coerce Maybe Text -> m SettingsFlow
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
                                                                                                                                              :<|> (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 -> m VerificationFlow) -> a
coerce Maybe Text -> m VerificationFlow
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
                                                                                                                                        :<|> (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 Integer -> Maybe Integer -> m [Identity]) -> a
coerce Maybe Integer -> Maybe Integer -> m [Identity]
listIdentities
          a
-> (a
    :<|> (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
:<|> m () -> a
coerce m ()
prometheus
          a
-> (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
:<|> (Text -> UpdateIdentity -> m Identity) -> a
coerce Text -> UpdateIdentity -> m Identity
updateIdentity
          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 HealthStatus -> a
coerce m HealthStatus
isInstanceAlive
          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
:<|> m HealthStatus -> a
coerce m HealthStatus
isInstanceReady
          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
:<|> m () -> a
coerce m ()
completeSelfServiceBrowserSettingsOIDCSettingsFlow
          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
 -> CompleteSelfServiceLoginFlowWithPasswordMethod
 -> m LoginViaApiResponse)
-> a
coerce Maybe Text
-> CompleteSelfServiceLoginFlowWithPasswordMethod
-> m LoginViaApiResponse
completeSelfServiceLoginFlowWithPasswordMethod
          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
:<|> (Maybe Text
 -> Maybe Text
 -> CompleteSelfServiceRecoveryFlowWithLinkMethod
 -> m ())
-> a
coerce Maybe Text
-> Maybe Text
-> CompleteSelfServiceRecoveryFlowWithLinkMethod
-> m ()
completeSelfServiceRecoveryFlowWithLinkMethod
          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 -> Value -> m RegistrationViaApiResponse) -> a
coerce Maybe Text -> Value -> m RegistrationViaApiResponse
completeSelfServiceRegistrationFlowWithPasswordMethod
          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
:<|> (Maybe Text
 -> CompleteSelfServiceSettingsFlowWithPasswordMethod
 -> m SettingsViaApiResponse)
-> a
coerce Maybe Text
-> CompleteSelfServiceSettingsFlowWithPasswordMethod
-> m SettingsViaApiResponse
completeSelfServiceSettingsFlowWithPasswordMethod
          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 -> Value -> m SettingsFlow) -> a
coerce Maybe Text -> Value -> m SettingsFlow
completeSelfServiceSettingsFlowWithProfileMethod
          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
 -> Maybe Text
 -> CompleteSelfServiceVerificationFlowWithLinkMethod
 -> m ())
-> a
coerce Maybe Text
-> Maybe Text
-> CompleteSelfServiceVerificationFlowWithLinkMethod
-> m ()
completeSelfServiceVerificationFlowWithLinkMethod
          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
:<|> m () -> a
coerce m ()
initializeSelfServiceBrowserLogoutFlow
          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
:<|> (Maybe Bool -> m LoginFlow) -> a
coerce Maybe Bool -> m LoginFlow
initializeSelfServiceLoginViaAPIFlow
          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
:<|> m () -> a
coerce m ()
initializeSelfServiceLoginViaBrowserFlow
          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
:<|> m RecoveryFlow -> a
coerce m RecoveryFlow
initializeSelfServiceRecoveryViaAPIFlow
          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
:<|> m () -> a
coerce m ()
initializeSelfServiceRecoveryViaBrowserFlow
          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
:<|> m RegistrationFlow -> a
coerce m RegistrationFlow
initializeSelfServiceRegistrationViaAPIFlow
          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
:<|> m () -> a
coerce m ()
initializeSelfServiceRegistrationViaBrowserFlow
          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
:<|> m SettingsFlow -> a
coerce m SettingsFlow
initializeSelfServiceSettingsViaAPIFlow
          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
:<|> m () -> a
coerce m ()
initializeSelfServiceSettingsViaBrowserFlow
          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
:<|> m VerificationFlow -> a
coerce m VerificationFlow
initializeSelfServiceVerificationViaAPIFlow
          a
-> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))
-> a :<|> (a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application))))
forall a b. a -> b -> a :<|> b
:<|> m () -> a
coerce m ()
initializeSelfServiceVerificationViaBrowserFlow
          a
-> (a :<|> (a :<|> (a :<|> Tagged m Application)))
-> a :<|> (a :<|> (a :<|> (a :<|> Tagged m Application)))
forall a b. a -> b -> a :<|> b
:<|> (RevokeSession -> m ()) -> a
coerce RevokeSession -> m ()
revokeSession
          a
-> (a :<|> (a :<|> Tagged m Application))
-> a :<|> (a :<|> (a :<|> Tagged m Application))
forall a b. a -> b -> a :<|> b
:<|> (Maybe Text -> Maybe Text -> m Session) -> a
coerce Maybe Text -> Maybe Text -> m Session
whoami
          a
-> (a :<|> Tagged m Application)
-> a :<|> (a :<|> Tagged m Application)
forall a b. a -> b -> a :<|> b
:<|> m Version -> a
coerce m Version
getVersion
          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"