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