Haskell Servant - login endpoint with two error states Here is one a handler for dealing with logins, I've recently refactored it to try and make dealing with the different error cases a bit more elegant, though I still think there is room for improvement:

import Config
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types
import Data.Bifunctor (bimap)
import Data.Char
import Data.List as List
import Data.Text.Lazy
import Data.Text.Lazy.Encoding
import Database.Persist
import Database.Persist.Postgresql
import GHC.Generics
import Servant
import Servant.Auth.Server
import Types (Account(..))
import Queries

type Route = "login" :&gt; ReqBody '[JSON] Credentials :&gt; Post '[JSON] LoginAttempt

instance FromJWT (Key Account)
instance ToJWT (Key Account)

data Credentials = Credentials
    { loginEmail :: String
    , loginPass  :: String
    } deriving (Eq, Show, Read, Generic)

instance FromJSON Credentials

instance ToJSON Credentials where
    toJSON creds =
        object
            [ "account" .= loginEmail creds
            ]

data LoginAttempt
    = Ok { authToken :: Text }
    | AuthenticationErr
    | TokenGenerationErr
    deriving (Generic)

instance ToJSON LoginAttempt where
    toJSON (Ok token) =
        object [ "token" .= token ]
    toJSON AuthenticationErr =
        object [ "error" .= ("Invalid username or password" :: Text) ]
    toJSON TokenGenerationErr =
        object [ "error" .= ("Error generating token" :: Text) ]

action :: Config -&gt; JWTSettings -&gt; Credentials -&gt; Handler LoginAttempt
action config jwt (Credentials email pass) = do
  login &lt;- runSqlPool (Queries.validateAccount email pass) $ getPool config
  result &lt;- either (const $ return AuthenticationErr) generateToken login
  case result of
    AuthenticationErr -&gt; throwError $ err401 { errBody = encode . toJSON $ result }
    TokenGenerationErr -&gt; throwError $ err500 { errBody = encode . toJSON $ result }
    _ -&gt; return result
  where
    generateToken :: Key Account -&gt; Handler LoginAttempt
    generateToken k = do
      token &lt;- liftIO $ makeJWT k jwt Nothing
      pure $ either (const TokenGenerationErr) (Ok . decodeUtf8) token
Since the Handler LoginAttempt from action only ever contains Ok, its result should instead be Handler Text. And then nobody ever sees a LoginAttempt object, so we don't need it.

action :: Config -&gt; JWTSettings -&gt; Credentials -&gt; Handler Text
action config jwt (Credentials email pass) = do
  login &lt;- either authenticationError pure =&lt;&lt;
    runSqlPool (Queries.validateAccount email pass) (getPool config)
  token &lt;- either tokenGenerationError pure =&lt;&lt;
    liftIO (makeJWT login jwt Nothing)
  pure $ decodeUtf8 token -- perhaps: pure $ decode $ object [ "token" .= decodeUtf8 token ]
  where
    autheticationError   _ = throwError $ err401 { errBody = encode $ object [ "error" .= ("Invalid username or password" :: Text) ] }
    tokenGenerationError _ = throwError $ err500 { errBody = encode $ object [ "error" .= ("Error generating token"       :: Text) ] }