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" :> ReqBody '[JSON] Credentials :> 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 -> JWTSettings -> Credentials -> Handler LoginAttempt action config jwt (Credentials email pass) = do login <- runSqlPool (Queries.validateAccount email pass) $ getPool config result <- either (const $ return AuthenticationErr) generateToken login case result of AuthenticationErr -> throwError $ err401 { errBody = encode . toJSON $ result } TokenGenerationErr -> throwError $ err500 { errBody = encode . toJSON $ result } _ -> return result where generateToken :: Key Account -> Handler LoginAttempt generateToken k = do token <- liftIO $ makeJWT k jwt Nothing pure $ either (const TokenGenerationErr) (Ok . decodeUtf8) token 
