module Web.Minion.Error (MonadThrow (..), module Web.Minion.Error) where

import Control.Exception
import Control.Monad.Catch (MonadThrow (..))
import Data.ByteString qualified as Bytes
import Data.ByteString.Lazy qualified as Bytes.Lazy
import Network.HTTP.Types qualified as Http
import Network.Wai qualified as Wai

data NoMatch = NoMatch
  deriving (Int -> NoMatch -> ShowS
[NoMatch] -> ShowS
NoMatch -> String
(Int -> NoMatch -> ShowS)
-> (NoMatch -> String) -> ([NoMatch] -> ShowS) -> Show NoMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoMatch -> ShowS
showsPrec :: Int -> NoMatch -> ShowS
$cshow :: NoMatch -> String
show :: NoMatch -> String
$cshowList :: [NoMatch] -> ShowS
showList :: [NoMatch] -> ShowS
Show, Show NoMatch
Typeable NoMatch
(Typeable NoMatch, Show NoMatch) =>
(NoMatch -> SomeException)
-> (SomeException -> Maybe NoMatch)
-> (NoMatch -> String)
-> Exception NoMatch
SomeException -> Maybe NoMatch
NoMatch -> String
NoMatch -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: NoMatch -> SomeException
toException :: NoMatch -> SomeException
$cfromException :: SomeException -> Maybe NoMatch
fromException :: SomeException -> Maybe NoMatch
$cdisplayException :: NoMatch -> String
displayException :: NoMatch -> String
Exception)

type ErrorBuilder = Wai.Request -> Http.Status -> Bytes.Lazy.ByteString -> ServerError

type TextToError = Bytes.Lazy.ByteString -> ServerError

data SomethingWentWrong = SomethingWentWrong
  deriving (Int -> SomethingWentWrong -> ShowS
[SomethingWentWrong] -> ShowS
SomethingWentWrong -> String
(Int -> SomethingWentWrong -> ShowS)
-> (SomethingWentWrong -> String)
-> ([SomethingWentWrong] -> ShowS)
-> Show SomethingWentWrong
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SomethingWentWrong -> ShowS
showsPrec :: Int -> SomethingWentWrong -> ShowS
$cshow :: SomethingWentWrong -> String
show :: SomethingWentWrong -> String
$cshowList :: [SomethingWentWrong] -> ShowS
showList :: [SomethingWentWrong] -> ShowS
Show, Show SomethingWentWrong
Typeable SomethingWentWrong
(Typeable SomethingWentWrong, Show SomethingWentWrong) =>
(SomethingWentWrong -> SomeException)
-> (SomeException -> Maybe SomethingWentWrong)
-> (SomethingWentWrong -> String)
-> Exception SomethingWentWrong
SomeException -> Maybe SomethingWentWrong
SomethingWentWrong -> String
SomethingWentWrong -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: SomethingWentWrong -> SomeException
toException :: SomethingWentWrong -> SomeException
$cfromException :: SomeException -> Maybe SomethingWentWrong
fromException :: SomeException -> Maybe SomethingWentWrong
$cdisplayException :: SomethingWentWrong -> String
displayException :: SomethingWentWrong -> String
Exception)

data ErrorBuilders = ErrorBuilders
  { ErrorBuilders -> ErrorBuilder
headerErrorBuilder :: ErrorBuilder
  , ErrorBuilders -> ErrorBuilder
queryParamsErrorBuilder :: ErrorBuilder
  , ErrorBuilders -> ErrorBuilder
captureErrorBuilder :: ErrorBuilder
  , ErrorBuilders -> ErrorBuilder
bodyErrorBuilder :: ErrorBuilder
  }

data ServerError = ServerError
  { ServerError -> Status
code :: Http.Status
  , ServerError -> [Header]
headers :: [Http.Header]
  , ServerError -> ByteString
body :: Bytes.Lazy.ByteString
  }
  deriving (Int -> ServerError -> ShowS
[ServerError] -> ShowS
ServerError -> String
(Int -> ServerError -> ShowS)
-> (ServerError -> String)
-> ([ServerError] -> ShowS)
-> Show ServerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerError -> ShowS
showsPrec :: Int -> ServerError -> ShowS
$cshow :: ServerError -> String
show :: ServerError -> String
$cshowList :: [ServerError] -> ShowS
showList :: [ServerError] -> ShowS
Show, Show ServerError
Typeable ServerError
(Typeable ServerError, Show ServerError) =>
(ServerError -> SomeException)
-> (SomeException -> Maybe ServerError)
-> (ServerError -> String)
-> Exception ServerError
SomeException -> Maybe ServerError
ServerError -> String
ServerError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ServerError -> SomeException
toException :: ServerError -> SomeException
$cfromException :: SomeException -> Maybe ServerError
fromException :: SomeException -> Maybe ServerError
$cdisplayException :: ServerError -> String
displayException :: ServerError -> String
Exception)

codeOf :: ServerError -> Http.Status
codeOf :: ServerError -> Status
codeOf ServerError{[Header]
ByteString
Status
$sel:code:ServerError :: ServerError -> Status
$sel:headers:ServerError :: ServerError -> [Header]
$sel:body:ServerError :: ServerError -> ByteString
code :: Status
headers :: [Header]
body :: ByteString
..} = Status
code

redirect :: (MonadThrow m) => Bytes.ByteString -> m a
redirect :: forall (m :: * -> *) a. MonadThrow m => ByteString -> m a
redirect ByteString
url = ServerError -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ServerError -> m a) -> ServerError -> m a
forall a b. (a -> b) -> a -> b
$ ServerError
found{headers = [("Location", url)]}

err300 :: ServerError
err300 :: ServerError
err300 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status300 [] ByteString
forall a. Monoid a => a
mempty

err301 :: ServerError
err301 :: ServerError
err301 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status301 [] ByteString
forall a. Monoid a => a
mempty

err302 :: ServerError
err302 :: ServerError
err302 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status302 [] ByteString
forall a. Monoid a => a
mempty

err303 :: ServerError
err303 :: ServerError
err303 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status303 [] ByteString
forall a. Monoid a => a
mempty

err304 :: ServerError
err304 :: ServerError
err304 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status304 [] ByteString
forall a. Monoid a => a
mempty

err305 :: ServerError
err305 :: ServerError
err305 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status305 [] ByteString
forall a. Monoid a => a
mempty

err307 :: ServerError
err307 :: ServerError
err307 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status307 [] ByteString
forall a. Monoid a => a
mempty

err400 :: ServerError
err400 :: ServerError
err400 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status400 [] ByteString
forall a. Monoid a => a
mempty

err401 :: ServerError
err401 :: ServerError
err401 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status401 [] ByteString
forall a. Monoid a => a
mempty

err402 :: ServerError
err402 :: ServerError
err402 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status402 [] ByteString
forall a. Monoid a => a
mempty

err403 :: ServerError
err403 :: ServerError
err403 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status403 [] ByteString
forall a. Monoid a => a
mempty

err404 :: ServerError
err404 :: ServerError
err404 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status404 [] ByteString
forall a. Monoid a => a
mempty

err405 :: ServerError
err405 :: ServerError
err405 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status405 [] ByteString
forall a. Monoid a => a
mempty

err406 :: ServerError
err406 :: ServerError
err406 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status406 [] ByteString
forall a. Monoid a => a
mempty

err407 :: ServerError
err407 :: ServerError
err407 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status407 [] ByteString
forall a. Monoid a => a
mempty

err409 :: ServerError
err409 :: ServerError
err409 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status409 [] ByteString
forall a. Monoid a => a
mempty

err410 :: ServerError
err410 :: ServerError
err410 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status410 [] ByteString
forall a. Monoid a => a
mempty

err411 :: ServerError
err411 :: ServerError
err411 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status411 [] ByteString
forall a. Monoid a => a
mempty

err412 :: ServerError
err412 :: ServerError
err412 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status412 [] ByteString
forall a. Monoid a => a
mempty

err413 :: ServerError
err413 :: ServerError
err413 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status413 [] ByteString
forall a. Monoid a => a
mempty

err414 :: ServerError
err414 :: ServerError
err414 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status414 [] ByteString
forall a. Monoid a => a
mempty

err415 :: ServerError
err415 :: ServerError
err415 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status415 [] ByteString
forall a. Monoid a => a
mempty

err416 :: ServerError
err416 :: ServerError
err416 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status416 [] ByteString
forall a. Monoid a => a
mempty

err417 :: ServerError
err417 :: ServerError
err417 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status417 [] ByteString
forall a. Monoid a => a
mempty

err418 :: ServerError
err418 :: ServerError
err418 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status418 [] ByteString
forall a. Monoid a => a
mempty

err422 :: ServerError
err422 :: ServerError
err422 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status422 [] ByteString
forall a. Monoid a => a
mempty

err500 :: ServerError
err500 :: ServerError
err500 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status500 [] ByteString
forall a. Monoid a => a
mempty

err501 :: ServerError
err501 :: ServerError
err501 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status501 [] ByteString
forall a. Monoid a => a
mempty

err502 :: ServerError
err502 :: ServerError
err502 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status502 [] ByteString
forall a. Monoid a => a
mempty

err503 :: ServerError
err503 :: ServerError
err503 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status503 [] ByteString
forall a. Monoid a => a
mempty

err504 :: ServerError
err504 :: ServerError
err504 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status504 [] ByteString
forall a. Monoid a => a
mempty

err505 :: ServerError
err505 :: ServerError
err505 = Status -> [Header] -> ByteString -> ServerError
ServerError Status
Http.status505 [] ByteString
forall a. Monoid a => a
mempty

multipleChoices :: ServerError
multipleChoices :: ServerError
multipleChoices = ServerError
err300

movedPermanently :: ServerError
movedPermanently :: ServerError
movedPermanently = ServerError
err301

found :: ServerError
found :: ServerError
found = ServerError
err302

seeOther :: ServerError
seeOther :: ServerError
seeOther = ServerError
err303

notModified :: ServerError
notModified :: ServerError
notModified = ServerError
err304

useProxy :: ServerError
useProxy :: ServerError
useProxy = ServerError
err305

temporaryRedirect :: ServerError
temporaryRedirect :: ServerError
temporaryRedirect = ServerError
err307

badRequest :: ServerError
badRequest :: ServerError
badRequest = ServerError
err400

unauthorized :: ServerError
unauthorized :: ServerError
unauthorized = ServerError
err401

paymentRequired :: ServerError
paymentRequired :: ServerError
paymentRequired = ServerError
err402

forbidden :: ServerError
forbidden :: ServerError
forbidden = ServerError
err403

notFound :: ServerError
notFound :: ServerError
notFound = ServerError
err404

methodNotAllowed :: ServerError
methodNotAllowed :: ServerError
methodNotAllowed = ServerError
err405

notAcceptable :: ServerError
notAcceptable :: ServerError
notAcceptable = ServerError
err406

proxyAuthenticationRequired :: ServerError
proxyAuthenticationRequired :: ServerError
proxyAuthenticationRequired = ServerError
err407

conflict :: ServerError
conflict :: ServerError
conflict = ServerError
err409

gone :: ServerError
gone :: ServerError
gone = ServerError
err410

lengthRequired :: ServerError
lengthRequired :: ServerError
lengthRequired = ServerError
err411

preconditionFailed :: ServerError
preconditionFailed :: ServerError
preconditionFailed = ServerError
err412

requestEntityTooLarge :: ServerError
requestEntityTooLarge :: ServerError
requestEntityTooLarge = ServerError
err413

requestURITooLong :: ServerError
requestURITooLong :: ServerError
requestURITooLong = ServerError
err414

unsupportedMediaType :: ServerError
unsupportedMediaType :: ServerError
unsupportedMediaType = ServerError
err415

requestedRangeNotSatisfiable :: ServerError
requestedRangeNotSatisfiable :: ServerError
requestedRangeNotSatisfiable = ServerError
err416

expectationFailed :: ServerError
expectationFailed :: ServerError
expectationFailed = ServerError
err417

teapot :: ServerError
teapot :: ServerError
teapot = ServerError
err418

unprocessableEntity :: ServerError
unprocessableEntity :: ServerError
unprocessableEntity = ServerError
err422

internalServerError :: ServerError
internalServerError :: ServerError
internalServerError = ServerError
err500

notImplemented :: ServerError
notImplemented :: ServerError
notImplemented = ServerError
err501

badGateway :: ServerError
badGateway :: ServerError
badGateway = ServerError
err502

serviceUnavailable :: ServerError
serviceUnavailable :: ServerError
serviceUnavailable = ServerError
err503

gatewayTimeout :: ServerError
gatewayTimeout :: ServerError
gatewayTimeout = ServerError
err504

httpVersionNotSupported :: ServerError
httpVersionNotSupported :: ServerError
httpVersionNotSupported = ServerError
err505