{-# LANGUAGE DerivingVia, DeriveAnyClass, ScopedTypeVariables #-}
module Twirp.Middleware.Errors where

import Data.Aeson
import GHC.Generics
import Network.HTTP.Types
import Network.Wai

data TwirpError = TwirpError { TwirpError -> String
code :: String, TwirpError -> String
msg :: String }
  deriving stock (TwirpError -> TwirpError -> Bool
(TwirpError -> TwirpError -> Bool)
-> (TwirpError -> TwirpError -> Bool) -> Eq TwirpError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwirpError -> TwirpError -> Bool
$c/= :: TwirpError -> TwirpError -> Bool
== :: TwirpError -> TwirpError -> Bool
$c== :: TwirpError -> TwirpError -> Bool
Eq, Int -> TwirpError -> ShowS
[TwirpError] -> ShowS
TwirpError -> String
(Int -> TwirpError -> ShowS)
-> (TwirpError -> String)
-> ([TwirpError] -> ShowS)
-> Show TwirpError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwirpError] -> ShowS
$cshowList :: [TwirpError] -> ShowS
show :: TwirpError -> String
$cshow :: TwirpError -> String
showsPrec :: Int -> TwirpError -> ShowS
$cshowsPrec :: Int -> TwirpError -> ShowS
Show, (forall x. TwirpError -> Rep TwirpError x)
-> (forall x. Rep TwirpError x -> TwirpError) -> Generic TwirpError
forall x. Rep TwirpError x -> TwirpError
forall x. TwirpError -> Rep TwirpError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TwirpError x -> TwirpError
$cfrom :: forall x. TwirpError -> Rep TwirpError x
Generic)
  deriving anyclass ([TwirpError] -> Encoding
[TwirpError] -> Value
TwirpError -> Encoding
TwirpError -> Value
(TwirpError -> Value)
-> (TwirpError -> Encoding)
-> ([TwirpError] -> Value)
-> ([TwirpError] -> Encoding)
-> ToJSON TwirpError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TwirpError] -> Encoding
$ctoEncodingList :: [TwirpError] -> Encoding
toJSONList :: [TwirpError] -> Value
$ctoJSONList :: [TwirpError] -> Value
toEncoding :: TwirpError -> Encoding
$ctoEncoding :: TwirpError -> Encoding
toJSON :: TwirpError -> Value
$ctoJSON :: TwirpError -> Value
ToJSON)

-- Rewrite error responses to use Twirp's error codes and JSON encoding.
-- See: https://github.com/twitchtv/twirp/blob/master/docs/errors.md
twirpErrorResponses :: Middleware
twirpErrorResponses :: Middleware
twirpErrorResponses = (Response -> Response) -> Middleware
modifyResponse Response -> Response
go
  where
    go :: Response -> Response
go Response
response = let status :: Status
status = Response -> Status
responseStatus Response
response in
      case Status -> Int
statusCode Status
status of
        Int
400 -> Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status ResponseHeaders
headers (TwirpError -> ByteString
forall a. ToJSON a => a -> ByteString
encode TwirpError
badRequest)
        Int
404 -> Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status ResponseHeaders
headers (TwirpError -> ByteString
forall a. ToJSON a => a -> ByteString
encode TwirpError
notFound)
        Int
408 -> Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status ResponseHeaders
headers (TwirpError -> ByteString
forall a. ToJSON a => a -> ByteString
encode TwirpError
canceled)
        Int
500 -> Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status ResponseHeaders
headers (TwirpError -> ByteString
forall a. ToJSON a => a -> ByteString
encode TwirpError
serverError)
        Int
503 -> Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status ResponseHeaders
headers (TwirpError -> ByteString
forall a. ToJSON a => a -> ByteString
encode TwirpError
unavailable)
        Int
_   -> Response
response

    headers :: ResponseHeaders
headers = [(HeaderName
hContentType, ByteString
"application/json; charset=utf-8")]

    badRequest :: TwirpError
badRequest = String -> String -> TwirpError
TwirpError String
"invalid_argument" String
"Bad Request"
    notFound :: TwirpError
notFound = String -> String -> TwirpError
TwirpError String
"not_found" String
"Not found"
    canceled :: TwirpError
canceled = String -> String -> TwirpError
TwirpError String
"canceled" String
"Request Timeout"
    unavailable :: TwirpError
unavailable = String -> String -> TwirpError
TwirpError String
"unavailable" String
"Service Unavailable"
    serverError :: TwirpError
serverError = String -> String -> TwirpError
TwirpError String
"internal" String
"Internal Server Error"