{-# LANGUAGE UndecidableInstances #-} module Mensam.Server.Server.Handler where import Mensam.Server.Application.Configured.Class import Mensam.Server.Application.Email.Class import Mensam.Server.Application.LoggerCustom.Class import Mensam.Server.Application.Secret.Class import Mensam.Server.Application.SeldaPool.Class import Mensam.Server.Server.Handler.Profiler import Mensam.Server.Server.Handler.RequestHash import Control.Monad.Base import Control.Monad.Catch import Control.Monad.IO.Unlift import Control.Monad.Logger.CallStack import Control.Monad.Trans.Class import Control.Monad.Trans.Compose.Stack import Control.Monad.Trans.Control import Control.Monad.Trans.Control.Identity import Data.Kind type Transformers :: Stack type Transformers = NilT :.|> RequestHashT :.|> ProfilerT type HandlerT :: (Type -> Type) -> Type -> Type newtype HandlerT m a = HandlerT {forall (m :: * -> *) a. HandlerT m a -> StackT Transformers m a unHandlerT :: StackT Transformers m a} deriving newtype (Functor (HandlerT m) Functor (HandlerT m) => (forall a. a -> HandlerT m a) -> (forall a b. HandlerT m (a -> b) -> HandlerT m a -> HandlerT m b) -> (forall a b c. (a -> b -> c) -> HandlerT m a -> HandlerT m b -> HandlerT m c) -> (forall a b. HandlerT m a -> HandlerT m b -> HandlerT m b) -> (forall a b. HandlerT m a -> HandlerT m b -> HandlerT m a) -> Applicative (HandlerT m) forall a. a -> HandlerT m a forall a b. HandlerT m a -> HandlerT m b -> HandlerT m a forall a b. HandlerT m a -> HandlerT m b -> HandlerT m b forall a b. HandlerT m (a -> b) -> HandlerT m a -> HandlerT m b forall a b c. (a -> b -> c) -> HandlerT m a -> HandlerT m b -> HandlerT m 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 forall (m :: * -> *). Applicative m => Functor (HandlerT m) forall (m :: * -> *) a. Applicative m => a -> HandlerT m a forall (m :: * -> *) a b. Applicative m => HandlerT m a -> HandlerT m b -> HandlerT m a forall (m :: * -> *) a b. Applicative m => HandlerT m a -> HandlerT m b -> HandlerT m b forall (m :: * -> *) a b. Applicative m => HandlerT m (a -> b) -> HandlerT m a -> HandlerT m b forall (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> HandlerT m a -> HandlerT m b -> HandlerT m c $cpure :: forall (m :: * -> *) a. Applicative m => a -> HandlerT m a pure :: forall a. a -> HandlerT m a $c<*> :: forall (m :: * -> *) a b. Applicative m => HandlerT m (a -> b) -> HandlerT m a -> HandlerT m b <*> :: forall a b. HandlerT m (a -> b) -> HandlerT m a -> HandlerT m b $cliftA2 :: forall (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> HandlerT m a -> HandlerT m b -> HandlerT m c liftA2 :: forall a b c. (a -> b -> c) -> HandlerT m a -> HandlerT m b -> HandlerT m c $c*> :: forall (m :: * -> *) a b. Applicative m => HandlerT m a -> HandlerT m b -> HandlerT m b *> :: forall a b. HandlerT m a -> HandlerT m b -> HandlerT m b $c<* :: forall (m :: * -> *) a b. Applicative m => HandlerT m a -> HandlerT m b -> HandlerT m a <* :: forall a b. HandlerT m a -> HandlerT m b -> HandlerT m a Applicative, (forall a b. (a -> b) -> HandlerT m a -> HandlerT m b) -> (forall a b. a -> HandlerT m b -> HandlerT m a) -> Functor (HandlerT m) forall a b. a -> HandlerT m b -> HandlerT m a forall a b. (a -> b) -> HandlerT m a -> HandlerT m b forall (m :: * -> *) a b. Functor m => a -> HandlerT m b -> HandlerT m a forall (m :: * -> *) a b. Functor m => (a -> b) -> HandlerT m a -> HandlerT m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall (m :: * -> *) a b. Functor m => (a -> b) -> HandlerT m a -> HandlerT m b fmap :: forall a b. (a -> b) -> HandlerT m a -> HandlerT m b $c<$ :: forall (m :: * -> *) a b. Functor m => a -> HandlerT m b -> HandlerT m a <$ :: forall a b. a -> HandlerT m b -> HandlerT m a Functor, Applicative (HandlerT m) Applicative (HandlerT m) => (forall a b. HandlerT m a -> (a -> HandlerT m b) -> HandlerT m b) -> (forall a b. HandlerT m a -> HandlerT m b -> HandlerT m b) -> (forall a. a -> HandlerT m a) -> Monad (HandlerT m) forall a. a -> HandlerT m a forall a b. HandlerT m a -> HandlerT m b -> HandlerT m b forall a b. HandlerT m a -> (a -> HandlerT m b) -> HandlerT m b forall (m :: * -> *). Monad m => Applicative (HandlerT m) forall (m :: * -> *) a. Monad m => a -> HandlerT m a forall (m :: * -> *) a b. Monad m => HandlerT m a -> HandlerT m b -> HandlerT m b forall (m :: * -> *) a b. Monad m => HandlerT m a -> (a -> HandlerT m b) -> HandlerT m 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 $c>>= :: forall (m :: * -> *) a b. Monad m => HandlerT m a -> (a -> HandlerT m b) -> HandlerT m b >>= :: forall a b. HandlerT m a -> (a -> HandlerT m b) -> HandlerT m b $c>> :: forall (m :: * -> *) a b. Monad m => HandlerT m a -> HandlerT m b -> HandlerT m b >> :: forall a b. HandlerT m a -> HandlerT m b -> HandlerT m b $creturn :: forall (m :: * -> *) a. Monad m => a -> HandlerT m a return :: forall a. a -> HandlerT m a Monad) deriving newtype ((forall (m :: * -> *). Monad m => Monad (HandlerT m)) => (forall (m :: * -> *) a. Monad m => m a -> HandlerT m a) -> MonadTrans HandlerT forall (m :: * -> *). Monad m => Monad (HandlerT m) forall (m :: * -> *) a. Monad m => m a -> HandlerT m a forall (t :: (* -> *) -> * -> *). (forall (m :: * -> *). Monad m => Monad (t m)) => (forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t $clift :: forall (m :: * -> *) a. Monad m => m a -> HandlerT m a lift :: forall (m :: * -> *) a. Monad m => m a -> HandlerT m a MonadTrans, MonadTrans HandlerT MonadTrans HandlerT => (forall (m :: * -> *) a. Monad m => (Run HandlerT -> m a) -> HandlerT m a) -> (forall (m :: * -> *) a. Monad m => m (StT HandlerT a) -> HandlerT m a) -> MonadTransControl HandlerT forall (m :: * -> *) a. Monad m => m (StT HandlerT a) -> HandlerT m a forall (m :: * -> *) a. Monad m => (Run HandlerT -> m a) -> HandlerT m a forall (t :: (* -> *) -> * -> *). MonadTrans t => (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a) -> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a) -> MonadTransControl t $cliftWith :: forall (m :: * -> *) a. Monad m => (Run HandlerT -> m a) -> HandlerT m a liftWith :: forall (m :: * -> *) a. Monad m => (Run HandlerT -> m a) -> HandlerT m a $crestoreT :: forall (m :: * -> *) a. Monad m => m (StT HandlerT a) -> HandlerT m a restoreT :: forall (m :: * -> *) a. Monad m => m (StT HandlerT a) -> HandlerT m a MonadTransControl, MonadTransControl HandlerT MonadTransControl HandlerT => (forall (m :: * -> *) a. Monad m => ((forall x. HandlerT m x -> m x) -> m a) -> HandlerT m a) -> MonadTransControlIdentity HandlerT forall (m :: * -> *) a. Monad m => ((forall x. HandlerT m x -> m x) -> m a) -> HandlerT m a forall (t :: (* -> *) -> * -> *). MonadTransControl t => (forall (m :: * -> *) a. Monad m => ((forall x. t m x -> m x) -> m a) -> t m a) -> MonadTransControlIdentity t $cliftWithIdentity :: forall (m :: * -> *) a. Monad m => ((forall x. HandlerT m x -> m x) -> m a) -> HandlerT m a liftWithIdentity :: forall (m :: * -> *) a. Monad m => ((forall x. HandlerT m x -> m x) -> m a) -> HandlerT m a MonadTransControlIdentity) deriving newtype (MonadBase b, MonadBaseControl b, MonadBaseControlIdentity b) deriving newtype (Monad (HandlerT m) Monad (HandlerT m) => (forall a. IO a -> HandlerT m a) -> MonadIO (HandlerT m) forall a. IO a -> HandlerT m a forall (m :: * -> *). Monad m => (forall a. IO a -> m a) -> MonadIO m forall (m :: * -> *). MonadIO m => Monad (HandlerT m) forall (m :: * -> *) a. MonadIO m => IO a -> HandlerT m a $cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> HandlerT m a liftIO :: forall a. IO a -> HandlerT m a MonadIO, MonadIO (HandlerT m) MonadIO (HandlerT m) => (forall b. ((forall a. HandlerT m a -> IO a) -> IO b) -> HandlerT m b) -> MonadUnliftIO (HandlerT m) forall b. ((forall a. HandlerT m a -> IO a) -> IO b) -> HandlerT m b forall (m :: * -> *). MonadIO m => (forall b. ((forall a. m a -> IO a) -> IO b) -> m b) -> MonadUnliftIO m forall (m :: * -> *). MonadUnliftIO m => MonadIO (HandlerT m) forall (m :: * -> *) b. MonadUnliftIO m => ((forall a. HandlerT m a -> IO a) -> IO b) -> HandlerT m b $cwithRunInIO :: forall (m :: * -> *) b. MonadUnliftIO m => ((forall a. HandlerT m a -> IO a) -> IO b) -> HandlerT m b withRunInIO :: forall b. ((forall a. HandlerT m a -> IO a) -> IO b) -> HandlerT m b MonadUnliftIO) deriving newtype (Monad (HandlerT m) Monad (HandlerT m) => (forall e a. (HasCallStack, Exception e) => e -> HandlerT m a) -> MonadThrow (HandlerT m) forall e a. (HasCallStack, Exception e) => e -> HandlerT m a forall (m :: * -> *). Monad m => (forall e a. (HasCallStack, Exception e) => e -> m a) -> MonadThrow m forall (m :: * -> *). MonadThrow m => Monad (HandlerT m) forall (m :: * -> *) e a. (MonadThrow m, HasCallStack, Exception e) => e -> HandlerT m a $cthrowM :: forall (m :: * -> *) e a. (MonadThrow m, HasCallStack, Exception e) => e -> HandlerT m a throwM :: forall e a. (HasCallStack, Exception e) => e -> HandlerT m a MonadThrow, MonadThrow (HandlerT m) MonadThrow (HandlerT m) => (forall e a. (HasCallStack, Exception e) => HandlerT m a -> (e -> HandlerT m a) -> HandlerT m a) -> MonadCatch (HandlerT m) forall e a. (HasCallStack, Exception e) => HandlerT m a -> (e -> HandlerT m a) -> HandlerT m a forall (m :: * -> *). MonadThrow m => (forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a) -> MonadCatch m forall (m :: * -> *). MonadCatch m => MonadThrow (HandlerT m) forall (m :: * -> *) e a. (MonadCatch m, HasCallStack, Exception e) => HandlerT m a -> (e -> HandlerT m a) -> HandlerT m a $ccatch :: forall (m :: * -> *) e a. (MonadCatch m, HasCallStack, Exception e) => HandlerT m a -> (e -> HandlerT m a) -> HandlerT m a catch :: forall e a. (HasCallStack, Exception e) => HandlerT m a -> (e -> HandlerT m a) -> HandlerT m a MonadCatch, MonadCatch (HandlerT m) MonadCatch (HandlerT m) => (forall b. HasCallStack => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b) -> (forall b. HasCallStack => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b) -> (forall a b c. HasCallStack => HandlerT m a -> (a -> ExitCase b -> HandlerT m c) -> (a -> HandlerT m b) -> HandlerT m (b, c)) -> MonadMask (HandlerT m) forall b. HasCallStack => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b forall a b c. HasCallStack => HandlerT m a -> (a -> ExitCase b -> HandlerT m c) -> (a -> HandlerT m b) -> HandlerT m (b, c) forall (m :: * -> *). MonadMask m => MonadCatch (HandlerT m) forall (m :: * -> *) b. (MonadMask m, HasCallStack) => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b forall (m :: * -> *) a b c. (MonadMask m, HasCallStack) => HandlerT m a -> (a -> ExitCase b -> HandlerT m c) -> (a -> HandlerT m b) -> HandlerT m (b, c) forall (m :: * -> *). MonadCatch m => (forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b) -> (forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b) -> (forall a b c. HasCallStack => m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)) -> MonadMask m $cmask :: forall (m :: * -> *) b. (MonadMask m, HasCallStack) => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b mask :: forall b. HasCallStack => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b $cuninterruptibleMask :: forall (m :: * -> *) b. (MonadMask m, HasCallStack) => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b uninterruptibleMask :: forall b. HasCallStack => ((forall a. HandlerT m a -> HandlerT m a) -> HandlerT m b) -> HandlerT m b $cgeneralBracket :: forall (m :: * -> *) a b c. (MonadMask m, HasCallStack) => HandlerT m a -> (a -> ExitCase b -> HandlerT m c) -> (a -> HandlerT m b) -> HandlerT m (b, c) generalBracket :: forall a b c. HasCallStack => HandlerT m a -> (a -> ExitCase b -> HandlerT m c) -> (a -> HandlerT m b) -> HandlerT m (b, c) MonadMask) deriving newtype (Monad (HandlerT m) Monad (HandlerT m) => (forall msg. ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> HandlerT m ()) -> MonadLogger (HandlerT m) forall msg. ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> HandlerT m () forall (m :: * -> *). Monad m => (forall msg. ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m ()) -> MonadLogger m forall (m :: * -> *). MonadLoggerCustom m => Monad (HandlerT m) forall (m :: * -> *) msg. (MonadLoggerCustom m, ToLogStr msg) => Loc -> LogSource -> LogLevel -> msg -> HandlerT m () $cmonadLoggerLog :: forall (m :: * -> *) msg. (MonadLoggerCustom m, ToLogStr msg) => Loc -> LogSource -> LogLevel -> msg -> HandlerT m () monadLoggerLog :: forall msg. ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> HandlerT m () MonadLogger, MonadLogger (HandlerT m) HandlerT m Bool MonadLogger (HandlerT m) => HandlerT m Bool -> MonadLoggerCustom (HandlerT m) forall (m :: * -> *). MonadLogger m => m Bool -> MonadLoggerCustom m forall (m :: * -> *). MonadLoggerCustom m => MonadLogger (HandlerT m) forall (m :: * -> *). MonadLoggerCustom m => HandlerT m Bool $ccolorfulLogCapability :: forall (m :: * -> *). MonadLoggerCustom m => HandlerT m Bool colorfulLogCapability :: HandlerT m Bool MonadLoggerCustom) deriving newtype (Monad (HandlerT m) HandlerT m Configuration Monad (HandlerT m) => HandlerT m Configuration -> MonadConfigured (HandlerT m) forall (m :: * -> *). Monad m => m Configuration -> MonadConfigured m forall (m :: * -> *). MonadConfigured m => Monad (HandlerT m) forall (m :: * -> *). MonadConfigured m => HandlerT m Configuration $cconfiguration :: forall (m :: * -> *). MonadConfigured m => HandlerT m Configuration configuration :: HandlerT m Configuration MonadConfigured) deriving newtype (Monad (HandlerT m) HandlerT m Secrets Monad (HandlerT m) => HandlerT m Secrets -> MonadSecret (HandlerT m) forall (m :: * -> *). Monad m => m Secrets -> MonadSecret m forall (m :: * -> *). MonadSecret m => Monad (HandlerT m) forall (m :: * -> *). MonadSecret m => HandlerT m Secrets $csecrets :: forall (m :: * -> *). MonadSecret m => HandlerT m Secrets secrets :: HandlerT m Secrets MonadSecret) deriving newtype (Monad (HandlerT m) MonadMask (SeldaTransactionT (HandlerT m)) MonadSelda (SeldaTransactionT (HandlerT m)) (Monad (HandlerT m), MonadMask (SeldaTransactionT (HandlerT m)), MonadSelda (SeldaTransactionT (HandlerT m))) => (forall a. SeldaTransactionT (HandlerT m) a -> HandlerT m (SeldaResult a)) -> MonadSeldaPool (HandlerT m) forall a. SeldaTransactionT (HandlerT m) a -> HandlerT m (SeldaResult a) forall (m :: * -> *). (Monad m, MonadMask (SeldaTransactionT m), MonadSelda (SeldaTransactionT m)) => (forall a. SeldaTransactionT m a -> m (SeldaResult a)) -> MonadSeldaPool m forall (m :: * -> *). (MonadSeldaPool m, MonadMask m, MonadIO m) => Monad (HandlerT m) forall (m :: * -> *). (MonadSeldaPool m, MonadMask m, MonadIO m) => MonadMask (SeldaTransactionT (HandlerT m)) forall (m :: * -> *). (MonadSeldaPool m, MonadMask m, MonadIO m) => MonadSelda (SeldaTransactionT (HandlerT m)) forall (m :: * -> *) a. (MonadSeldaPool m, MonadMask m, MonadIO m) => SeldaTransactionT (HandlerT m) a -> HandlerT m (SeldaResult a) $crunSeldaTransactionT :: forall (m :: * -> *) a. (MonadSeldaPool m, MonadMask m, MonadIO m) => SeldaTransactionT (HandlerT m) a -> HandlerT m (SeldaResult a) runSeldaTransactionT :: forall a. SeldaTransactionT (HandlerT m) a -> HandlerT m (SeldaResult a) MonadSeldaPool) deriving newtype (Monad (HandlerT m) Monad (HandlerT m) => (Email -> HandlerT m SendEmailResult) -> MonadEmail (HandlerT m) Email -> HandlerT m SendEmailResult forall (m :: * -> *). Monad m => (Email -> m SendEmailResult) -> MonadEmail m forall (m :: * -> *). MonadEmail m => Monad (HandlerT m) forall (m :: * -> *). MonadEmail m => Email -> HandlerT m SendEmailResult $csendEmail :: forall (m :: * -> *). MonadEmail m => Email -> HandlerT m SendEmailResult sendEmail :: Email -> HandlerT m SendEmailResult MonadEmail) runHandlerT :: (MonadIO m, MonadLoggerCustom m) => Hash -> HandlerT m a -> m a runHandlerT :: forall (m :: * -> *) a. (MonadIO m, MonadLoggerCustom m) => Hash -> HandlerT m a -> m a runHandlerT Hash randomHash HandlerT m a handler = do LogSource -> m () forall (m :: * -> *). (HasCallStack, MonadLogger m) => LogSource -> m () logInfo LogSource "Starting HTTP request handler." let runTransformers :: RunStackT Transformers m a runTransformers = RunStackT NilT m a forall (b :: * -> *) c. RunStackT NilT b c RunNilT RunStackT NilT m a -> (RequestHashT (StackT NilT m) a -> StackT NilT m a) -> RunStackT (NilT :.|> RequestHashT) m a forall (ts :: Stack) (b :: * -> *) c (t :: (* -> *) -> * -> *). RunStackT ts b c -> (t (StackT ts b) c -> StackT ts b c) -> RunStackT (ts :.|> t) b c :..> Hash -> RequestHashT (Elevator NoT m) a -> Elevator NoT m a forall (m :: * -> *) a. Hash -> RequestHashT m a -> m a runRequestHashT Hash randomHash RunStackT (NilT :.|> RequestHashT) m a -> (ProfilerT (StackT (NilT :.|> RequestHashT) m) a -> StackT (NilT :.|> RequestHashT) m a) -> RunStackT Transformers m a forall (ts :: Stack) (b :: * -> *) c (t :: (* -> *) -> * -> *). RunStackT ts b c -> (t (StackT ts b) c -> StackT ts b c) -> RunStackT (ts :.|> t) b c :..> ProfilerT (ComposeT RequestHashT TransparentT m) a -> ComposeT RequestHashT TransparentT m a ProfilerT (StackT (NilT :.|> RequestHashT) m) a -> StackT (NilT :.|> RequestHashT) m a forall (m :: * -> *) a. (MonadIO m, MonadLogger m) => ProfilerT m a -> m a runProfilerT RunStackT Transformers m a -> StackT Transformers m a -> m a forall (ts :: Stack) (m :: * -> *) a. RunStackT ts m a -> StackT ts m a -> m a runStackT RunStackT Transformers m a runTransformers (StackT Transformers m a -> m a) -> StackT Transformers m a -> m a forall a b. (a -> b) -> a -> b $ HandlerT m a -> StackT Transformers m a forall (m :: * -> *) a. HandlerT m a -> StackT Transformers m a unHandlerT HandlerT m a handler