module Wire.API.Error
(
DynError (..),
dynError,
dynErrorToWai,
StaticError (..),
KnownError,
MapError,
errorToResponse,
errorToWai,
APIError (..),
CanThrow,
CanThrowMany,
DeclaredErrorEffects,
addErrorResponseToSwagger,
addStaticErrorToSwagger,
IsSwaggerError (..),
ErrorResponse,
ErrorEffect,
ErrorS,
throwS,
noteS,
mapErrorS,
runErrorS,
mapToRuntimeError,
mapToDynamicError,
)
where
import Control.Error (hush)
import Control.Lens (at, (%~), (.~), (?~))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as A
import Data.HashMap.Strict.InsOrd
import Data.Kind
import Data.Metrics.Servant
import Data.OpenApi qualified as S
import Data.Proxy
import Data.SOP
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LT
import GHC.TypeLits
import Imports hiding (All)
import Network.HTTP.Types.Status qualified as HTTP
import Network.Wai.Utilities.Error qualified as Wai
import Network.Wai.Utilities.JSONResponse
import Polysemy
import Polysemy.Error
import Servant
import Servant.Client (HasClient (Client))
import Servant.Client.Core.HasClient (hoistClientMonad)
import Servant.Client.Streaming (HasClient (clientWithRoute))
import Servant.OpenApi
import Wire.API.Routes.MultiVerb
import Wire.API.Routes.Named (Named)
import Wire.API.Routes.Version
data DynError = DynError
{ DynError -> Natural
eCode :: Natural,
DynError -> Text
eLabel :: Text,
DynError -> Text
eMessage :: Text
}
dynErrorToWai :: DynError -> Wai.Error
dynErrorToWai :: DynError -> Error
dynErrorToWai (DynError Natural
c Text
l Text
m) =
Status -> LText -> LText -> Error
Wai.mkError (HttpStatusCode -> Status
forall a. Enum a => HttpStatusCode -> a
toEnum (Natural -> HttpStatusCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c)) (Text -> LText
LT.fromStrict Text
l) (Text -> LText
LT.fromStrict Text
m)
instance ToJSON DynError where
toJSON :: DynError -> Value
toJSON = (.value) (JSONResponse -> Value)
-> (DynError -> JSONResponse) -> DynError -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynError -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse
dynErrorFromWai :: Wai.Error -> DynError
dynErrorFromWai :: Error -> DynError
dynErrorFromWai =
Natural -> Text -> Text -> DynError
DynError
(Natural -> Text -> Text -> DynError)
-> (Error -> Natural) -> Error -> Text -> Text -> DynError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HttpStatusCode -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HttpStatusCode -> Natural)
-> (Error -> HttpStatusCode) -> Error -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> HttpStatusCode
HTTP.statusCode (Status -> HttpStatusCode)
-> (Error -> Status) -> Error -> HttpStatusCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Status
Wai.code
(Error -> Text -> Text -> DynError)
-> (Error -> Text) -> Error -> Text -> DynError
forall a b. (Error -> a -> b) -> (Error -> a) -> Error -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LText -> Text
LT.toStrict (LText -> Text) -> (Error -> LText) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> LText
Wai.label
(Error -> Text -> DynError) -> (Error -> Text) -> Error -> DynError
forall a b. (Error -> a -> b) -> (Error -> a) -> Error -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LText -> Text
LT.toStrict (LText -> Text) -> (Error -> LText) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> LText
Wai.message
instance FromJSON DynError where
parseJSON :: Value -> Parser DynError
parseJSON = (Error -> DynError) -> Parser Error -> Parser DynError
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Error -> DynError
dynErrorFromWai (Parser Error -> Parser DynError)
-> (Value -> Parser Error) -> Value -> Parser DynError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Error
forall a. FromJSON a => Value -> Parser a
parseJSON
data StaticError = StaticError
{ StaticError -> Natural
seCode :: Nat,
StaticError -> Symbol
seLabel :: Symbol,
StaticError -> Symbol
seMessage :: Symbol
}
data SStaticError e where
SStaticError ::
(KnownNat c, KnownSymbol l, KnownSymbol msg) =>
Proxy c ->
Proxy l ->
Proxy msg ->
SStaticError ('StaticError c l msg)
deriving (Value -> Parser [SStaticError e]
Value -> Parser (SStaticError e)
(Value -> Parser (SStaticError e))
-> (Value -> Parser [SStaticError e]) -> FromJSON (SStaticError e)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (e :: StaticError).
KnownError e =>
Value -> Parser [SStaticError e]
forall (e :: StaticError).
KnownError e =>
Value -> Parser (SStaticError e)
$cparseJSON :: forall (e :: StaticError).
KnownError e =>
Value -> Parser (SStaticError e)
parseJSON :: Value -> Parser (SStaticError e)
$cparseJSONList :: forall (e :: StaticError).
KnownError e =>
Value -> Parser [SStaticError e]
parseJSONList :: Value -> Parser [SStaticError e]
A.FromJSON, [SStaticError e] -> Value
[SStaticError e] -> Encoding
SStaticError e -> Value
SStaticError e -> Encoding
(SStaticError e -> Value)
-> (SStaticError e -> Encoding)
-> ([SStaticError e] -> Value)
-> ([SStaticError e] -> Encoding)
-> ToJSON (SStaticError e)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (e :: StaticError).
KnownError e =>
[SStaticError e] -> Value
forall (e :: StaticError).
KnownError e =>
[SStaticError e] -> Encoding
forall (e :: StaticError). KnownError e => SStaticError e -> Value
forall (e :: StaticError).
KnownError e =>
SStaticError e -> Encoding
$ctoJSON :: forall (e :: StaticError). KnownError e => SStaticError e -> Value
toJSON :: SStaticError e -> Value
$ctoEncoding :: forall (e :: StaticError).
KnownError e =>
SStaticError e -> Encoding
toEncoding :: SStaticError e -> Encoding
$ctoJSONList :: forall (e :: StaticError).
KnownError e =>
[SStaticError e] -> Value
toJSONList :: [SStaticError e] -> Value
$ctoEncodingList :: forall (e :: StaticError).
KnownError e =>
[SStaticError e] -> Encoding
toEncodingList :: [SStaticError e] -> Encoding
A.ToJSON, Typeable (SStaticError e)
Typeable (SStaticError e) =>
(Proxy (SStaticError e)
-> Declare (Definitions Schema) NamedSchema)
-> ToSchema (SStaticError e)
Proxy (SStaticError e) -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
forall (e :: StaticError).
(Typeable e, KnownError e) =>
Typeable (SStaticError e)
forall (e :: StaticError).
(Typeable e, KnownError e) =>
Proxy (SStaticError e) -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall (e :: StaticError).
(Typeable e, KnownError e) =>
Proxy (SStaticError e) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (SStaticError e) -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema (SStaticError e)
class KnownError (e :: StaticError) where
seSing :: SStaticError e
instance (KnownNat c, KnownSymbol l, KnownSymbol msg) => KnownError ('StaticError c l msg) where
seSing :: SStaticError ('StaticError c l msg)
seSing = Proxy c
-> Proxy l -> Proxy msg -> SStaticError ('StaticError c l msg)
forall (c :: Natural) (l :: Symbol) (msg :: Symbol).
(KnownNat c, KnownSymbol l, KnownSymbol msg) =>
Proxy c
-> Proxy l -> Proxy msg -> SStaticError ('StaticError c l msg)
SStaticError Proxy c
forall {k} (t :: k). Proxy t
Proxy Proxy l
forall {k} (t :: k). Proxy t
Proxy Proxy msg
forall {k} (t :: k). Proxy t
Proxy
dynError' :: SStaticError e -> DynError
dynError' :: forall (e :: StaticError). SStaticError e -> DynError
dynError' (SStaticError Proxy c
c Proxy l
l Proxy msg
msg) = Proxy c -> Proxy l -> Proxy msg -> DynError
forall (c :: Natural) (l :: Symbol) (msg :: Symbol).
(KnownNat c, KnownSymbol l, KnownSymbol msg) =>
Proxy c -> Proxy l -> Proxy msg -> DynError
mkDynError Proxy c
c Proxy l
l Proxy msg
msg
mkDynError ::
(KnownNat c, KnownSymbol l, KnownSymbol msg) =>
Proxy c ->
Proxy l ->
Proxy msg ->
DynError
mkDynError :: forall (c :: Natural) (l :: Symbol) (msg :: Symbol).
(KnownNat c, KnownSymbol l, KnownSymbol msg) =>
Proxy c -> Proxy l -> Proxy msg -> DynError
mkDynError Proxy c
c Proxy l
l Proxy msg
msg =
Natural -> Text -> Text -> DynError
DynError
(HttpStatusCode -> Natural
forall a. Enum a => HttpStatusCode -> a
toEnum (Integer -> HttpStatusCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy c -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy c
c)))
(String -> Text
Text.pack (Proxy l -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy l
l))
(String -> Text
Text.pack (Proxy msg -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy msg
msg))
dynError :: forall e. (KnownError e) => DynError
dynError :: forall (e :: StaticError). KnownError e => DynError
dynError = SStaticError e -> DynError
forall (e :: StaticError). SStaticError e -> DynError
dynError' (SStaticError e -> DynError) -> SStaticError e -> DynError
forall a b. (a -> b) -> a -> b
$ forall (e :: StaticError). KnownError e => SStaticError e
seSing @e
staticErrorSchema :: SStaticError e -> ValueSchema NamedSwaggerDoc (SStaticError e)
staticErrorSchema :: forall (e :: StaticError).
SStaticError e -> ValueSchema NamedSwaggerDoc (SStaticError e)
staticErrorSchema e :: SStaticError e
e@(SStaticError Proxy c
c Proxy l
l Proxy msg
m) =
Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc (SStaticError e)
-> ValueSchema NamedSwaggerDoc (SStaticError e)
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier Text
"Error" NamedSwaggerDoc -> NamedSwaggerDoc
addExample (ObjectSchema SwaggerDoc (SStaticError e)
-> ValueSchema NamedSwaggerDoc (SStaticError e))
-> ObjectSchema SwaggerDoc (SStaticError e)
-> ValueSchema NamedSwaggerDoc (SStaticError e)
forall a b. (a -> b) -> a -> b
$
Proxy c -> Proxy l -> Proxy msg -> SStaticError e
Proxy c
-> Proxy l -> Proxy msg -> SStaticError ('StaticError c l msg)
forall (c :: Natural) (l :: Symbol) (msg :: Symbol).
(KnownNat c, KnownSymbol l, KnownSymbol msg) =>
Proxy c
-> Proxy l -> Proxy msg -> SStaticError ('StaticError c l msg)
SStaticError
(Proxy c -> Proxy l -> Proxy msg -> SStaticError e)
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) (Proxy c)
-> SchemaP
SwaggerDoc
Object
[Pair]
(SStaticError e)
(Proxy l -> Proxy msg -> SStaticError e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy c
c Proxy c
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) Natural
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) (Proxy c)
forall a b.
a
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) b
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Natural -> SStaticError e -> Natural
forall a b. a -> b -> a
const Natural
code (SStaticError e -> Natural)
-> SchemaP SwaggerDoc Object [Pair] Natural Natural
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) Natural
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value Natural Natural
-> SchemaP SwaggerDoc Object [Pair] Natural Natural
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"code" SchemaP SwaggerDoc Value Value Natural Natural
codeSchema))
SchemaP
SwaggerDoc
Object
[Pair]
(SStaticError e)
(Proxy l -> Proxy msg -> SStaticError e)
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) (Proxy l)
-> SchemaP
SwaggerDoc
Object
[Pair]
(SStaticError e)
(Proxy msg -> SStaticError e)
forall a b.
SchemaP SwaggerDoc Object [Pair] (SStaticError e) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) a
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Proxy l
l Proxy l
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) Text
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) (Proxy l)
forall a b.
a
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) b
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> SStaticError e -> Text
forall a b. a -> b -> a
const Text
label (SStaticError e -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"label" SchemaP SwaggerDoc Value Value Text Text
labelSchema))
SchemaP
SwaggerDoc
Object
[Pair]
(SStaticError e)
(Proxy msg -> SStaticError e)
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) (Proxy msg)
-> ObjectSchema SwaggerDoc (SStaticError e)
forall a b.
SchemaP SwaggerDoc Object [Pair] (SStaticError e) (a -> b)
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) a
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Proxy msg
m Proxy msg
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) Text
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) (Proxy msg)
forall a b.
a
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) b
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> SStaticError e -> Text
forall a b. a -> b -> a
const Text
message (SStaticError e -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] (SStaticError e) Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"message" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
where
err :: DynError
err = SStaticError e -> DynError
forall (e :: StaticError). SStaticError e -> DynError
dynError' SStaticError e
e
label :: Text
label = DynError -> Text
eLabel DynError
err
code :: Natural
code = DynError -> Natural
eCode DynError
err
message :: Text
message = DynError -> Text
eMessage DynError
err
addExample :: NamedSwaggerDoc -> NamedSwaggerDoc
addExample = (Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema)
-> (Maybe Value -> Identity (Maybe Value))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
S.example ((Maybe Value -> Identity (Maybe Value))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Value -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SStaticError e -> Value
forall a. ToJSON a => a -> Value
A.toJSON SStaticError e
e
labelSchema :: ValueSchema SwaggerDoc Text
labelSchema :: SchemaP SwaggerDoc Value Value Text Text
labelSchema = SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text Text
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed (SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text Text)
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Value Value Text Text
forall a b. (a -> b) -> a -> b
$ forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Label" (Text -> Text -> SchemaP [Value] Text (Alt Maybe Text) Text Text
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
label Text
label)
codeSchema :: ValueSchema SwaggerDoc Natural
codeSchema :: SchemaP SwaggerDoc Value Value Natural Natural
codeSchema = SchemaP NamedSwaggerDoc Value Value Natural Natural
-> SchemaP SwaggerDoc Value Value Natural Natural
forall doc doc' v m a b.
HasObject doc doc' =>
SchemaP doc' v m a b -> SchemaP doc v m a b
unnamed (SchemaP NamedSwaggerDoc Value Value Natural Natural
-> SchemaP SwaggerDoc Value Value Natural Natural)
-> SchemaP NamedSwaggerDoc Value Value Natural Natural
-> SchemaP SwaggerDoc Value Value Natural Natural
forall a b. (a -> b) -> a -> b
$ forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Natural Text
"Status" (Natural
-> Natural
-> SchemaP [Value] Natural (Alt Maybe Natural) Natural Natural
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Natural
code Natural
code)
instance (KnownError e) => ToSchema (SStaticError e) where
schema :: ValueSchema NamedSwaggerDoc (SStaticError e)
schema = SStaticError e -> ValueSchema NamedSwaggerDoc (SStaticError e)
forall (e :: StaticError).
SStaticError e -> ValueSchema NamedSwaggerDoc (SStaticError e)
staticErrorSchema SStaticError e
forall (e :: StaticError). KnownError e => SStaticError e
seSing
data CanThrow e
data CanThrowMany (es :: [k])
instance (RoutesToPaths api) => RoutesToPaths (CanThrow err :> api) where
getRoutes :: Forest PathSegment
getRoutes = forall routes. RoutesToPaths routes => Forest PathSegment
forall {k} (routes :: k).
RoutesToPaths routes =>
Forest PathSegment
getRoutes @api
instance (RoutesToPaths api) => RoutesToPaths (CanThrowMany errs :> api) where
getRoutes :: Forest PathSegment
getRoutes = forall routes. RoutesToPaths routes => Forest PathSegment
forall {k} (routes :: k).
RoutesToPaths routes =>
Forest PathSegment
getRoutes @api
type instance
SpecialiseToVersion v (CanThrow e :> api) =
CanThrow e :> SpecialiseToVersion v api
instance (HasServer api ctx) => HasServer (CanThrow e :> api) ctx where
type ServerT (CanThrow e :> api) m = ServerT api m
route :: forall env.
Proxy (CanThrow e :> api)
-> Context ctx
-> Delayed env (Server (CanThrow e :> api))
-> Router env
route Proxy (CanThrow e :> api)
_ = Proxy api
-> Context ctx
-> Delayed env (Server api)
-> Router' env RoutingApplication
forall env.
Proxy api -> Context ctx -> Delayed env (Server api) -> Router env
forall {k} (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (CanThrow e :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (CanThrow e :> api) m
-> ServerT (CanThrow e :> api) n
hoistServerWithContext Proxy (CanThrow e :> api)
_ = Proxy api
-> Proxy ctx
-> (forall {x}. m x -> n x)
-> ServerT api m
-> ServerT api n
forall {k} (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall (m :: * -> *) (n :: * -> *).
Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
instance (HasServer api ctx) => HasServer (CanThrowMany es :> api) ctx where
type ServerT (CanThrowMany es :> api) m = ServerT api m
route :: forall env.
Proxy (CanThrowMany es :> api)
-> Context ctx
-> Delayed env (Server (CanThrowMany es :> api))
-> Router env
route Proxy (CanThrowMany es :> api)
_ = Proxy api
-> Context ctx
-> Delayed env (Server api)
-> Router' env RoutingApplication
forall env.
Proxy api -> Context ctx -> Delayed env (Server api) -> Router env
forall {k} (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (CanThrowMany es :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (CanThrowMany es :> api) m
-> ServerT (CanThrowMany es :> api) n
hoistServerWithContext Proxy (CanThrowMany es :> api)
_ = Proxy api
-> Proxy ctx
-> (forall {x}. m x -> n x)
-> ServerT api m
-> ServerT api n
forall {k} (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall (m :: * -> *) (n :: * -> *).
Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
instance
(HasOpenApi api, IsSwaggerError e) =>
HasOpenApi (CanThrow e :> api)
where
toOpenApi :: Proxy (CanThrow e :> api) -> OpenApi
toOpenApi Proxy (CanThrow e :> api)
_ = forall (e :: k). IsSwaggerError e => OpenApi -> OpenApi
forall {k} (e :: k). IsSwaggerError e => OpenApi -> OpenApi
addToOpenApi @e (Proxy api -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api))
instance (HasClient m api) => HasClient m (CanThrow e :> api) where
type Client m (CanThrow e :> api) = Client m api
clientWithRoute :: Proxy m
-> Proxy (CanThrow e :> api)
-> Request
-> Client m (CanThrow e :> api)
clientWithRoute Proxy m
pm Proxy (CanThrow e :> api)
_ = Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api -> Request -> Client m api)
-> Proxy api -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api
hoistClientMonad :: forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy (CanThrow e :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (CanThrow e :> api)
-> Client mon' (CanThrow e :> api)
hoistClientMonad Proxy m
pm Proxy (CanThrow e :> api)
_ = Proxy m
-> Proxy api
-> (forall {x}. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (mon :: * -> *) (mon' :: * -> *).
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
type instance
SpecialiseToVersion v (CanThrowMany es :> api) =
CanThrowMany es :> SpecialiseToVersion v api
instance (HasOpenApi api) => HasOpenApi (CanThrowMany '[] :> api) where
toOpenApi :: Proxy (CanThrowMany '[] :> api) -> OpenApi
toOpenApi Proxy (CanThrowMany '[] :> api)
_ = Proxy api -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @api)
instance
(HasOpenApi (CanThrowMany es :> api), IsSwaggerError e) =>
HasOpenApi (CanThrowMany (e : es) :> api)
where
toOpenApi :: Proxy (CanThrowMany (e : es) :> api) -> OpenApi
toOpenApi Proxy (CanThrowMany (e : es) :> api)
_ = forall (e :: k). IsSwaggerError e => OpenApi -> OpenApi
forall {k} (e :: k). IsSwaggerError e => OpenApi -> OpenApi
addToOpenApi @e (Proxy (CanThrowMany es :> api) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(CanThrowMany es :> api)))
type family DeclaredErrorEffects api :: EffectRow where
DeclaredErrorEffects (CanThrow e :> api) = (ErrorEffect e ': DeclaredErrorEffects api)
DeclaredErrorEffects (CanThrowMany (e : es) :> api) =
DeclaredErrorEffects (CanThrow e :> CanThrowMany es :> api)
DeclaredErrorEffects (x :> api) = DeclaredErrorEffects api
DeclaredErrorEffects (Named n api) = DeclaredErrorEffects api
DeclaredErrorEffects api = '[]
errorResponseSwagger :: forall e. (Typeable e, KnownError e) => S.Response
errorResponseSwagger :: forall (e :: StaticError). (Typeable e, KnownError e) => Response
errorResponseSwagger =
Response
forall a. Monoid a => a
mempty
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Response -> Identity Response
forall s a. HasDescription s a => Lens' s a
Lens' Response Text
S.description ((Text -> Identity Text) -> Response -> Identity Response)
-> Text -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (DynError -> Text
eMessage DynError
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (label: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DynError -> Text
eLabel DynError
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`)")
Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap MediaType MediaTypeObject
-> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response
forall s a. HasContent s a => Lens' s a
Lens' Response (InsOrdHashMap MediaType MediaTypeObject)
S.content ((InsOrdHashMap MediaType MediaTypeObject
-> Identity (InsOrdHashMap MediaType MediaTypeObject))
-> Response -> Identity Response)
-> InsOrdHashMap MediaType MediaTypeObject -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MediaType
-> MediaTypeObject -> InsOrdHashMap MediaType MediaTypeObject
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
singleton MediaType
mediaType MediaTypeObject
mediaTypeObject
where
err :: DynError
err = forall (e :: StaticError). KnownError e => DynError
dynError @e
mediaType :: MediaType
mediaType = Proxy JSON -> MediaType
forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy JSON -> MediaType) -> Proxy JSON -> MediaType
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @JSON
mediaTypeObject :: MediaTypeObject
mediaTypeObject =
MediaTypeObject
forall a. Monoid a => a
mempty
MediaTypeObject
-> (MediaTypeObject -> MediaTypeObject) -> MediaTypeObject
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject
forall s a. HasSchema s a => Lens' s a
Lens' MediaTypeObject (Maybe (Referenced Schema))
S.schema ((Maybe (Referenced Schema)
-> Identity (Maybe (Referenced Schema)))
-> MediaTypeObject -> Identity MediaTypeObject)
-> Referenced Schema -> MediaTypeObject -> MediaTypeObject
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Schema -> Referenced Schema
forall a. a -> Referenced a
S.Inline (Proxy (SStaticError e) -> Schema
forall a. ToSchema a => Proxy a -> Schema
S.toSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SStaticError e)))
addErrorResponseToSwagger :: Int -> S.Response -> S.OpenApi -> S.OpenApi
addErrorResponseToSwagger :: HttpStatusCode -> Response -> OpenApi -> OpenApi
addErrorResponseToSwagger HttpStatusCode
code Response
resp =
(Operation -> Identity Operation) -> OpenApi -> Identity OpenApi
Traversal' OpenApi Operation
S.allOperations
((Operation -> Identity Operation) -> OpenApi -> Identity OpenApi)
-> ((Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> Operation -> Identity Operation)
-> (Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Responses -> Identity Responses)
-> Operation -> Identity Operation
forall s a. HasResponses s a => Lens' s a
Lens' Operation Responses
S.responses
((Responses -> Identity Responses)
-> Operation -> Identity Operation)
-> ((Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> Responses -> Identity Responses)
-> (Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> Operation
-> Identity Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap HttpStatusCode (Referenced Response)
-> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Responses -> Identity Responses
forall s a. HasResponses s a => Lens' s a
Lens'
Responses (InsOrdHashMap HttpStatusCode (Referenced Response))
S.responses
((InsOrdHashMap HttpStatusCode (Referenced Response)
-> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> Responses -> Identity Responses)
-> ((Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> InsOrdHashMap HttpStatusCode (Referenced Response)
-> Identity (InsOrdHashMap HttpStatusCode (Referenced Response)))
-> (Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> Responses
-> Identity Responses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap HttpStatusCode (Referenced Response))
-> Lens'
(InsOrdHashMap HttpStatusCode (Referenced Response))
(Maybe
(IxValue (InsOrdHashMap HttpStatusCode (Referenced Response))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index (InsOrdHashMap HttpStatusCode (Referenced Response))
code
((Maybe (Referenced Response)
-> Identity (Maybe (Referenced Response)))
-> OpenApi -> Identity OpenApi)
-> (Maybe (Referenced Response) -> Maybe (Referenced Response))
-> OpenApi
-> OpenApi
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Referenced Response -> Maybe (Referenced Response)
forall a. a -> Maybe a
Just
(Referenced Response -> Maybe (Referenced Response))
-> (Maybe (Referenced Response) -> Referenced Response)
-> Maybe (Referenced Response)
-> Maybe (Referenced Response)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Referenced Response) -> Referenced Response
addRef
where
addRef :: Maybe (S.Referenced S.Response) -> S.Referenced S.Response
addRef :: Maybe (Referenced Response) -> Referenced Response
addRef Maybe (Referenced Response)
Nothing = Response -> Referenced Response
forall a. a -> Referenced a
S.Inline Response
resp
addRef (Just (S.Inline Response
resp1)) = Response -> Referenced Response
forall a. a -> Referenced a
S.Inline (Response -> Response -> Response
combineResponseSwagger Response
resp1 Response
resp)
addRef (Just r :: Referenced Response
r@(S.Ref Reference
_)) = Referenced Response
r
addStaticErrorToSwagger :: forall e. (Typeable e, KnownError e) => S.OpenApi -> S.OpenApi
addStaticErrorToSwagger :: forall (e :: StaticError).
(Typeable e, KnownError e) =>
OpenApi -> OpenApi
addStaticErrorToSwagger =
HttpStatusCode -> Response -> OpenApi -> OpenApi
addErrorResponseToSwagger
(Natural -> HttpStatusCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynError -> Natural
eCode (forall (e :: StaticError). KnownError e => DynError
dynError @e)))
(forall (e :: StaticError). (Typeable e, KnownError e) => Response
errorResponseSwagger @e)
type family MapError (e :: k) :: StaticError
type family ErrorEffect (e :: k) :: Effect
class IsSwaggerError e where
addToOpenApi :: S.OpenApi -> S.OpenApi
type ErrorS e = Error (Tagged e ())
throwS :: forall e r a. (Member (ErrorS e) r) => Sem r a
throwS :: forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS = Tagged e () -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (forall (s :: k) b. b -> Tagged s b
forall {k} (s :: k) b. b -> Tagged s b
Tagged @e ())
noteS :: forall e r a. (Member (ErrorS e) r) => Maybe a -> Sem r a
noteS :: forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS = Tagged e () -> Maybe a -> Sem r a
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note (forall (s :: k) b. b -> Tagged s b
forall {k} (s :: k) b. b -> Tagged s b
Tagged @e ())
runErrorS :: forall e r a. Sem (ErrorS e : r) a -> Sem r (Maybe a)
runErrorS :: forall {k} (e :: k) (r :: EffectRow) a.
Sem (ErrorS e : r) a -> Sem r (Maybe a)
runErrorS = (Either (Tagged e ()) a -> Maybe a)
-> Sem r (Either (Tagged e ()) a) -> Sem r (Maybe a)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (Tagged e ()) a -> Maybe a
forall a b. Either a b -> Maybe b
hush (Sem r (Either (Tagged e ()) a) -> Sem r (Maybe a))
-> (Sem (ErrorS e : r) a -> Sem r (Either (Tagged e ()) a))
-> Sem (ErrorS e : r) a
-> Sem r (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @(Tagged e ())
mapErrorS ::
forall e e' r a.
(Member (ErrorS e') r) =>
Sem (ErrorS e ': r) a ->
Sem r a
mapErrorS :: forall {k} {k} (e :: k) (e' :: k) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
mapErrorS = (Tagged e () -> Tagged e' ())
-> Sem (Error (Tagged e ()) : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError (forall (s :: k) b. b -> Tagged s b
forall {k} (s :: k) b. b -> Tagged s b
Tagged @e' (() -> Tagged e' ())
-> (Tagged e () -> ()) -> Tagged e () -> Tagged e' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged e () -> ()
forall {k} (s :: k) b. Tagged s b -> b
unTagged)
mapToRuntimeError ::
forall e e' r a. (Member (Error e') r) => e' -> Sem (ErrorS e ': r) a -> Sem r a
mapToRuntimeError :: forall {k} (e :: k) e' (r :: EffectRow) a.
Member (Error e') r =>
e' -> Sem (ErrorS e : r) a -> Sem r a
mapToRuntimeError e'
e' = (Tagged e () -> e') -> Sem (Error (Tagged e ()) : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError (e' -> Tagged e () -> e'
forall a b. a -> b -> a
const e'
e')
mapToDynamicError ::
forall e r a.
(Member (Error DynError) r, KnownError (MapError e)) =>
Sem (ErrorS e ': r) a ->
Sem r a
mapToDynamicError :: forall {k} (e :: k) (r :: EffectRow) a.
(Member (Error DynError) r, KnownError (MapError e)) =>
Sem (ErrorS e : r) a -> Sem r a
mapToDynamicError = DynError -> Sem (ErrorS e : r) a -> Sem r a
forall {k} (e :: k) e' (r :: EffectRow) a.
Member (Error e') r =>
e' -> Sem (ErrorS e : r) a -> Sem r a
mapToRuntimeError (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e))
errorToWai :: forall e. (KnownError (MapError e)) => Wai.Error
errorToWai :: forall {k} (e :: k). KnownError (MapError e) => Error
errorToWai = DynError -> Error
dynErrorToWai (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e))
errorToResponse :: forall e. (KnownError (MapError e)) => JSONResponse
errorToResponse :: forall {k} (e :: k). KnownError (MapError e) => JSONResponse
errorToResponse = DynError -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e))
class APIError e where
toResponse :: e -> JSONResponse
instance APIError Wai.Error where
toResponse :: Error -> JSONResponse
toResponse = Error -> JSONResponse
waiErrorToJSONResponse
instance APIError DynError where
toResponse :: DynError -> JSONResponse
toResponse (DynError Natural
c Text
l Text
m) =
Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse) -> Error -> JSONResponse
forall a b. (a -> b) -> a -> b
$
Status -> LText -> LText -> Error
Wai.mkError (HttpStatusCode -> Status
forall a. Enum a => HttpStatusCode -> a
toEnum (Natural -> HttpStatusCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c)) (Text -> LText
LT.fromStrict Text
l) (Text -> LText
LT.fromStrict Text
m)
instance APIError (SStaticError e) where
toResponse :: SStaticError e -> JSONResponse
toResponse = DynError -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (DynError -> JSONResponse)
-> (SStaticError e -> DynError) -> SStaticError e -> JSONResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SStaticError e -> DynError
forall (e :: StaticError). SStaticError e -> DynError
dynError'
type family RespondWithStaticError (s :: StaticError) :: Type where
RespondWithStaticError ('StaticError s l m) = RespondAs JSON s m DynError
type family StaticErrorStatus (s :: StaticError) :: Nat where
StaticErrorStatus ('StaticError s l m) = s
data ErrorResponse e
type instance ResponseType (ErrorResponse e) = DynError
instance
( ResponseBody (RespondWithStaticError (MapError e)) ~ LByteString,
ResponseType (RespondWithStaticError (MapError e)) ~ DynError,
IsResponse cs (RespondWithStaticError (MapError e))
) =>
IsResponse cs (ErrorResponse e)
where
type ResponseStatus (ErrorResponse e) = StaticErrorStatus (MapError e)
type ResponseBody (ErrorResponse e) = LByteString
responseRender :: AcceptHeader
-> ResponseType (ErrorResponse e)
-> Maybe (ResponseF (ResponseBody (ErrorResponse e)))
responseRender = forall (cs :: k) a.
IsResponse cs a =>
AcceptHeader
-> ResponseType a -> Maybe (ResponseF (ResponseBody a))
forall {k} (cs :: k) a.
IsResponse cs a =>
AcceptHeader
-> ResponseType a -> Maybe (ResponseF (ResponseBody a))
responseRender @cs @(RespondWithStaticError (MapError e))
responseUnrender :: MediaType
-> ResponseF (ResponseBody (ErrorResponse e))
-> UnrenderResult (ResponseType (ErrorResponse e))
responseUnrender = forall (cs :: k) a.
IsResponse cs a =>
MediaType
-> ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a)
forall {k} (cs :: k) a.
IsResponse cs a =>
MediaType
-> ResponseF (ResponseBody a) -> UnrenderResult (ResponseType a)
responseUnrender @cs @(RespondWithStaticError (MapError e))
instance (KnownError (MapError e)) => AsConstructor '[] (ErrorResponse e) where
toConstructor :: ResponseType (ErrorResponse e) -> NP I '[]
toConstructor ResponseType (ErrorResponse e)
_ = NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil
fromConstructor :: NP I '[] -> ResponseType (ErrorResponse e)
fromConstructor NP I '[]
_ = forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e)
instance (KnownError (MapError e), Typeable (MapError e)) => IsSwaggerResponse (ErrorResponse e) where
responseSwagger :: Declare Response
responseSwagger = Response -> Declare Response
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> Declare Response) -> Response -> Declare Response
forall a b. (a -> b) -> a -> b
$ forall (e :: StaticError). (Typeable e, KnownError e) => Response
errorResponseSwagger @(MapError e)
instance
(ResponseType r ~ a, KnownError (MapError e)) =>
AsUnion '[ErrorResponse e, r] (Maybe a)
where
toUnion :: Maybe a -> Union (ResponseTypes '[ErrorResponse e, r])
toUnion Maybe a
Nothing = I DynError -> NS I '[DynError, a]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (DynError -> I DynError
forall a. a -> I a
I (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e)))
toUnion (Just a
x) = NS I '[a] -> NS I '[DynError, a]
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (I a -> NS I '[a]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (a -> I a
forall a. a -> I a
I a
x))
fromUnion :: Union (ResponseTypes '[ErrorResponse e, r]) -> Maybe a
fromUnion (Z (I x
_)) = Maybe a
forall a. Maybe a
Nothing
fromUnion (S (Z (I x
x))) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
x
fromUnion (S (S NS I xs
x)) = case NS I xs
x of {}