module Network.Wai.Middleware.Stats ( requestStats ) where import Freckle.App.Prelude import Control.Monad.Reader (runReaderT) import Freckle.App.Stats (HasStatsClient) import qualified Freckle.App.Stats as Stats import Network.HTTP.Types.Status (Status(..)) import Network.Wai (Middleware, Request, requestMethod, responseStatus) requestStats :: HasStatsClient env => env -> (Request -> [(Text, Text)]) -> Middleware requestStats :: forall env. HasStatsClient env => env -> (Request -> [(Text, Text)]) -> Middleware requestStats env env Request -> [(Text, Text)] getTags Application app Request req Response -> IO ResponseReceived respond = do UTCTime start <- IO UTCTime getCurrentTime Application app Request req forall a b. (a -> b) -> a -> b $ \Response res -> do let tags :: [(Text, Text)] tags = Request -> [(Text, Text)] getTags Request req forall a. Semigroup a => a -> a -> a <> [ (Text "method", ByteString -> Text decodeUtf8 forall a b. (a -> b) -> a -> b $ Request -> ByteString requestMethod Request req) , (Text "status", String -> Text pack forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show forall a b. (a -> b) -> a -> b $ Status -> Int statusCode forall a b. (a -> b) -> a -> b $ Response -> Status responseStatus Response res) ] forall a b c. (a -> b -> c) -> b -> a -> c flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT env env forall a b. (a -> b) -> a -> b $ forall env (m :: * -> *) a. (MonadReader env m, HasStatsClient env) => [(Text, Text)] -> m a -> m a Stats.tagged [(Text, Text)] tags forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) env. (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => Text -> m () Stats.increment Text "requests" forall (m :: * -> *) env. (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => Text -> UTCTime -> m () Stats.histogramSinceMs Text "response_time_ms" UTCTime start Response -> IO ResponseReceived respond Response res