module Ratel.Wai ( ratelMiddleware, toRequest, ) where import qualified Control.Concurrent as Concurrent import qualified Control.Exception as Exception import qualified Data.Bifunctor as Bifunctor import qualified Data.ByteString.Char8 as BS import qualified Data.CaseInsensitive as CI import qualified Data.Char as Char import qualified Data.Map as Map import qualified Network.HTTP.Client as Client import qualified Network.Wai as Wai import qualified Ratel ratelMiddleware :: Ratel.ApiKey -> Maybe Client.Manager -> (Ratel.Payload -> IO Ratel.Payload) -> Wai.Middleware ratelMiddleware :: String -> Maybe Manager -> (Payload -> IO Payload) -> Middleware ratelMiddleware String apiKey Maybe Manager maybeManager Payload -> IO Payload modify Application handle Request request Response -> IO ResponseReceived respond = do forall e a. Exception e => IO a -> (e -> IO a) -> IO a Exception.catch ( do Application handle Request request ( \Response response -> do Response -> IO ResponseReceived respond Response response ) ) ( \SomeException exception -> do let err :: Error err = forall exception. (Exception exception, HasCallStack) => exception -> Error Ratel.toError (SomeException exception :: Exception.SomeException) let req :: Request req = Request -> Request toRequest Request request let server :: Server server = Ratel.Server { serverEnvironmentName :: Maybe String Ratel.serverEnvironmentName = forall a. Maybe a Nothing, serverHostname :: Maybe String Ratel.serverHostname = forall a. Maybe a Nothing, serverProjectRoot :: Maybe Project Ratel.serverProjectRoot = forall a. Maybe a Nothing } Payload payload <- Payload -> IO Payload modify Ratel.Payload { payloadError :: Error Ratel.payloadError = Error err, payloadNotifier :: Maybe Notifier Ratel.payloadNotifier = forall a. Maybe a Nothing, payloadRequest :: Maybe Request Ratel.payloadRequest = forall a. a -> Maybe a Just Request req, payloadServer :: Server Ratel.payloadServer = Server server } ThreadId _ <- IO () -> IO ThreadId Concurrent.forkIO ( do UUID _ <- String -> Maybe Manager -> Payload -> IO UUID Ratel.notify String apiKey Maybe Manager maybeManager Payload payload forall (f :: * -> *) a. Applicative f => a -> f a pure () ) forall e a. Exception e => e -> IO a Exception.throwIO SomeException exception ) toRequest :: Wai.Request -> Ratel.Request toRequest :: Request -> Request toRequest Request request = Ratel.Request { requestAction :: Maybe String Ratel.requestAction = forall a. Maybe a Nothing, requestCgiData :: Maybe (Map String String) Ratel.requestCgiData = forall a. a -> Maybe a Just ( forall k a. Ord k => Map k a -> Map k a -> Map k a Map.union ( forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [ (String "REMOTE_ADDR", forall a. Show a => a -> String show (Request -> SockAddr Wai.remoteHost Request request)), (String "REQUEST_METHOD", ByteString -> String BS.unpack (Request -> ByteString Wai.requestMethod Request request)) ] ) ( forall k a. Ord k => [(k, a)] -> Map k a Map.fromList ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ( \(CI ByteString k, ByteString v) -> ( String "HTTP_" forall a. Semigroup a => a -> a -> a <> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\Char c -> if Char c forall a. Eq a => a -> a -> Bool == Char '-' then Char '_' else Char -> Char Char.toUpper Char c) (ByteString -> String BS.unpack (forall s. CI s -> s CI.foldedCase CI ByteString k)), ByteString -> String BS.unpack ByteString v ) ) (Request -> RequestHeaders Wai.requestHeaders Request request) ) ) ), requestComponent :: Maybe String Ratel.requestComponent = forall a. Maybe a Nothing, requestContext :: Maybe (Map String Value) Ratel.requestContext = forall a. Maybe a Nothing, requestParams :: Maybe (Map String String) Ratel.requestParams = forall a. a -> Maybe a Just ( forall k a. Ord k => [(k, a)] -> Map k a Map.fromList ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d Bifunctor.bimap ByteString -> String BS.unpack (forall b a. b -> (a -> b) -> Maybe a -> b maybe String "" ByteString -> String BS.unpack)) (Request -> Query Wai.queryString Request request) ) ), requestSession :: Maybe (Map String String) Ratel.requestSession = forall a. Maybe a Nothing, requestUrl :: Maybe String Ratel.requestUrl = forall a. a -> Maybe a Just ( ByteString -> String BS.unpack (Request -> ByteString Wai.rawPathInfo Request request) forall a. Semigroup a => a -> a -> a <> ByteString -> String BS.unpack (Request -> ByteString Wai.rawQueryString Request request) ) }