-- 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 OverloadedStrings #-}
module Network.Wai.Routing.Purescheme.Core.Query
  ( singleParameter
  , maybeSingleParameter
  )
where
  
import Network.Wai.Routing.Purescheme.Core.Basic
import Network.Wai.Routing.Purescheme.Core.Internal

import Data.ByteString (ByteString)
import qualified Data.Text as T
import Data.String.Interpolate.IsString (i)
import Network.HTTP.Types (badRequest400, statusMessage)
import Network.Wai (queryString)

-- | Match single parameter in the query string, fails when the parameter is not found or the
-- query string contains multiple values for the parameter
singleParameter :: FromUri a => ByteString -> (a -> GenericApplication b) -> GenericApplication b
singleParameter :: ByteString -> (a -> GenericApplication b) -> GenericApplication b
singleParameter ByteString
name a -> GenericApplication b
f Request
req =
  case ((ByteString, Maybe ByteString) -> Bool)
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString
k, Maybe ByteString
_) -> ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name) ([(ByteString, Maybe ByteString)]
 -> [(ByteString, Maybe ByteString)])
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> [(ByteString, Maybe ByteString)]
queryString Request
req of
    [(ByteString
_, Just ByteString
value)] -> a -> GenericApplication b
f (ByteString -> a
forall a. FromUri a => ByteString -> a
fromByteString ByteString
value) Request
req
    [] -> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject (Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived)
-> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Text -> Rejection
invalidParameterRejection [i|Required query parameter not found: #{name}|]
    [(ByteString, Maybe ByteString)]
_ -> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject (Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived)
-> Rejection -> (b -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Text -> Rejection
invalidParameterRejection 
      [i|Found more than one parameter in query string, required only one: #{name}|]

-- | Match single parameter in the query string, if multiple values for the same parameter found
-- then fails
maybeSingleParameter :: 
  FromUri a 
  => ByteString 
  -> (Maybe a -> GenericApplication r) 
  -> GenericApplication r
maybeSingleParameter :: ByteString
-> (Maybe a -> GenericApplication r) -> GenericApplication r
maybeSingleParameter ByteString
name Maybe a -> GenericApplication r
f Request
req =
  case ((ByteString, Maybe ByteString) -> Bool)
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString
k, Maybe ByteString
_) -> ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name) ([(ByteString, Maybe ByteString)]
 -> [(ByteString, Maybe ByteString)])
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> [(ByteString, Maybe ByteString)]
queryString Request
req of
    [(ByteString
_, Just ByteString
value)] -> Maybe a -> GenericApplication r
f (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. FromUri a => ByteString -> a
fromByteString ByteString
value) Request
req
    [] -> Maybe a -> GenericApplication r
f Maybe a
forall a. Maybe a
Nothing Request
req
    [(ByteString, Maybe ByteString)]
_ -> 
      Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall r.
Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
reject (Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived)
-> Rejection -> (r -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Text -> Rejection
invalidParameterRejection 
        [i|Found more than one parameter in query string, required none or only one: #{name}|]

invalidParameterRejection :: T.Text -> Rejection
invalidParameterRejection :: Text -> Rejection
invalidParameterRejection Text
errorMessage =
  Rejection :: Text -> Int -> Status -> ResponseHeaders -> Rejection
Rejection
    { status :: Status
status = Status
badRequest400
    , message :: Text
message = [i|#{statusMessage badRequest400}: #{errorMessage}|]
    , priority :: Int
priority = Int
200
    , headers :: ResponseHeaders
headers = []
    }