servant/servant-server/src/Servant/Server/Internal/ServantErr.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Servant.Server.Internal.ServantErr where

import           Control.Exception (Exception)
import           Control.Monad.Trans.Except (ExceptT)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy  as LBS
import           Data.Typeable (Typeable)
import qualified Network.HTTP.Types    as HTTP
import           Network.Wai           (Response, responseLBS)

data ServantErr = ServantErr { errHTTPCode     :: Int
                             , errReasonPhrase :: String
                             , errBody         :: LBS.ByteString
                             , errHeaders      :: [HTTP.Header]
                             } deriving (Show, Eq, Read, Typeable)

instance Exception ServantErr

type Handler = ExceptT ServantErr IO

responseServantErr :: ServantErr -> Response
responseServantErr ServantErr{..} = responseLBS status errHeaders errBody
  where
    status = HTTP.mkStatus errHTTPCode (BS.pack errReasonPhrase)

-- | 'err300' Multiple Choices
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err300 { errBody = "I can't choose." }
--
err300 :: ServantErr
err300 = ServantErr { errHTTPCode = 300
                    , errReasonPhrase = "Multiple Choices"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err301' Moved Permanently
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err301
--
err301 :: ServantErr
err301 = ServantErr { errHTTPCode = 301
                    , errReasonPhrase = "Moved Permanently"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err302' Found
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err302
--
err302 :: ServantErr
err302 = ServantErr { errHTTPCode = 302
                    , errReasonPhrase = "Found"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err303' See Other
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err303
--
err303 :: ServantErr
err303 = ServantErr { errHTTPCode = 303
                    , errReasonPhrase = "See Other"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err304' Not Modified
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err304
--
err304 :: ServantErr
err304 = ServantErr { errHTTPCode = 304
                    , errReasonPhrase = "Not Modified"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err305' Use Proxy
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err305
--
err305 :: ServantErr
err305 = ServantErr { errHTTPCode = 305
                    , errReasonPhrase = "Use Proxy"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err307' Temporary Redirect
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err307
--
err307 :: ServantErr
err307 = ServantErr { errHTTPCode = 307
                    , errReasonPhrase = "Temporary Redirect"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err400' Bad Request
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err400 { errBody = "Your request makes no sense to me." }
--
err400 :: ServantErr
err400 = ServantErr { errHTTPCode = 400
                    , errReasonPhrase = "Bad Request"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err401' Unauthorized
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err401 { errBody = "Your credentials are invalid." }
--
err401 :: ServantErr
err401 = ServantErr { errHTTPCode = 401
                    , errReasonPhrase = "Unauthorized"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err402' Payment Required
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err402 { errBody = "You have 0 credits. Please give me $$$." }
--
err402 :: ServantErr
err402 = ServantErr { errHTTPCode = 402
                    , errReasonPhrase = "Payment Required"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err403' Forbidden
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err403 { errBody = "Please login first." }
--
err403 :: ServantErr
err403 = ServantErr { errHTTPCode = 403
                    , errReasonPhrase = "Forbidden"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err404' Not Found
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err404 { errBody = "(╯°□°）╯︵ ┻━┻)." }
--
err404 :: ServantErr
err404 = ServantErr { errHTTPCode = 404
                    , errReasonPhrase = "Not Found"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err405' Method Not Allowed
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err405 { errBody = "Your account privileges does not allow for this.  Please pay $$$." }
--
err405 :: ServantErr
err405 = ServantErr { errHTTPCode = 405
                    , errReasonPhrase = "Method Not Allowed"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err406' Not Acceptable
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err406
--
err406 :: ServantErr
err406 = ServantErr { errHTTPCode = 406
                    , errReasonPhrase = "Not Acceptable"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err407' Proxy Authentication Required
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err407
--
err407 :: ServantErr
err407 = ServantErr { errHTTPCode = 407
                    , errReasonPhrase = "Proxy Authentication Required"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err409' Conflict
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" }
--
err409 :: ServantErr
err409 = ServantErr { errHTTPCode = 409
                    , errReasonPhrase = "Conflict"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err410' Gone
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." }
--
err410 :: ServantErr
err410 = ServantErr { errHTTPCode = 410
                    , errReasonPhrase = "Gone"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err411' Length Required
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError err411
--
err411 :: ServantErr
err411 = ServantErr { errHTTPCode = 411
                    , errReasonPhrase = "Length Required"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err412' Precondition Failed
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err412 { errBody = "Precondition fail: x < 42 && y > 57" }
--
err412 :: ServantErr
err412 = ServantErr { errHTTPCode = 412
                    , errReasonPhrase = "Precondition Failed"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err413' Request Entity Too Large
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err413 { errBody = "Request exceeded 64k." }
--
err413 :: ServantErr
err413 = ServantErr { errHTTPCode = 413
                    , errReasonPhrase = "Request Entity Too Large"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err414' Request-URI Too Large
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err414 { errBody = "Maximum length is 64." }
--
err414 :: ServantErr
err414 = ServantErr { errHTTPCode = 414
                    , errReasonPhrase = "Request-URI Too Large"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err415' Unsupported Media Type
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err415 { errBody = "Supported media types:  gif, png" }
--
err415 :: ServantErr
err415 = ServantErr { errHTTPCode = 415
                    , errReasonPhrase = "Unsupported Media Type"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err416' Request range not satisfiable
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err416 { errBody = "Valid range is [0, 424242]." }
--
err416 :: ServantErr
err416 = ServantErr { errHTTPCode = 416
                    , errReasonPhrase = "Request range not satisfiable"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err417' Expectation Failed
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err417 { errBody = "I found a quux in the request.  This isn't going to work." }
--
err417 :: ServantErr
err417 = ServantErr { errHTTPCode = 417
                    , errReasonPhrase = "Expectation Failed"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err500' Internal Server Error
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err500 { errBody = "Exception in module A.B.C:55.  Have a great day!" }
--
err500 :: ServantErr
err500 = ServantErr { errHTTPCode = 500
                    , errReasonPhrase = "Internal Server Error"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err501' Not Implemented
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err501 { errBody = "/v1/foo is not supported with quux in the request." }
--
err501 :: ServantErr
err501 = ServantErr { errHTTPCode = 501
                    , errReasonPhrase = "Not Implemented"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err502' Bad Gateway
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err502 { errBody = "Tried gateway foo, bar, and baz.  None responded." }
--
err502 :: ServantErr
err502 = ServantErr { errHTTPCode = 502
                    , errReasonPhrase = "Bad Gateway"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err503' Service Unavailable
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err503 { errBody = "We're rewriting in PHP." }
--
err503 :: ServantErr
err503 = ServantErr { errHTTPCode = 503
                    , errReasonPhrase = "Service Unavailable"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err504' Gateway Time-out
--
-- Example:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err504 { errBody = "Backend foobar did not respond in 5 seconds." }
--
err504 :: ServantErr
err504 = ServantErr { errHTTPCode = 504
                    , errReasonPhrase = "Gateway Time-out"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err505' HTTP Version not supported
--
-- Example usage:
--
-- > failingHandler :: Handler ()
-- > failingHandler = throwError $ err505 { errBody = "I support HTTP/4.0 only." }
--
err505 :: ServantErr
err505 = ServantErr { errHTTPCode = 505
                    , errReasonPhrase = "HTTP Version not supported"
                    , errBody = ""
                    , errHeaders = []
                    }