如何在自定义servant处理程序中响应HTTP状态？

Question

我创建了一个自定义仆人处理程序

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状态码？

Answer 1

您需要将

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

，Servant 将捕获并使用它来返回 HTTP 404。然后，自然转换

ExceptT ServantErr . ReaderT (TVar ...) :~> ExceptT ServantErr

将必须展开并重新包装，以释放阅读器效果。总而言之，代码并不多。

Answer 2

您可以在您的处理程序中使用UVerb，然后响应WithStatus：

type API =
         "fisx"  :> Capture "bool" Bool
         :> UVerb 'GET '[JSON] '[WithStatus 200 Int, WithStatus 303 String]

fisx :: Bool -> Handler (Union '[WithStatus 200 Int, WithStatus 303 String])
fisx True = respond (WithStatus @200 5)
fisx False = respond (WithStatus @303 ("still fisx" :: String))

cf https://docs.servant.dev/en/stable/cookbook/uverb/UVerb.html