Internal.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Internal where

import Data.ByteArray (pack)
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck
import Test.QuickCheck.Instances.Text ()

import Data.Password.Types (mkPassword, Password, PasswordHash, Salt(..))
import Data.Password.Internal (PasswordCheck(..))


testCorrectPassword :: (Eq params, Show params)
                    => String
                    -> (Password -> IO (PasswordHash a))
                    -> (Password -> PasswordHash a -> PasswordCheck)
                    -> (PasswordHash a -> Maybe params)
                    -> params
                    -> TestTree
testCorrectPassword s hashF checkF extractParamsF params = testProperty s $
  \pass -> ioProperty $ do
    let pw = mkPassword pass
    hpw <- hashF pw
    return $ (checkF pw hpw === PasswordCheckSuccess) .&&. extractParamsF hpw === Just params

testIncorrectPassword :: String
                      -> (Password -> IO (PasswordHash a))
                      -> (Password -> PasswordHash a -> PasswordCheck)
                      -> TestTree
testIncorrectPassword s hashF checkF = testProperty s $
  \pass pass2 -> pass /= pass2 && not (all isEmpty [pass, pass2]) ==>
    ioProperty $ do
      let pw = mkPassword pass
          pw2 = mkPassword pass2
      hpw <- hashF pw
      return $ checkF pw2 hpw === PasswordCheckFail
  where
    isEmpty c = c `elem` ["", "\NUL"]

testWithSalt :: (Eq params, Show params)
             => String
             -> (Salt a -> Password -> PasswordHash a)
             -> (Password -> PasswordHash a -> PasswordCheck)
             -> (PasswordHash a -> Maybe params)
             -> params
             -> TestTree
testWithSalt s hashWithSalt checkF extractParamsF params = testProperty s $
  \pass salt ->
    let pw = mkPassword pass
        hpw = hashWithSalt salt pw
    in (checkF pw hpw === PasswordCheckSuccess) .&&. extractParamsF hpw === Just params

instance Arbitrary (Salt a) where
  arbitrary = Salt . pack <$> vector 16