Question

我正在尝试在我的happstack应用程序中存储所有200个响应代码的计数器。

module Main where

import Happstack.Server

import Control.Concurrent
import Control.Monad.IO.Class ( liftIO )
import Control.Monad

main :: IO ()
main = do
  counter <- (newMVar 0) :: IO (MVar Integer)

  simpleHTTP nullConf $ countResponses counter (app counter)

countResponses :: MVar Integer -> ServerPart Response -> ServerPart Response
countResponses counter r = do
  resp <- r
  liftIO $ putStrLn $ show resp
  -- TODO: Does not work, response code always 200
  if rsCode resp == 200
    then liftIO $ (putMVar counter . (+) 1) =<< takeMVar counter
    else liftIO $ putStrLn $ "Unknown code: " ++ (show $ rsCode resp)
  return resp

app counter = do
  c <- liftIO $ readMVar counter

  msum
    [ dir "error" $ notFound $ toResponse $ "NOT HERE"
    , ok $ toResponse $ "Hello, World! " ++ (show c)
    ]

据我所知，问题是notFound添加了一个设置代码的过滤器，该代码在我检查响应时尚未运行。

我无法使用自己的过滤器，因为它有类型Response -> Response，我需要在IO monad中访问mvar。我发现mapServerPartT看起来似乎可以挂钩我自己的代码，但是我不太确定在这种情况下这是否过度。

我确实发现simpleHttp''似乎直接调用runWebT，然后在我可以挂钩的任何代码的之外运行appFilterToResp 。也许我必须建立自己的simpleHttp''版本？

更新：这是有效的，这是最好的方法吗？

-- Use this instead of simpleHTTP withMetrics :: (ToMessage a) => MVar Integer -> Conf -> ServerPartT IO a -> IO () withMetrics counter conf hs = Listen.listen conf (\req -> (simpleHTTP'' (mapServerPartT id hs) req) >>= runValidator (fromMaybe return (validator conf)) >>= countResponses counter)

一个可能相关的问题：我也希望能够对请求进行计时，这意味着我必须在请求周期结束时挂钩可能是同一个位置。

更新2：我能够获得请求的时间安排：

logMessage x = logM "Happstack.Server.AccessLog.Combined" INFO x withMetrics :: (ToMessage a) => Conf -> ServerPartT IO a -> IO () withMetrics conf hs = Listen.listen conf $ \req -> do startTime <- liftIO $ getCurrentTime resp <- simpleHTTP'' (mapServerPartT id hs) req validatedResp <- runValidator (fromMaybe return (validator conf)) resp endTime <- liftIO $ getCurrentTime logMessage $ rqUri req ++ " " ++ show (diffUTCTime endTime startTime) return validatedResp

如何在happstack中访问响应代码？

0 个答案: