module Mig.Core.Class.Plugin (
ToPlugin (..),
Plugin (..),
PluginFun,
toPlugin,
fromPluginFun,
($:),
applyPlugin,
RawResponse (..),
prependServerAction,
appendServerAction,
processResponse,
whenSecure,
processNoResponse,
) where
import Control.Monad.IO.Class
import Data.OpenApi (ToParamSchema (..), ToSchema (..))
import Data.Proxy
import Data.String
import Data.Text (Text)
import GHC.TypeLits
import Web.FormUrlEncoded (FromForm)
import Web.HttpApiData
import Mig.Core.Class.MediaType
import Mig.Core.Class.Monad
import Mig.Core.Class.Response
import Mig.Core.Server
import Mig.Core.ServerFun
import Mig.Core.Types
type PluginFun m = ServerFun m -> ServerFun m
data Plugin m = Plugin
{ forall (m :: * -> *). Plugin m -> RouteInfo -> RouteInfo
info :: RouteInfo -> RouteInfo
, forall (m :: * -> *). Plugin m -> PluginFun m
run :: PluginFun m
}
instance Monoid (Plugin m) where
mempty :: Plugin m
mempty = forall (m :: * -> *).
(RouteInfo -> RouteInfo) -> PluginFun m -> Plugin m
Plugin forall a. a -> a
id forall a. a -> a
id
instance Semigroup (Plugin m) where
<> :: Plugin m -> Plugin m -> Plugin m
(<>) Plugin m
a Plugin m
b = forall (m :: * -> *).
(RouteInfo -> RouteInfo) -> PluginFun m -> Plugin m
Plugin (Plugin m
a.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plugin m
b.info) (Plugin m
a.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plugin m
b.run)
($:) :: forall f. (ToPlugin f) => f -> Server (MonadOf f) -> Server (MonadOf f)
$: :: forall f.
ToPlugin f =>
f -> Server (MonadOf f) -> Server (MonadOf f)
($:) = forall f.
ToPlugin f =>
f -> Server (MonadOf f) -> Server (MonadOf f)
applyPlugin
applyPlugin :: forall f. (ToPlugin f) => f -> Server (MonadOf f) -> Server (MonadOf f)
applyPlugin :: forall f.
ToPlugin f =>
f -> Server (MonadOf f) -> Server (MonadOf f)
applyPlugin f
a = forall (m :: * -> *).
(RouteInfo -> RouteInfo) -> Server m -> Server m
mapRouteInfo (forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *).
(ServerFun m -> ServerFun n) -> Server m -> Server n
mapServerFun (forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun f
a)
class (MonadIO (MonadOf f)) => ToPlugin f where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginFun :: f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPlugin :: forall f. (ToPlugin f) => f -> Plugin (MonadOf f)
toPlugin :: forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin f
a = forall (m :: * -> *).
(RouteInfo -> RouteInfo) -> PluginFun m -> Plugin m
Plugin (forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @f) (forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun f
a)
instance (MonadIO m) => ToPlugin (PluginFun m) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: PluginFun m
-> ServerFun (MonadOf (PluginFun m))
-> ServerFun (MonadOf (PluginFun m))
toPluginFun = forall a. a -> a
id
instance (MonadIO m) => ToPlugin (Plugin m) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: Plugin m
-> ServerFun (MonadOf (Plugin m)) -> ServerFun (MonadOf (Plugin m))
toPluginFun = (.run)
fromPluginFun :: (MonadIO m) => PluginFun m -> Plugin m
fromPluginFun :: forall (m :: * -> *). MonadIO m => PluginFun m -> Plugin m
fromPluginFun = forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin
instance (ToPlugin a) => ToPlugin (PathInfo -> a) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: (PathInfo -> a)
-> ServerFun (MonadOf (PathInfo -> a))
-> ServerFun (MonadOf (PathInfo -> a))
toPluginFun PathInfo -> a
f = \ServerFun (MonadOf (PathInfo -> a))
fun -> forall (m :: * -> *). ([Text] -> ServerFun m) -> ServerFun m
withPathInfo (\[Text]
path -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (PathInfo -> a
f ([Text] -> PathInfo
PathInfo [Text]
path)) ServerFun (MonadOf (PathInfo -> a))
fun)
instance (ToPlugin a) => ToPlugin (FullPathInfo -> a) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: (FullPathInfo -> a)
-> ServerFun (MonadOf (FullPathInfo -> a))
-> ServerFun (MonadOf (FullPathInfo -> a))
toPluginFun FullPathInfo -> a
f = \ServerFun (MonadOf (FullPathInfo -> a))
fun -> forall (m :: * -> *). (Text -> ServerFun m) -> ServerFun m
withFullPathInfo (\Text
path -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (FullPathInfo -> a
f (Text -> FullPathInfo
FullPathInfo Text
path)) ServerFun (MonadOf (FullPathInfo -> a))
fun)
instance (ToPlugin a) => ToPlugin (IsSecure -> a) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: (IsSecure -> a)
-> ServerFun (MonadOf (IsSecure -> a))
-> ServerFun (MonadOf (IsSecure -> a))
toPluginFun IsSecure -> a
f = \ServerFun (MonadOf (IsSecure -> a))
fun -> \Request
req -> (forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (IsSecure -> a
f (Bool -> IsSecure
IsSecure Request
req.isSecure)) ServerFun (MonadOf (IsSecure -> a))
fun) Request
req
instance (ToPlugin a) => ToPlugin (RawRequest -> a) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: (RawRequest -> a)
-> ServerFun (MonadOf (RawRequest -> a))
-> ServerFun (MonadOf (RawRequest -> a))
toPluginFun RawRequest -> a
f = \ServerFun (MonadOf (RawRequest -> a))
fun -> \Request
req -> (forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (RawRequest -> a
f (Request -> RawRequest
RawRequest Request
req)) ServerFun (MonadOf (RawRequest -> a))
fun) Request
req
newtype RawResponse = RawResponse (Maybe Response)
instance (ToPlugin a) => ToPlugin (RawResponse -> a) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall a. a -> a
id
toPluginFun :: (RawResponse -> a)
-> ServerFun (MonadOf (RawResponse -> a))
-> ServerFun (MonadOf (RawResponse -> a))
toPluginFun RawResponse -> a
f = \ServerFun (MonadOf (RawResponse -> a))
fun -> \Request
req -> do
Maybe Response
resp <- ServerFun (MonadOf (RawResponse -> a))
fun Request
req
(forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (RawResponse -> a
f (Maybe Response -> RawResponse
RawResponse Maybe Response
resp)) ServerFun (MonadOf (RawResponse -> a))
fun) Request
req
instance (FromReqBody ty a, ToSchema a, ToPlugin b) => ToPlugin (Body ty a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall {k} (ty :: k) a.
(ToMediaType ty, ToSchema a) =>
RouteInfo -> RouteInfo
addBodyInfo @ty @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (Body ty a -> b)
-> ServerFun (MonadOf (Body ty a -> b))
-> ServerFun (MonadOf (Body ty a -> b))
toPluginFun Body ty a -> b
f = \ServerFun (MonadOf (Body ty a -> b))
fun -> forall {k} (media :: k) a (m :: * -> *).
(MonadIO m, FromReqBody media a) =>
(a -> ServerFun m) -> ServerFun m
withBody @ty (\a
body -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (Body ty a -> b
f (forall {k} (media :: k) a. a -> Body media a
Body a
body)) ServerFun (MonadOf (Body ty a -> b))
fun)
instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Header sym a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addHeaderInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (Header sym a -> b)
-> ServerFun (MonadOf (Header sym a -> b))
-> ServerFun (MonadOf (Header sym a -> b))
toPluginFun Header sym a -> b
f = \ServerFun (MonadOf (Header sym a -> b))
fun -> forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
HeaderName -> (a -> ServerFun m) -> ServerFun m
withHeader (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (\a
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (Header sym a -> b
f (forall (sym :: Symbol) a. a -> Header sym a
Header a
a)) ServerFun (MonadOf (Header sym a -> b))
fun)
instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (OptionalHeader sym a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalHeaderInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (OptionalHeader sym a -> b)
-> ServerFun (MonadOf (OptionalHeader sym a -> b))
-> ServerFun (MonadOf (OptionalHeader sym a -> b))
toPluginFun OptionalHeader sym a -> b
f = \ServerFun (MonadOf (OptionalHeader sym a -> b))
fun -> forall a (m :: * -> *).
FromHttpApiData a =>
HeaderName -> (Maybe a -> ServerFun m) -> ServerFun m
withOptionalHeader (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (\Maybe a
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (OptionalHeader sym a -> b
f (forall (sym :: Symbol) a. Maybe a -> OptionalHeader sym a
OptionalHeader Maybe a
a)) ServerFun (MonadOf (OptionalHeader sym a -> b))
fun)
instance (FromForm a, ToPlugin b) => ToPlugin (Cookie a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalHeaderInfo @"Cookie" @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (Cookie a -> b)
-> ServerFun (MonadOf (Cookie a -> b))
-> ServerFun (MonadOf (Cookie a -> b))
toPluginFun Cookie a -> b
f = \ServerFun (MonadOf (Cookie a -> b))
fun -> forall a (m :: * -> *).
FromForm a =>
(Maybe a -> ServerFun m) -> ServerFun m
withCookie (\Maybe a
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (Cookie a -> b
f (forall a. Maybe a -> Cookie a
Cookie Maybe a
a)) ServerFun (MonadOf (Cookie a -> b))
fun)
instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Query sym a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addQueryInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (Query sym a -> b)
-> ServerFun (MonadOf (Query sym a -> b))
-> ServerFun (MonadOf (Query sym a -> b))
toPluginFun Query sym a -> b
f = \ServerFun (MonadOf (Query sym a -> b))
fun -> forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
Text -> (a -> ServerFun m) -> ServerFun m
withQuery (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (\a
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (Query sym a -> b
f (forall (sym :: Symbol) a. a -> Query sym a
Query a
a)) ServerFun (MonadOf (Query sym a -> b))
fun)
instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Optional sym a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addOptionalInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (Optional sym a -> b)
-> ServerFun (MonadOf (Optional sym a -> b))
-> ServerFun (MonadOf (Optional sym a -> b))
toPluginFun Optional sym a -> b
f = \ServerFun (MonadOf (Optional sym a -> b))
fun -> forall a (m :: * -> *).
FromHttpApiData a =>
Text -> (Maybe a -> ServerFun m) -> ServerFun m
withOptional (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (\Maybe a
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (Optional sym a -> b
f (forall (sym :: Symbol) a. Maybe a -> Optional sym a
Optional Maybe a
a)) ServerFun (MonadOf (Optional sym a -> b))
fun)
instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Capture sym a -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol) a.
(KnownSymbol sym, ToParamSchema a) =>
RouteInfo -> RouteInfo
addCaptureInfo @sym @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (Capture sym a -> b)
-> ServerFun (MonadOf (Capture sym a -> b))
-> ServerFun (MonadOf (Capture sym a -> b))
toPluginFun Capture sym a -> b
f = \ServerFun (MonadOf (Capture sym a -> b))
fun -> forall (m :: * -> *) a.
(Monad m, FromHttpApiData a) =>
Text -> (a -> ServerFun m) -> ServerFun m
withCapture (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (\a
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (Capture sym a -> b
f (forall (sym :: Symbol) a. a -> Capture sym a
Capture a
a)) ServerFun (MonadOf (Capture sym a -> b))
fun)
instance (ToPlugin b, KnownSymbol sym) => ToPlugin (QueryFlag sym -> b) where
toPluginInfo :: RouteInfo -> RouteInfo
toPluginInfo = forall (sym :: Symbol). KnownSymbol sym => RouteInfo -> RouteInfo
addQueryFlagInfo @sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. ToPlugin f => RouteInfo -> RouteInfo
toPluginInfo @b
toPluginFun :: (QueryFlag sym -> b)
-> ServerFun (MonadOf (QueryFlag sym -> b))
-> ServerFun (MonadOf (QueryFlag sym -> b))
toPluginFun QueryFlag sym -> b
f = \ServerFun (MonadOf (QueryFlag sym -> b))
fun -> forall (m :: * -> *). Text -> (Bool -> ServerFun m) -> ServerFun m
withQueryFlag (forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName @sym) (\Bool
a -> forall f.
ToPlugin f =>
f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f)
toPluginFun (QueryFlag sym -> b
f (forall (sym :: Symbol). Bool -> QueryFlag sym
QueryFlag Bool
a)) ServerFun (MonadOf (QueryFlag sym -> b))
fun)
prependServerAction :: forall m. (MonadIO m) => m () -> Plugin m
prependServerAction :: forall (m :: * -> *). MonadIO m => m () -> Plugin m
prependServerAction m ()
act = forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin ServerFun m -> ServerFun m
go
where
go :: ServerFun m -> ServerFun m
go :: ServerFun m -> ServerFun m
go ServerFun m
f = \Request
req -> do
m ()
act
ServerFun m
f Request
req
appendServerAction :: forall m. (MonadIO m) => m () -> Plugin m
appendServerAction :: forall (m :: * -> *). MonadIO m => m () -> Plugin m
appendServerAction m ()
act = forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin ServerFun m -> ServerFun m
go
where
go :: ServerFun m -> ServerFun m
go :: ServerFun m -> ServerFun m
go ServerFun m
f = \Request
req -> do
Maybe Response
resp <- ServerFun m
f Request
req
m ()
act
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Response
resp
processResponse :: forall m. (MonadIO m) => (m (Maybe Response) -> m (Maybe Response)) -> Plugin m
processResponse :: forall (m :: * -> *).
MonadIO m =>
(m (Maybe Response) -> m (Maybe Response)) -> Plugin m
processResponse m (Maybe Response) -> m (Maybe Response)
act = forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin ServerFun m -> ServerFun m
go
where
go :: ServerFun m -> ServerFun m
go :: ServerFun m -> ServerFun m
go ServerFun m
f = \Request
req -> do
m (Maybe Response) -> m (Maybe Response)
act (ServerFun m
f Request
req)
whenSecure :: forall m. (MonadIO m) => Plugin m
whenSecure :: forall (m :: * -> *). MonadIO m => Plugin m
whenSecure = forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin forall a b. (a -> b) -> a -> b
$ \(IsSecure Bool
isSecure) ->
forall (m :: * -> *).
MonadIO m =>
(m (Maybe Response) -> m (Maybe Response)) -> Plugin m
processResponse (if Bool
isSecure then forall a. a -> a
id else forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing))
processNoResponse :: forall m a. (MonadIO m, IsResp a) => m a -> Plugin m
processNoResponse :: forall (m :: * -> *) a. (MonadIO m, IsResp a) => m a -> Plugin m
processNoResponse m a
defaultResponse = forall f. ToPlugin f => f -> Plugin (MonadOf f)
toPlugin PluginFun m
go
where
go :: PluginFun m
go :: PluginFun m
go ServerFun m
fun = \Request
req -> do
Maybe Response
mResp <- ServerFun m
fun Request
req
case Maybe Response
mResp of
Just Response
resp -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Response
resp)
Maybe Response
Nothing -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsResp a => a -> Response
toResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
defaultResponse
getName :: forall sym a. (KnownSymbol sym, IsString a) => a
getName :: forall (sym :: Symbol) a. (KnownSymbol sym, IsString a) => a
getName = forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym))