module Wire.API.Routes.API
( ServiceAPI (..),
API,
hoistAPIHandler,
hoistAPI,
mkAPI,
mkNamedAPI,
(<@>),
ServerEffect (..),
ServerEffects (..),
hoistServerWithDomain,
)
where
import Data.Domain
import Data.Kind
import Data.OpenApi qualified as S
import Data.Proxy
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Internal
import Servant hiding (Union)
import Servant.OpenApi
import Wire.API.Error
import Wire.API.Routes.Named
import Wire.API.Routes.Version
class ServiceAPI service (v :: Version) where
type ServiceAPIRoutes service
type SpecialisedAPIRoutes v service :: Type
type SpecialisedAPIRoutes v service = SpecialiseToVersion v (ServiceAPIRoutes service)
serviceSwagger :: (HasOpenApi (SpecialisedAPIRoutes v service)) => S.OpenApi
serviceSwagger = Proxy (SpecialisedAPIRoutes v service) -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SpecialisedAPIRoutes v service))
instance ServiceAPI VersionAPITag v where
type ServiceAPIRoutes VersionAPITag = VersionAPI
newtype API api r = API {forall {k} (api :: k) (r :: EffectRow).
API api r -> ServerT api (Sem r)
unAPI :: ServerT api (Sem r)}
mkAPI ::
forall r0 api.
(HasServer api '[Domain], ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0)) ->
API api r0
mkAPI :: forall (r0 :: EffectRow) api.
(HasServer api '[Domain],
ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API api r0
mkAPI ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
h = ServerT api (Sem r0) -> API api r0
forall {k} (api :: k) (r :: EffectRow).
ServerT api (Sem r) -> API api r
API (ServerT api (Sem r0) -> API api r0)
-> ServerT api (Sem r0) -> API api r0
forall a b. (a -> b) -> a -> b
$ forall {k} (api :: k) (m :: * -> *) (n :: * -> *).
HasServer api '[Domain] =>
(forall x. m x -> n x) -> ServerT api m -> ServerT api n
forall api (m :: * -> *) (n :: * -> *).
HasServer api '[Domain] =>
(forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServerWithDomain @api (forall (r :: EffectRow) (r1 :: EffectRow) a.
ServerEffects r r1 =>
Sem (Append r r1) a -> Sem r1 a
interpretServerEffects @(DeclaredErrorEffects api) @r0) ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
h
mkNamedAPI ::
forall name r0 api.
(HasServer api '[Domain], ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0)) ->
API (Named name api) r0
mkNamedAPI :: forall {k} (name :: k) (r0 :: EffectRow) api.
(HasServer api '[Domain],
ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
mkNamedAPI = ServerT (Named name api) (Sem r0) -> API (Named name api) r0
Named name (ServerT api (Sem r0)) -> API (Named name api) r0
forall {k} (api :: k) (r :: EffectRow).
ServerT api (Sem r) -> API api r
API (Named name (ServerT api (Sem r0)) -> API (Named name api) r0)
-> (ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> Named name (ServerT api (Sem r0)))
-> ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API (Named name api) r0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerT api (Sem r0) -> Named name (ServerT api (Sem r0))
forall {k} (name :: k) x. x -> Named name x
Named (ServerT api (Sem r0) -> Named name (ServerT api (Sem r0)))
-> (ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> ServerT api (Sem r0))
-> ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> Named name (ServerT api (Sem r0))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. API api r0 -> ServerT api (Sem r0)
forall {k} (api :: k) (r :: EffectRow).
API api r -> ServerT api (Sem r)
unAPI (API api r0 -> ServerT api (Sem r0))
-> (ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API api r0)
-> ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> ServerT api (Sem r0)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r0 :: EffectRow) api.
(HasServer api '[Domain],
ServerEffects (DeclaredErrorEffects api) r0) =>
ServerT api (Sem (Append (DeclaredErrorEffects api) r0))
-> API api r0
mkAPI @r0 @api
(<@>) :: API api1 r -> API api2 r -> API (api1 :<|> api2) r
<@> :: forall api1 (r :: EffectRow) api2.
API api1 r -> API api2 r -> API (api1 :<|> api2) r
(<@>) (API ServerT api1 (Sem r)
h1) (API ServerT api2 (Sem r)
h2) = ServerT (api1 :<|> api2) (Sem r) -> API (api1 :<|> api2) r
forall {k} (api :: k) (r :: EffectRow).
ServerT api (Sem r) -> API api r
API (ServerT api1 (Sem r)
h1 ServerT api1 (Sem r)
-> ServerT api2 (Sem r)
-> ServerT api1 (Sem r) :<|> ServerT api2 (Sem r)
forall a b. a -> b -> a :<|> b
:<|> ServerT api2 (Sem r)
h2)
infixr 3 <@>
hoistServerWithDomain ::
forall api m n.
(HasServer api '[Domain]) =>
(forall x. m x -> n x) ->
ServerT api m ->
ServerT api n
hoistServerWithDomain :: forall {k} (api :: k) (m :: * -> *) (n :: * -> *).
HasServer api '[Domain] =>
(forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServerWithDomain = Proxy api
-> Proxy '[Domain]
-> (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 '[Domain]
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @api) (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @'[Domain])
hoistAPIHandler ::
forall api r n.
(HasServer api '[Domain]) =>
(forall x. Sem r x -> n x) ->
API api r ->
ServerT api n
hoistAPIHandler :: forall {k} (api :: k) (r :: EffectRow) (n :: * -> *).
HasServer api '[Domain] =>
(forall x. Sem r x -> n x) -> API api r -> ServerT api n
hoistAPIHandler forall x. Sem r x -> n x
f = forall (api :: k) (m :: * -> *) (n :: * -> *).
HasServer api '[Domain] =>
(forall x. m x -> n x) -> ServerT api m -> ServerT api n
forall {k} (api :: k) (m :: * -> *) (n :: * -> *).
HasServer api '[Domain] =>
(forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServerWithDomain @api Sem r x -> n x
forall x. Sem r x -> n x
f (ServerT api (Sem r) -> ServerT api n)
-> (API api r -> ServerT api (Sem r)) -> API api r -> ServerT api n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. API api r -> ServerT api (Sem r)
forall {k} (api :: k) (r :: EffectRow).
API api r -> ServerT api (Sem r)
unAPI
hoistAPI ::
forall api1 api2 r1 r2.
(ServerT api1 (Sem r1) -> ServerT api2 (Sem r2)) ->
API api1 r1 ->
API api2 r2
hoistAPI :: forall {k} {k} (api1 :: k) (api2 :: k) (r1 :: EffectRow)
(r2 :: EffectRow).
(ServerT api1 (Sem r1) -> ServerT api2 (Sem r2))
-> API api1 r1 -> API api2 r2
hoistAPI ServerT api1 (Sem r1) -> ServerT api2 (Sem r2)
f = ServerT api2 (Sem r2) -> API api2 r2
forall {k} (api :: k) (r :: EffectRow).
ServerT api (Sem r) -> API api r
API (ServerT api2 (Sem r2) -> API api2 r2)
-> (API api1 r1 -> ServerT api2 (Sem r2))
-> API api1 r1
-> API api2 r2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerT api1 (Sem r1) -> ServerT api2 (Sem r2)
f (ServerT api1 (Sem r1) -> ServerT api2 (Sem r2))
-> (API api1 r1 -> ServerT api1 (Sem r1))
-> API api1 r1
-> ServerT api2 (Sem r2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. API api1 r1 -> ServerT api1 (Sem r1)
forall {k} (api :: k) (r :: EffectRow).
API api r -> ServerT api (Sem r)
unAPI
class ServerEffect eff r where
interpretServerEffect :: Sem (eff ': r) a -> Sem r a
class ServerEffects r r1 where
interpretServerEffects :: Sem (Append r r1) a -> Sem r1 a
instance ServerEffects '[] r where
interpretServerEffects :: forall a. Sem (Append '[] r) a -> Sem r a
interpretServerEffects = Sem r a -> Sem r a
Sem (Append '[] r) a -> Sem r a
forall a. a -> a
id
instance (ServerEffects r r1, ServerEffect eff (Append r r1)) => ServerEffects (eff ': r) r1 where
interpretServerEffects :: forall a. Sem (Append (eff : r) r1) a -> Sem r1 a
interpretServerEffects = forall (r :: EffectRow) (r1 :: EffectRow) a.
ServerEffects r r1 =>
Sem (Append r r1) a -> Sem r1 a
interpretServerEffects @r @r1 (Sem (Append r r1) a -> Sem r1 a)
-> (Sem (eff : Append r r1) a -> Sem (Append r r1) a)
-> Sem (eff : Append r r1) a
-> Sem r1 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (eff :: Effect) (r :: EffectRow) a.
ServerEffect eff r =>
Sem (eff : r) a -> Sem r a
interpretServerEffect @eff @(Append r r1)
instance (KnownError (MapError e), Member (Error DynError) r) => ServerEffect (ErrorS e) r where
interpretServerEffect :: forall a. Sem (ErrorS e : r) a -> Sem r a
interpretServerEffect = Sem (ErrorS e : r) a -> Sem r a
forall {k} (e :: k) (r :: EffectRow) a.
(Member (Error DynError) r, KnownError (MapError e)) =>
Sem (ErrorS e : r) a -> Sem r a
mapToDynamicError
instance (KnownError (MapError e), Member (Error DynError) r) => ServerEffect (Error (Tagged e Text)) r where
interpretServerEffect :: forall a. Sem (Error (Tagged e Text) : r) a -> Sem r a
interpretServerEffect = (Tagged e Text -> DynError)
-> Sem (Error (Tagged e Text) : 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 ((Tagged e Text -> DynError)
-> Sem (Error (Tagged e Text) : r) a -> Sem r a)
-> (Tagged e Text -> DynError)
-> Sem (Error (Tagged e Text) : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \Tagged e Text
msg -> (forall (e :: StaticError). KnownError e => DynError
dynError @(MapError e)) {eMessage = unTagged msg}