Header.hs

module Properties.Trait.Header
  ( tests
  ) where

import Data.Functor.Identity (runIdentity)
import Data.String (fromString)
import Data.Text.Encoding (encodeUtf8)
import Network.Wai (defaultRequest)
import Test.QuickCheck (Property, allProperties, counterexample, property, (.&&.), (=/=), (===))
import Test.QuickCheck.Instances ()
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperties)

import WebGear.Middlewares.Header
import WebGear.Trait
import WebGear.Types


prop_headerParseError :: Property
prop_headerParseError = property $ \hval ->
  let
    hval' = "test-" <> hval
    req = defaultRequest { requestHeaders = [("foo", encodeUtf8 hval')] }
  in
    case runIdentity (toAttribute @(Header "foo" Int) req) of
      Found v    ->
        counterexample ("Unexpected result: " <> show v) (property False)
      NotFound e ->
        e === Right (HeaderParseError $ "could not parse: `" <> hval' <> "' (input does not start with a digit)")

prop_headerParseSuccess :: Property
prop_headerParseSuccess = property $ \(n :: Int) ->
  let
    req = defaultRequest { requestHeaders = [("foo", fromString $ show n)] }
  in
    case runIdentity (toAttribute @(Header "foo" Int) req) of
      Found n'   -> n === n'
      NotFound e ->
        counterexample ("Unexpected result: " <> show e) (property False)

prop_headerMatch :: Property
prop_headerMatch = property $ \v ->
  let
    req = defaultRequest { requestHeaders = [("foo", v)] }
  in
    case runIdentity (toAttribute @(HeaderMatch "foo" "bar") req) of
      Found _           -> v === "bar"
      NotFound Nothing  ->
        counterexample "Unexpected result: Nothing" (property False)
      NotFound (Just e) ->
        expectedHeader e === "bar" .&&. actualHeader e =/= "bar"


-- Hack for TH splicing
return []

tests :: TestTree
tests = testProperties "Trait.Header" $allProperties