module Ratel.Wai ( ratelMiddleware, toRequest ) where import qualified Control.Concurrent as Concurrent import qualified Control.Exception as Exception 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 :: ApiKey -> Maybe Manager -> (Payload -> IO Payload) -> Middleware ratelMiddleware ApiKey apiKey Maybe Manager maybeManager Payload -> IO Payload modify Application handle Request request Response -> IO ResponseReceived respond = do IO ResponseReceived -> (SomeException -> IO ResponseReceived) -> IO ResponseReceived 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 = SomeException -> Error 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 = Server :: Maybe ApiKey -> Maybe ApiKey -> Maybe Project -> Server Ratel.Server { serverEnvironmentName :: Maybe ApiKey Ratel.serverEnvironmentName = Maybe ApiKey forall a. Maybe a Nothing , serverHostname :: Maybe ApiKey Ratel.serverHostname = Maybe ApiKey forall a. Maybe a Nothing , serverProjectRoot :: Maybe Project Ratel.serverProjectRoot = Maybe Project forall a. Maybe a Nothing } Payload payload <- Payload -> IO Payload modify Payload :: Error -> Maybe Notifier -> Maybe Request -> Server -> Payload Ratel.Payload { payloadError :: Error Ratel.payloadError = Error err , payloadNotifier :: Maybe Notifier Ratel.payloadNotifier = Maybe Notifier forall a. Maybe a Nothing , payloadRequest :: Maybe Request Ratel.payloadRequest = Request -> Maybe Request forall a. a -> Maybe a Just Request req , payloadServer :: Server Ratel.payloadServer = Server server } ThreadId _ <- IO () -> IO ThreadId Concurrent.forkIO (do UUID _ <- ApiKey -> Maybe Manager -> Payload -> IO UUID Ratel.notify ApiKey apiKey Maybe Manager maybeManager Payload payload () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return ()) SomeException -> IO ResponseReceived forall e a. Exception e => e -> IO a Exception.throwIO SomeException exception) toRequest :: Wai.Request -> Ratel.Request toRequest :: Request -> Request toRequest Request request = Request :: Maybe ApiKey -> Maybe (Map ApiKey ApiKey) -> Maybe ApiKey -> Maybe (Map ApiKey Value) -> Maybe (Map ApiKey ApiKey) -> Maybe (Map ApiKey ApiKey) -> Maybe ApiKey -> Request Ratel.Request { requestAction :: Maybe ApiKey Ratel.requestAction = Maybe ApiKey forall a. Maybe a Nothing , requestCgiData :: Maybe (Map ApiKey ApiKey) Ratel.requestCgiData = Map ApiKey ApiKey -> Maybe (Map ApiKey ApiKey) forall a. a -> Maybe a Just (Map ApiKey ApiKey -> Map ApiKey ApiKey -> Map ApiKey ApiKey forall k a. Ord k => Map k a -> Map k a -> Map k a Map.union ([(ApiKey, ApiKey)] -> Map ApiKey ApiKey forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [ (ApiKey "REMOTE_ADDR", SockAddr -> ApiKey forall a. Show a => a -> ApiKey show (Request -> SockAddr Wai.remoteHost Request request)) , (ApiKey "REQUEST_METHOD", ByteString -> ApiKey BS.unpack (Request -> ByteString Wai.requestMethod Request request)) ]) ([(ApiKey, ApiKey)] -> Map ApiKey ApiKey forall k a. Ord k => [(k, a)] -> Map k a Map.fromList (((CI ByteString, ByteString) -> (ApiKey, ApiKey)) -> [(CI ByteString, ByteString)] -> [(ApiKey, ApiKey)] forall a b. (a -> b) -> [a] -> [b] map (\ (CI ByteString k, ByteString v) -> (ApiKey "HTTP_" ApiKey -> ApiKey -> ApiKey forall a. [a] -> [a] -> [a] ++ (Char -> Char) -> ApiKey -> ApiKey forall a b. (a -> b) -> [a] -> [b] map (\ Char c -> if Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '-' then Char '_' else Char -> Char Char.toUpper Char c) (ByteString -> ApiKey BS.unpack (CI ByteString -> ByteString forall s. CI s -> s CI.foldedCase CI ByteString k)), ByteString -> ApiKey BS.unpack ByteString v)) (Request -> [(CI ByteString, ByteString)] Wai.requestHeaders Request request)))) , requestComponent :: Maybe ApiKey Ratel.requestComponent = Maybe ApiKey forall a. Maybe a Nothing , requestContext :: Maybe (Map ApiKey Value) Ratel.requestContext = Maybe (Map ApiKey Value) forall a. Maybe a Nothing , requestParams :: Maybe (Map ApiKey ApiKey) Ratel.requestParams = Map ApiKey ApiKey -> Maybe (Map ApiKey ApiKey) forall a. a -> Maybe a Just ([(ApiKey, ApiKey)] -> Map ApiKey ApiKey forall k a. Ord k => [(k, a)] -> Map k a Map.fromList (((ByteString, Maybe ByteString) -> (ApiKey, ApiKey)) -> [(ByteString, Maybe ByteString)] -> [(ApiKey, ApiKey)] forall a b. (a -> b) -> [a] -> [b] map (\ (ByteString k, Maybe ByteString v) -> (ByteString -> ApiKey BS.unpack ByteString k, ApiKey -> (ByteString -> ApiKey) -> Maybe ByteString -> ApiKey forall b a. b -> (a -> b) -> Maybe a -> b maybe ApiKey "" ByteString -> ApiKey BS.unpack Maybe ByteString v)) (Request -> [(ByteString, Maybe ByteString)] Wai.queryString Request request))) , requestSession :: Maybe (Map ApiKey ApiKey) Ratel.requestSession = Maybe (Map ApiKey ApiKey) forall a. Maybe a Nothing , requestUrl :: Maybe ApiKey Ratel.requestUrl = ApiKey -> Maybe ApiKey forall a. a -> Maybe a Just (ByteString -> ApiKey BS.unpack (Request -> ByteString Wai.rawPathInfo Request request) ApiKey -> ApiKey -> ApiKey forall a. [a] -> [a] -> [a] ++ ByteString -> ApiKey BS.unpack (Request -> ByteString Wai.rawQueryString Request request)) }