{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}

module PasswordProperties (
  testPassword
) where

import Crypto.Saltine.Core.Password
import Crypto.Saltine.Internal.Util
import Data.Maybe                             (isJust, isNothing, fromJust)
import Data.Monoid
import Data.Text                              (Text)
import Test.Framework.Providers.QuickCheck2
import Test.Framework
import Test.QuickCheck

import qualified Crypto.Saltine.Internal.Password as I
import qualified Data.Text                        as T

instance Arbitrary Text where
    arbitrary = T.pack <$> arbitrary

instance Arbitrary Algorithm where
    arbitrary = elements $ enumFromTo minBound maxBound

-- | Sadly using the actual maximum limit is just way too slow
instance Arbitrary Memlimit where
    arbitrary = I.Memlimit <$> chooseInt ( max I.pwhash_argon2i_memlimit_min I.pwhash_argon2id_memlimit_min
                                         , max I.pwhash_argon2i_memlimit_min I.pwhash_argon2id_memlimit_min * 4
                                         )

instance Arbitrary Opslimit where
    arbitrary = I.Opslimit <$> chooseInt ( max I.pwhash_argon2i_opslimit_min I.pwhash_argon2id_opslimit_min
                                         , max I.pwhash_argon2i_opslimit_min I.pwhash_argon2id_opslimit_min * 4
                                         )

instance Arbitrary Policy where
    arbitrary = applyArbitrary3 Policy

rightInverseProp :: Text -> Policy -> IO Bool
rightInverseProp pw pol = do
    h <- pwhashStr pw pol
    pure $ pwhashStrVerify (fromJust h) pw

rightInverseFailureProp1 :: Text -> Policy -> Text -> IO Bool
rightInverseFailureProp1 pw pol per =
    let npw = T.reverse pw <> T.pack "0" <> per
    in do
        h <- pwhashStr pw pol
        pure . not $ pwhashStrVerify (fromJust h) npw

rightProp :: Text -> Policy -> IO Bool
rightProp pw pol = do
    h <- pwhashStr pw pol
    pure $ Just False == needsRehash (opsPolicy pol) (memPolicy pol) (fromJust h)

rightFailureProp :: Text -> Opslimit -> Opslimit -> Memlimit -> Memlimit -> IO Bool
rightFailureProp pw ops1 ops2 mem1 mem2 = do
    h <- pwhashStr pw (Policy ops1 mem1 defaultAlgorithm)
    pure $ Just True == needsRehash ops2 mem2 (fromJust h)
            || ops1 == ops2

rightFailureProp2 :: Text -> Opslimit -> Memlimit -> Bool
rightFailureProp2 invhash ops mem =
    isNothing $ needsRehash ops mem (I.PasswordHash invhash)

rightProp2 :: Salt -> Text -> Policy -> Gen Bool
rightProp2 salt pw pol = do
    i <- chooseInt (I.pwhash_bytes_min, 1024)

    pure $ isJust $ pwhash pw i salt pol


testPassword :: Test
testPassword = buildTest $ do
  salt <- newSalt

  return $ testGroup "... Password" [

    testProperty "Can hash passwords and verify them..."
        $ ioProperty . uncurry rightInverseProp,

    testProperty "Hashed passwords cannot be verified with the wrong password..."
        $ ioProperty . uncurry3 rightInverseFailureProp1,

    testProperty "Hashed passwords do not need to be rehashed with the same policy..."
        $ ioProperty . uncurry rightProp,

    testProperty "Hashed passwords do need to be rehashed with a different policy..."
        $ ioProperty . uncurry5 rightFailureProp,

    testProperty "needsRehash detects invalid hashes..."
        rightFailureProp2,

    testProperty "Deriving a key from a password..."
        (rightProp2 salt)
    ]