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 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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | 'err405' Method Not Allowed
--
-- Example:
--
-- > failingHandler :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr err406
--
err406 :: ServantErr
err406 = ServantErr { errHTTPCode = 406
                    , errReasonPhrase = "Not Acceptable"
                    , errBody = ""
                    , errHeaders = []
                    }

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

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

-- | 'err410' Gone
--
-- Example:
--
-- > failingHandler :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr err411
--
err411 :: ServantErr
err411 = ServantErr { errHTTPCode = 411
                    , errReasonPhrase = "Length Required"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err412' Precondition Failed
--
-- Example:
--
-- > failingHandler :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ err503 { errBody = "We're rewriting in PHP." }
--
err503 :: ServantErr
err503 = ServantErr { errHTTPCode = 503
                    , errReasonPhrase = "Service Unavailable"
                    , errBody = ""
                    , errHeaders = []
                    }

-- | 'err504' Gateway Time-out
--
-- Example:
--
-- > failingHandler :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ 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 :: ExceptT ServantErr IO ()
-- > failingHandler = throwErr $ err505 { errBody = "I support HTTP/4.0 only." }
--
err505 :: ServantErr
err505 = ServantErr { errHTTPCode = 505
                    , errReasonPhrase = "HTTP Version not supported"
                    , errBody = ""
                    , errHeaders = []
                    }