CODEWITHSUNDEEP
haskellservant
Zale
Zale

Reputation: 133

How to response with HTTP status in custom servant handler?

I created a custom servant handler

type ServiceSet = TVar (M.Map String [MicroService])
type LocalHandler = ReaderT ServiceSet IO

But i failed to find a way to response a 404-not-found status code to client in following function:

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'

how to send 404 status code in ????

Upvotes: 2

Views: 1342

Answers (2)

Jappie Kerk
Jappie Kerk

Reputation: 1307

you can use UVerb in yor handlers and then respond 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

Upvotes: 0

hao
hao

Reputation: 10238

You will need to add ExceptT to your stack of monad transforms. Right now, with just ReaderT, there is no way to encode the notion of an error being thrown.

{-# 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'

With ExceptT ServantErr . ReaderT (TVar ...) you can then throwError err404, which Servant will catch and use to return an HTTP 404. The natural transformation ExceptT ServantErr . ReaderT (TVar ...) :~> ExceptT ServantErr will then have to unwrap and rewrap in order to discharge the reader effect. All in all, not terribly more code.

Upvotes: 5

Related Questions