-- 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 QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.Wai.Routing.Purescheme.Core.Method
  ( method
  )
where

import Network.Wai.Routing.Purescheme.Core.Basic
import Network.Wai.Routing.Purescheme.Core.Internal

import qualified Data.Text.Encoding as T
import Network.HTTP.Types (StdMethod, renderStdMethod, methodNotAllowed405, statusMessage)
import Network.Wai (requestMethod)

-- | Match with standard http method
method :: StdMethod -> GenericApplication e -> GenericApplication e
method :: StdMethod -> GenericApplication e -> GenericApplication e
method StdMethod
m GenericApplication e
f Request
req =
  if Request -> Method
requestMethod Request
req Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== StdMethod -> Method
renderStdMethod StdMethod
m
    then GenericApplication e
f Request
req
    else Rejection -> (e -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject Rejection
methodNotAllowedRejection

methodNotAllowedRejection :: Rejection
methodNotAllowedRejection :: Rejection
methodNotAllowedRejection =
  Rejection :: Text -> Int -> Status -> ResponseHeaders -> Rejection
Rejection
    { status :: Status
status = Status
methodNotAllowed405
    , message :: Text
message = Method -> Text
T.decodeUtf8 (Method -> Text) -> Method -> Text
forall a b. (a -> b) -> a -> b
$ Status -> Method
statusMessage Status
methodNotAllowed405
    , priority :: Int
priority = Int
100
    , headers :: ResponseHeaders
headers = []
    }