mirror of https://github.com/voidlizard/hbs2
98 lines
3.3 KiB
Haskell
98 lines
3.3 KiB
Haskell
{-# 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)
|
|
]
|