-- Copyright 2020 Fernando Rincon Martin
-- 
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
-- 
--     http://www.apache.org/licenses/LICENSE-2.0
-- 
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-------------------------------------------------------------------------------
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
module Network.Wai.Routing.Purescheme.Core.Internal (
    Rejection(..)
  , reject
  , reject'
  , notFoundDefaultRejection
  , addOrReplaceHeader
) where

import Control.Exception (Exception, throwIO)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Typeable (Typeable)
import Network.Wai (ResponseReceived)
import Network.HTTP.Types (Status, ResponseHeaders, Header, notFound404, statusMessage)

data Rejection 
  = Rejection
  { Rejection -> Text
message :: Text
  , Rejection -> Int
priority :: Int
  , Rejection -> Status
status :: Status
  , Rejection -> ResponseHeaders
headers :: ResponseHeaders
  } 
  deriving (Int -> Rejection -> ShowS
[Rejection] -> ShowS
Rejection -> String
(Int -> Rejection -> ShowS)
-> (Rejection -> String)
-> ([Rejection] -> ShowS)
-> Show Rejection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rejection] -> ShowS
$cshowList :: [Rejection] -> ShowS
show :: Rejection -> String
$cshow :: Rejection -> String
showsPrec :: Int -> Rejection -> ShowS
$cshowsPrec :: Int -> Rejection -> ShowS
Show, Typeable)

instance Exception Rejection

reject :: Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject :: Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
rejectionException r -> IO ResponseReceived
_ = Rejection -> IO ResponseReceived
reject' Rejection
rejectionException

reject' :: Rejection -> IO ResponseReceived
reject' :: Rejection -> IO ResponseReceived
reject' = Rejection -> IO ResponseReceived
forall e a. Exception e => e -> IO a
throwIO

addOrReplaceHeader :: [Header] -> Header -> [Header]
addOrReplaceHeader :: ResponseHeaders -> Header -> ResponseHeaders
addOrReplaceHeader ResponseHeaders
fromHeaders header :: Header
header@(HeaderName
key, ByteString
_) = 
   Header
headerHeader -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
:(Header -> Bool) -> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
k, ByteString
_) -> HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
key) ResponseHeaders
fromHeaders

notFoundDefaultRejection :: Rejection
notFoundDefaultRejection :: Rejection
notFoundDefaultRejection = 
  Rejection :: Text -> Int -> Status -> ResponseHeaders -> Rejection
Rejection
    { status :: Status
status = Status
notFound404
    , message :: Text
message = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Status -> ByteString
statusMessage Status
notFound404
    , priority :: Int
priority = Int
forall a. Bounded a => a
minBound
    , headers :: ResponseHeaders
headers = []
    }