webgear-server-0.2.0: test/Properties/Trait/Auth/Basic.hs
module Properties.Trait.Auth.Basic
( tests
) where
import Data.ByteString.Base64 (encode)
import Data.ByteString.Char8 (elem)
import Data.Functor.Identity (runIdentity)
import Network.Wai (defaultRequest)
import Prelude hiding (elem)
import Test.QuickCheck (Discard (..), Property, allProperties, counterexample, property, (.&&.),
(===))
import Test.QuickCheck.Instances ()
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperties)
import WebGear.Middlewares.Auth.Basic
import WebGear.Trait
import WebGear.Types
prop_basicAuth :: Property
prop_basicAuth = property f
where
f (username, password)
| ':' `elem` username = property Discard
| otherwise =
let
hval = "Basic " <> encode (username <> ":" <> password)
req = defaultRequest { requestHeaders = [("Authorization", hval)] }
in
case runIdentity (toAttribute @BasicAuth req) of
Found creds ->
credentialsUsername creds === Username username
.&&. credentialsPassword creds === Password password
NotFound e ->
counterexample ("Unexpected failure: " <> show e) (property False)
-- Hack for TH splicing
return []
tests :: TestTree
tests = testProperties "Trait.Auth.Basic" $allProperties