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))
        }