如何在自定义服务处理程序中响应 HTTP 状态?
How to response with HTTP status in custom servant handler?
我创建了一个自定义仆人处理程序
type ServiceSet = TVar (M.Map String [MicroService])
type LocalHandler = ReaderT ServiceSet IO
但我未能找到一种方法来在以下函数中向客户端响应 404-not-found 状态代码:
getService :: String -> LocalHandler MicroService
getService sn = do
tvar <- ask
ms <- liftIO $ do
sl <- atomically $ do
sm <- readTVar tvar
return $ case M.lookup sn sm of
Nothing -> []
Just sl -> sl
let n = length sl
i <- randomRIO (0, n - 1)
return $ if n == 0
then Nothing
else Just . head . drop i $ sl
case ms of
Nothing -> ??? -- throwError err404
Just ms' -> return ms'
如何在???
中发送404状态码?
您需要将 ExceptT
添加到您的 monad 转换堆栈中。现在,只有 ReaderT
,无法对抛出错误的概念进行编码。
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Lib where
import Control.Monad.Except
import Control.Monad.Reader
import Data.Maybe
import Data.Map
import GHC.Conc
import Prelude hiding (lookup)
import Servant.API
import Servant.Server
import System.Random
type API =
Capture "name" String :> Get '[JSON] Int
type World =
TVar (Map String [Int])
type Effects =
ExceptT ServantErr (ReaderT World IO)
server :: World -> Server API
server world =
enter (Nat transform) get
where
transform :: Effects a -> ExceptT ServantErr IO a
transform (ExceptT foo) =
ExceptT $ runReaderT foo world
get :: String -> Effects Int
get sn = do
tvar <- ask
ms <- liftIO $ do
sl <- atomically $ do
sm <- readTVar tvar
return (fromMaybe [] (lookup sn sm))
let n = length sl
i <- randomRIO (0, n - 1)
return $ if n == 0
then Nothing
else Just . head . drop i $ sl
case ms of
Nothing ->
throwError err404
Just ms' ->
return ms'
使用 ExceptT ServantErr . ReaderT (TVar ...)
然后您可以 throwError err404
,仆人将捕获并用于 return HTTP 404。然后自然转换 ExceptT ServantErr . ReaderT (TVar ...) :~> ExceptT ServantErr
将不得不展开和重新包装以释放 reader 效果。总而言之,代码并不多。
我创建了一个自定义仆人处理程序
type ServiceSet = TVar (M.Map String [MicroService])
type LocalHandler = ReaderT ServiceSet IO
但我未能找到一种方法来在以下函数中向客户端响应 404-not-found 状态代码:
getService :: String -> LocalHandler MicroService
getService sn = do
tvar <- ask
ms <- liftIO $ do
sl <- atomically $ do
sm <- readTVar tvar
return $ case M.lookup sn sm of
Nothing -> []
Just sl -> sl
let n = length sl
i <- randomRIO (0, n - 1)
return $ if n == 0
then Nothing
else Just . head . drop i $ sl
case ms of
Nothing -> ??? -- throwError err404
Just ms' -> return ms'
如何在???
中发送404状态码?
您需要将 ExceptT
添加到您的 monad 转换堆栈中。现在,只有 ReaderT
,无法对抛出错误的概念进行编码。
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Lib where
import Control.Monad.Except
import Control.Monad.Reader
import Data.Maybe
import Data.Map
import GHC.Conc
import Prelude hiding (lookup)
import Servant.API
import Servant.Server
import System.Random
type API =
Capture "name" String :> Get '[JSON] Int
type World =
TVar (Map String [Int])
type Effects =
ExceptT ServantErr (ReaderT World IO)
server :: World -> Server API
server world =
enter (Nat transform) get
where
transform :: Effects a -> ExceptT ServantErr IO a
transform (ExceptT foo) =
ExceptT $ runReaderT foo world
get :: String -> Effects Int
get sn = do
tvar <- ask
ms <- liftIO $ do
sl <- atomically $ do
sm <- readTVar tvar
return (fromMaybe [] (lookup sn sm))
let n = length sl
i <- randomRIO (0, n - 1)
return $ if n == 0
then Nothing
else Just . head . drop i $ sl
case ms of
Nothing ->
throwError err404
Just ms' ->
return ms'
使用 ExceptT ServantErr . ReaderT (TVar ...)
然后您可以 throwError err404
,仆人将捕获并用于 return HTTP 404。然后自然转换 ExceptT ServantErr . ReaderT (TVar ...) :~> ExceptT ServantErr
将不得不展开和重新包装以释放 reader 效果。总而言之,代码并不多。