diff --git a/botan-bindings/CHANGELOG.md b/botan-bindings/CHANGELOG.md index 568b119..14a7ff4 100644 --- a/botan-bindings/CHANGELOG.md +++ b/botan-bindings/CHANGELOG.md @@ -18,6 +18,7 @@ experimental `x509` code is moved. * PATCH: enable `-Wall` in addition to a number of other GHC warnings. * PATCH: use `GHC2021` as the default language. +* PATCH: update documentation in the `Botan.Bindings.PwdHash` module. ## 0.1.0.0 -- 2025-09-17 diff --git a/botan-bindings/src/Botan/Bindings/PwdHash.hs b/botan-bindings/src/Botan/Bindings/PwdHash.hs index 6589dcf..f4fe87d 100644 --- a/botan-bindings/src/Botan/Bindings/PwdHash.hs +++ b/botan-bindings/src/Botan/Bindings/PwdHash.hs @@ -8,12 +8,16 @@ Maintainer : joris@well-typed.com, leo@apotheca.io Stability : experimental Portability : POSIX -Derive a key from a passphrase +This module is based on the [Password Based Key +Deriviation](https://botan.randombit.net/handbook/api_ref/pbkdf.html) section of +the C++ Botan documentation. -} {-# LANGUAGE CApiFFI #-} module Botan.Bindings.PwdHash ( + -- * Available schemes + -- $schemes pattern BOTAN_PBKDF_PBKDF2 , pattern BOTAN_PBKDF_SCRYPT , pattern BOTAN_PBKDF_ARGON2D @@ -21,30 +25,79 @@ module Botan.Bindings.PwdHash ( , pattern BOTAN_PBKDF_ARGON2ID , pattern BOTAN_PBKDF_BCRYPT_PBKDF , pattern BOTAN_PBKDF_OPENPGP_S2K + -- * Password hashing , botan_pwdhash , botan_pwdhash_timed ) where import Botan.Bindings.Prelude +{------------------------------------------------------------------------------- + Available schemes +-------------------------------------------------------------------------------} + +-- $schemes +-- +-- There are a number of schemes available to be used as the PBKDF algorithm for +-- 'botan_pwdhash' and 'botan_pwdhash_timed', which are listed in the [Available +-- Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +-- section of the C++ Botan documentation. A pattern synonym for the name of +-- each of the available schemes is included in these Haskell bindings. + pattern BOTAN_PBKDF_PBKDF2 - , BOTAN_PBKDF_SCRYPT - , BOTAN_PBKDF_ARGON2D - , BOTAN_PBKDF_ARGON2I - , BOTAN_PBKDF_ARGON2ID - , BOTAN_PBKDF_BCRYPT_PBKDF - , BOTAN_PBKDF_OPENPGP_S2K - :: (Eq a, IsString a) => a + , BOTAN_PBKDF_SCRYPT + , BOTAN_PBKDF_ARGON2D + , BOTAN_PBKDF_ARGON2I + , BOTAN_PBKDF_ARGON2ID + , BOTAN_PBKDF_BCRYPT_PBKDF + , BOTAN_PBKDF_OPENPGP_S2K + :: (Eq a, IsString a) => a +-- | Name of the @PBKDF2@ scheme +-- +-- NOTE: @PBKDF2@ is not a valid scheme name to pass to 'botan_pwdhash' or +-- 'botan_pwdhash_timed' directly. Instead, the scheme name should be +-- parameterised by a hash function. For more information see the [Available +-- Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +-- section of the C++ Botan documentation pattern BOTAN_PBKDF_PBKDF2 = "PBKDF2" + +-- | Name of the @Scrypt@ scheme pattern BOTAN_PBKDF_SCRYPT = "Scrypt" + +-- | Name of the @Argon2d@ scheme pattern BOTAN_PBKDF_ARGON2D = "Argon2d" + +-- | Name of the @Argon2i@ scheme pattern BOTAN_PBKDF_ARGON2I = "Argon2i" + +-- | Name of the @Argon2d@ scheme pattern BOTAN_PBKDF_ARGON2ID = "Argon2id" + +-- | Name of the @Bcrypt-PBKDF@ scheme pattern BOTAN_PBKDF_BCRYPT_PBKDF = "Bcrypt-PBKDF" + +-- | Name of the @OpenPGP-S2K@ scheme +-- +-- NOTE: @OpenPGP-S2K@ is not a valid scheme name to pass to 'botan_pwdhash' or +-- 'botan_pwdhash_timed' directly. Instead, the scheme name should be +-- parameterised by a hash function. For more information see the [Available +-- Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +-- section of the C++ Botan documentation pattern BOTAN_PBKDF_OPENPGP_S2K = "OpenPGP-S2K" --- | Derive a key from a passphrase using algorithm-specific parameters +{------------------------------------------------------------------------------- + Password hashing +-------------------------------------------------------------------------------} + +-- | Derive a cryptographic key from a passphrase using algorithm-specific parameters +-- +-- NOTE: the interpretation of parameters @param1@, @param2@, and @param3@ are +-- different depending on the PBKDF algorithm that is picked. See the +-- documentation of the +-- [@from_params@](https://botan.randombit.net/handbook/api_ref/pbkdf.html#passwordhash) +-- C++ function for more information about the meaning of the parameters. +-- foreign import capi safe "botan/ffi.h botan_pwdhash" botan_pwdhash :: ConstPtr CChar -- ^ __algo__: PBKDF algorithm, e.g., "PBKDF2(SHA-256)" or "Scrypt" @@ -55,20 +108,39 @@ foreign import capi safe "botan/ffi.h botan_pwdhash" -> CSize -- ^ __out_len__: the desired length of the key to produce -> ConstPtr CChar -- ^ __passphrase__: the password to derive the key from -> CSize -- ^ __passphrase_len__: if > 0, specifies length of password. If len == 0, then - -- strlen will be called on passphrase to compute the length. + -- strlen will be called on passphrase to compute the length. -> ConstPtr Word8 -- ^ __salt[]__: a randomly chosen salt -> CSize -- ^ __salt_len__: length of salt in bytes -> IO CInt -- ^ 0 on success, a negative value on failure - --- | Derive a key from a passphrase using parameters generated over a specific duration +-- | Derive a cryptographic key from a passphrase using algorithm-specific +-- parameters that are tuned automatically for a desired running time of the +-- algorithm. +-- +-- NOTE: for the @Argon2@ and @Scrypt@ PBKDF algorithms, 'botan_pwdhash_timed' +-- returns parameters in a different order than the order in which they should +-- be passed to 'botan_pwdhash'. This is a known issue with the Botan C++ +-- library. See for more +-- information. +-- +-- 'botan_pwdhash_timed' always returns parameters in this order: +-- +-- > (iterations, parallelism, memoryParam) +-- +-- 'botan_pwdhash' shoulds be given parameters in this order for the +-- @Argon2@ and @Scrypt@ algorithms: +-- +-- > param1 = memoryParam +-- > param2 = iterations +-- > param3 = parallelism +-- foreign import capi safe "botan/ffi.h botan_pwdhash_timed" botan_pwdhash_timed :: ConstPtr CChar -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" -> Word32 -- ^ __msec__: the desired runtime in milliseconds - -> Ptr CSize -- ^ __param1__: will be set to the first password hash parameter - -> Ptr CSize -- ^ __param2__: will be set to the second password hash parameter - -> Ptr CSize -- ^ __param3__: will be set to the third password hash parameter + -> Ptr CSize -- ^ __param1__: will be set to the first PBKDF algorithm parameter + -> Ptr CSize -- ^ __param2__: will be set to the second PBKDF algorithm parameter (may be zero if unneeded) + -> Ptr CSize -- ^ __param3__: will be set to the third PBKDF algorithm parameter (may be zero if unneeded) -> Ptr Word8 -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes -> CSize -- ^ __out_len__: the desired length of the key to produce -> ConstPtr CChar -- ^ __passphrase__: the password to derive the key from diff --git a/botan-low/CHANGELOG.md b/botan-low/CHANGELOG.md index 6f72fe4..3e42769 100644 --- a/botan-low/CHANGELOG.md +++ b/botan-low/CHANGELOG.md @@ -17,6 +17,9 @@ experimental `x509` code is moved. * PATCH: enable `-Wall` in addition to a number of other GHC warnings. * PATCH: use `GHC2021` as the default language. +* BREAKING: `Botan.Low.PwdHash.pbkdf2` now takes a `HashName` instead of a + `MacName`. +* PATCH: update documentation in the `Botan.Low.PwdHash` module. ## 0.0.2.0 -- 2025-09-17 diff --git a/botan-low/botan-low.cabal b/botan-low/botan-low.cabal index 6f95d38..7220e70 100644 --- a/botan-low/botan-low.cabal +++ b/botan-low/botan-low.cabal @@ -65,9 +65,11 @@ common language default-language: GHC2021 default-extensions: DerivingStrategies + LambdaCase PatternSynonyms RecordWildCards RoleAnnotations + ViewPatterns library import: warnings, language @@ -128,6 +130,25 @@ library , deepseq >=1.1 && <2 , text >=1.2 && <1.3 || >=2.0 && <2.2 +test-suite test + import: warnings, language + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test/ + build-depends: + , base + , botan-low + , bytestring + , hspec + , QuickCheck + , tasty + , tasty-hspec + , tasty-hunit + + other-modules: + Test.Botan.Low.PwdHash + Test.Prelude + -- -- Unit tests -- @@ -697,31 +718,6 @@ test-suite botan-low-pubkey-x25519-tests -- TODO: Pubkey folder tests -test-suite botan-low-pwdhash-tests - import: warnings, language - - -- TODO: temporarily disabled because the test suite fails. See issue #33. - buildable: False - type: exitcode-stdio-1.0 - main-is: Botan/Low/PwdHashSpec.hs - hs-source-dirs: test/ - build-depends: - , base - , botan-bindings - , botan-low - , bytestring - , hspec - , QuickCheck - - other-modules: - Paths_botan_low - Test.Prelude - - autogen-modules: Paths_botan_low - default-extensions: - NoImplicitPrelude - OverloadedStrings - test-suite botan-low-rng-tests import: warnings, language diff --git a/botan-low/src/Botan/Low/PwdHash.hs b/botan-low/src/Botan/Low/PwdHash.hs index 050bb0b..41ab0f6 100644 --- a/botan-low/src/Botan/Low/PwdHash.hs +++ b/botan-low/src/Botan/Low/PwdHash.hs @@ -8,19 +8,15 @@ Maintainer : joris@well-typed.com, leo@apotheca.io Stability : experimental Portability : POSIX -Derive a key from a passphrase +This module is based on the [Password Based Key +Deriviation](https://botan.randombit.net/handbook/api_ref/pbkdf.html) section of +the C++ Botan documentation. -} module Botan.Low.PwdHash ( - - -- * Password hashing - + -- * Available schemes + -- $schemes PBKDFName - , pwdhash - , pwdhashTimed - - -- * Password hashing algorithms - , pattern PBKDF2 , pbkdf2 , pattern Scrypt @@ -30,103 +26,186 @@ module Botan.Low.PwdHash ( , pattern Bcrypt_PBKDF , pattern OpenPGP_S2K , openPGP_S2K - + -- * Password hashing + , pwdhash + , pwdhashTimed ) where import Botan.Bindings.PwdHash import Botan.Low.Error import Botan.Low.Hash -import Botan.Low.MAC import Botan.Low.Prelude +{------------------------------------------------------------------------------- + Available schemes +-------------------------------------------------------------------------------} + +-- $schemes +-- +-- There are a number of schemes available to be used as the PBKDF algorithm for +-- 'pwdhash' and 'pwdhashTimed', which are listed in the [Available +-- Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +-- section of the C++ Botan documentation. A pattern synonym for the name of +-- each of the available schemes is included in these Haskell bindings. + +-- | The name of a key derivation scheme used as a PBKDF algorithm type PBKDFName = ByteString pattern PBKDF2 - , Scrypt - , Argon2d - , Argon2i - , Argon2id - , Bcrypt_PBKDF - , OpenPGP_S2K - :: PBKDFName - + , Scrypt + , Argon2d + , Argon2i + , Argon2id + , Bcrypt_PBKDF + , OpenPGP_S2K + :: PBKDFName + +-- | Name of the @PBKDF2@ scheme +-- +-- NOTE: @PBKDF2@ is not a valid scheme name to pass to 'pwdhash' or +-- 'pwdhashTimed' directly. Instead, the scheme name should be parameterised by +-- a hash function using 'pbkdf2'. For more information see the [Available +-- Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +-- section of the C++ Botan documentation pattern PBKDF2 = BOTAN_PBKDF_PBKDF2 + +-- | Create a valid scheme name for @PBKDF2@ parameterised over a hash function +-- name. +-- +-- NOTE: "PBKDF(HMAC(SHA-256))" is equivalent to "PBKDF(SHA-256)". 'pbkdf2' +-- always outputs the latter given a hash function name. +pbkdf2 :: HashName -> PBKDFName +pbkdf2 m = PBKDF2 /$ m + +-- | Name of the @Scrypt@ scheme +-- pattern Scrypt = BOTAN_PBKDF_SCRYPT + +-- | Name of the @Argon2d@ scheme pattern Argon2d = BOTAN_PBKDF_ARGON2D + +-- | Name of the @Argon2i@ scheme pattern Argon2i = BOTAN_PBKDF_ARGON2I + +-- | Name of the @Argon2d@ scheme pattern Argon2id = BOTAN_PBKDF_ARGON2ID + +-- | Name of the @Bcrypt-PBKDF@ scheme pattern Bcrypt_PBKDF = BOTAN_PBKDF_BCRYPT_PBKDF + +-- | Name of the @OpenPGP-S2K@ scheme +-- +-- NOTE: @OpenPGP-S2K@ is not a valid scheme name to pass to 'pwdhash' or +-- 'pwdhashTimed' directly. Instead, the scheme name should be parameterised by +-- a hash function using 'openPGP_S2K'. For more information see the [Available +-- Schemes](https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes) +-- section of the C++ Botan documentation pattern OpenPGP_S2K = BOTAN_PBKDF_OPENPGP_S2K --- NOTE: May require HMAC -pbkdf2 :: MACName -> PBKDFName -pbkdf2 m = PBKDF2 /$ m +-- | Create a valid scheme name for @openPGP-S2K@ parameterised over a hash +-- function name. openPGP_S2K:: HashName -> PBKDFName openPGP_S2K h = OpenPGP_S2K /$ h --- NOTE: Should passphrase be Text or ByteString? Text is implied by use of const char* --- as well as the non-null context implied by passphrase_len == 0. ByteString for now. +{------------------------------------------------------------------------------- + Password hashing +-------------------------------------------------------------------------------} --- | Password hash +-- | Derive a cryptographic key from a passphrase using algorithm-specific parameters +-- +-- NOTE: the interpretation of parameters @param1@, @param2@, and @param3@ are +-- different depending on the PBKDF algorithm that is picked. See the +-- documentation of the +-- [@from_params@](https://botan.randombit.net/handbook/api_ref/pbkdf.html#passwordhash) +-- C++ function for more information about the meaning of the parameters. +-- +pwdhash :: + PBKDFName -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" + -> Int -- ^ __param1__: the first PBKDF algorithm parameter + -> Int -- ^ __param2__: the second PBKDF algorithm parameter (may be zero if unneeded) + -> Int -- ^ __param3__: the third PBKDF algorithm parameter (may be zero if unneeded) + -> Int -- ^ __out_len__: the desired length of the key to produce + -> ByteString -- ^ __passphrase__: the password to derive the key from + -> ByteString -- ^ __salt[]__: a randomly chosen salt + -> IO ByteString -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes +pwdhash algo p1 p2 p3 outLen passphrase salt = + allocBytes outLen $ \ outPtr -> + asCString algo $ \ algoPtr -> + asCStringLen passphrase $ \ passphrasePtr passphraseLen -> + asBytesLen salt $ \ saltPtr saltLen -> + throwBotanIfNegative_ $ botan_pwdhash + (ConstPtr algoPtr) + (fromIntegral p1) + (fromIntegral p2) + (fromIntegral p3) + outPtr + (fromIntegral outLen) + (ConstPtr passphrasePtr) + passphraseLen + (ConstPtr saltPtr) + saltLen + +-- | Derive a cryptographic key from a passphrase using algorithm-specific +-- parameters that are tuned automatically for a desired running time of the +-- algorithm. +-- +-- NOTE: for the @Argon2@ and @Scrypt@ PBKDF algorithms, 'pwdhashTimed' returns +-- parameters in a different order than the order in which they should be passed +-- to 'pwdhash'. This is a known issue with the Botan C++ library. See +-- for more information. -- --- 'pwdhash' and 'pwdhashTimed'\'s parameter order may be inconsistent. See --- botan-low\/test\/Botan\/Low\/PwdHashSpec.hs for more information. -pwdhash - :: PBKDFName -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" - -> Int -- ^ __param1__: the first PBKDF algorithm parameter - -> Int -- ^ __param2__: the second PBKDF algorithm parameter (may be zero if unneeded) - -> Int -- ^ __param3__: the third PBKDF algorithm parameter (may be zero if unneeded) - -> Int -- ^ __out_len__: the desired length of the key to produce - -> ByteString -- ^ __passphrase__: the password to derive the key from - -> ByteString -- ^ __salt[]__: a randomly chosen salt - -> IO ByteString -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes -pwdhash algo p1 p2 p3 outLen passphrase salt = allocBytes outLen $ \ outPtr -> do - asCString algo $ \ algoPtr -> do - asCStringLen passphrase $ \ passphrasePtr passphraseLen -> do - asBytesLen salt $ \ saltPtr saltLen -> do - throwBotanIfNegative_ $ botan_pwdhash - (ConstPtr algoPtr) - (fromIntegral p1) - (fromIntegral p2) - (fromIntegral p3) - outPtr - (fromIntegral outLen) - (ConstPtr passphrasePtr) - passphraseLen - (ConstPtr saltPtr) - saltLen - --- | Timed password hash +-- 'pwdhashTimed' always returns parameters in this order: -- --- 'pwdhash' and 'pwdhashTimed'\'s parameter order may be inconsistent. See --- botan-low\/test\/Botan\/Low\/PwdHashSpec.hs for more information. -pwdhashTimed - :: PBKDFName -- ^ __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" - -> Int -- ^ __msec__: the desired runtime in milliseconds - -> Int -- ^ __out_len__: the desired length of the key to produce - -> ByteString -- ^ __passphrase__: the password to derive the key from - -> ByteString -- ^ __salt[]__: a randomly chosen salt - -> IO (Int,Int,Int,ByteString) -- ^ __out[]__: buffer to store the derived key, must be of out_len bytes -pwdhashTimed algo msec outLen passphrase salt = alloca $ \ p1Ptr -> alloca $ \ p2Ptr -> alloca $ \ p3Ptr -> do - out <- allocBytes outLen $ \ outPtr -> do - asCString algo $ \ algoPtr -> do - asCStringLen passphrase $ \ passphrasePtr passphraseLen -> do - asBytesLen salt $ \ saltPtr saltLen -> do - throwBotanIfNegative_ $ botan_pwdhash_timed - (ConstPtr algoPtr) - (fromIntegral msec) - p1Ptr - p2Ptr - p3Ptr - outPtr - (fromIntegral outLen) - (ConstPtr passphrasePtr) - passphraseLen - (ConstPtr saltPtr) - saltLen - p1 <- fromIntegral <$> peek p1Ptr - p2 <- fromIntegral <$> peek p2Ptr - p3 <- fromIntegral <$> peek p3Ptr - return (p1,p2,p3,out) +-- > (iterations, parallelism, memoryParam) +-- +-- 'pwdhash' shoulds be given parameters in this order for the +-- @Argon2@ and @Scrypt@ algorithms: +-- +-- > param1 = memoryParam +-- > param2 = iterations +-- > param3 = parallelism +-- +pwdhashTimed :: + -- | __algo__: PBKDF algorithm, e.g., "Scrypt" or "PBKDF2(SHA-256)" + PBKDFName + -- | __msec__: the desired runtime in milliseconds + -> Int + -- | __out_len__: the desired length of the key to produce + -> Int + -- | __passphrase__: the password to derive the key from + -> ByteString + -- | __salt[]__: a randomly chosen salt + -> ByteString + -- | A tuple of four elements (in order): + -- + -- * __param1__: the first PBKDF algorithm parameter + -- * __param2__: the second PBKDF algorithm parameter (may be zero if unneeded) + -- * __param3__: the third PBKDF algorithm parameter (may be zero if unneeded) + -- * __out[]__: buffer to store the derived key, must be of out_len bytes + -> IO (Int, Int, Int, ByteString) +pwdhashTimed algo msec outLen passphrase salt = + alloca $ \ p1Ptr -> + alloca $ \ p2Ptr -> + alloca $ \ p3Ptr -> do + out <- allocBytes outLen $ \ outPtr -> + asCString algo $ \ algoPtr -> + asCStringLen passphrase $ \ passphrasePtr passphraseLen -> + asBytesLen salt $ \ saltPtr saltLen -> do + throwBotanIfNegative_ $ botan_pwdhash_timed + (ConstPtr algoPtr) + (fromIntegral msec) + p1Ptr + p2Ptr + p3Ptr + outPtr + (fromIntegral outLen) + (ConstPtr passphrasePtr) + passphraseLen + (ConstPtr saltPtr) + saltLen + p1 <- fromIntegral <$> peek p1Ptr + p2 <- fromIntegral <$> peek p2Ptr + p3 <- fromIntegral <$> peek p3Ptr + return (p1, p2, p3, out) diff --git a/botan-low/test/Botan/Low/PwdHashSpec.hs b/botan-low/test/Botan/Low/PwdHashSpec.hs deleted file mode 100644 index ab53b62..0000000 --- a/botan-low/test/Botan/Low/PwdHashSpec.hs +++ /dev/null @@ -1,61 +0,0 @@ -module Main (main) where - -import Data.ByteString (isPrefixOf) - -import Botan.Low.Hash -import Botan.Low.MAC -import Botan.Low.PwdHash - -import Test.Prelude - --- NOTE: Needs more exhaustive tests, and to validate parameter order for --- Scrypt and the Argons. We've got tests that pass, but that doesn't --- mean that they're being used properly. Need to investigate C++ source. - --- NOTE: Values generated by "pwdhashTimed pbkdf 200 64 passphrase salt" -pbkdfs :: [(PBKDFName, Int, Int, Int)] -pbkdfs = - [ ("PBKDF2(HMAC(SHA-512))",138000,0,0) - -- NOTE: These results indicate that the parameter result order is inconsistent - -- for pwdhashTimed compared to pwdhash - -- Eg, Scrypt should be n, r, p but n=8192 is clearly last - -- Same for the argons - -- This causes both tests to fail (original generated values) - -- , ("Scrypt",1,81,8192) - -- , ("Argon2d",1,1,262144) - -- , ("Argon2i",1,1,262144) - -- , ("Argon2id",1,1,262144) - -- Note that this still causes four pwdhashTimed tests to still fail because - -- the pwdhashTimed function itself needs to be fixed for these algorithms - -- Fixed values, assuming only x/z are flipped a la (x,y,z) -> (z,y,x) - -- But - , ("Scrypt",8192,81,1) - , ("Argon2d",262144,1,1) - , ("Argon2i",262144,1,1) - , ("Argon2id",262144,1,1) - , ("Bcrypt-PBKDF",26,0,0) - , ("OpenPGP-S2K(SHA-512)",65011712,0,0) - ] - -passphrase :: ByteString -passphrase = "Fee fi fo fum!" - -salt :: ByteString -salt = "salt" - -main :: IO () -main = hspec $ testSuite pbkdfs (\(n,_,_,_) -> chars n) $ \ (pbkdf, i, j, k) -> do - it "pwdhash" $ do - _ <- pwdhash pbkdf i j k 64 passphrase salt - pass - it "pwdhashTimed" $ do - timed@(i',j',k',pwd) <- pwdhashTimed pbkdf 200 64 passphrase salt - -- NOTE: Fails parity for Scrypt and the Argons due to parameter order - -- pwd' <- pwdhash pbkdf i' j' k' 64 passphrase salt - --NOTE: Scrypt still fails parity and flipping j and k doesn't matter. - pwd' <- case pbkdf of - "Scrypt" -> pwdhash pbkdf j' k' i' 64 passphrase salt - _ | "Argon" `isPrefixOf` pbkdf -> pwdhash pbkdf k' j' i' 64 passphrase salt - _ -> pwdhash pbkdf i' j' k' 64 passphrase salt - pwd `shouldBe` pwd' - pass diff --git a/botan-low/test/Main.hs b/botan-low/test/Main.hs new file mode 100644 index 0000000..0dc7764 --- /dev/null +++ b/botan-low/test/Main.hs @@ -0,0 +1,14 @@ +module Main (main) where + +import qualified Test.Botan.Low.PwdHash +import Test.Tasty + +main :: IO () +main = tests >>= defaultMain + +tests :: IO TestTree +tests = do + pwdHashTests <- Test.Botan.Low.PwdHash.tests + pure $ testGroup "botan-low" [ + pwdHashTests + ] diff --git a/botan-low/test/Test/Botan/Low/PwdHash.hs b/botan-low/test/Test/Botan/Low/PwdHash.hs new file mode 100644 index 0000000..d155e54 --- /dev/null +++ b/botan-low/test/Test/Botan/Low/PwdHash.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Botan.Low.PwdHash ( + tests + -- * Test parameters + , generateTestParams + ) where + +import Botan.Low.Error +import Botan.Low.Hash +import Botan.Low.MAC +import Botan.Low.PwdHash +import Control.Exception +import Data.ByteString +import Test.Prelude +import Test.Tasty +import Test.Tasty.Hspec +import Test.Tasty.HUnit + +tests :: IO TestTree +tests = do + specs <- testSpec "spec_pwdhash" spec_pwdhash + pure $ testGroup "Test.Botan.Low.PwdHash" [ + testCase "test_pwdhash_PBKDF2_badSchemeName" $ + test_pwdhash_PBKDF2_badSchemeName False + , testCase "test_pwdhashTimed_PBKDF2_badSchemeName" $ + test_pwdhash_PBKDF2_badSchemeName True + , specs + ] + +{------------------------------------------------------------------------------- + Test parameters +-------------------------------------------------------------------------------} + +data TestParams = TestParams { + testPbkdfName :: PBKDFName + , testIterationsParam :: Int + , testParallelismParam :: Int + , testMemoryParam :: Int + } + deriving stock (Show, Eq) + +-- | Parameters for testing +-- +-- These are generated using 'generateTestParams'. +testParams :: [TestParams] +testParams = + [ TestParams "PBKDF2(SHA-256)" 436000 0 0 + , TestParams "PBKDF2(SHA-512)" 258000 0 0 + , TestParams "Scrypt" 8 1 65536 + , TestParams "Argon2d" 1 1 262144 + , TestParams "Argon2i" 1 1 262144 + , TestParams "Argon2id" 1 1 262144 + , TestParams "Bcrypt-PBKDF" 92 0 0 + , TestParams "OpenPGP-S2K(SHA-384)" 65011712 0 0 + ] + +-- | Schemes for testing +testPbkdfs :: [PBKDFName] +testPbkdfs = [ + -- PBKDF2 + pbkdf2 SHA256 + , pbkdf2 SHA512 + -- Scrypt + , Scrypt + -- Argon + , Argon2d + , Argon2i + , Argon2id + -- Bcrypt + , Bcrypt_PBKDF + -- OpenPGP S2K + , openPGP_S2K SHA384 + ] + +-- | Generate test parameters using 'tuneParams' on schemes listed in +-- 'testPbkdfs'. +-- +-- NOTE: the test parameters can change per invocation, but theys should be +-- roughly similar. +generateTestParams :: IO [TestParams] +generateTestParams = forM testPbkdfs tuneParams + +-- | Tune parameters for a given scheme +tuneParams :: PBKDFName -> IO TestParams +tuneParams name = do + (iterations, parallelism, memory, _) <- pwdhashTimed name 200 64 passphrase salt + pure $ TestParams name iterations parallelism memory + +passphrase :: ByteString +passphrase = "Fee fi fo fum!" + +salt :: ByteString +salt = "salt" + +{------------------------------------------------------------------------------- + Tests +-------------------------------------------------------------------------------} + +-- | Test that using 'pwdhash' or 'pwdhashTimed' with bad scheme names results +-- in errors. +test_pwdhash_PBKDF2_badSchemeName :: Bool -> Assertion +test_pwdhash_PBKDF2_badSchemeName useTimed = do + -- PBKDF2 + go PBKDF2 >>= \case + Left BadParameterException{} -> pure () + Right{} -> assertFailure "got success, but expected BadParameterException" + go (pbkdf2 HMAC) >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (pbkdf2 $ hmac "2") >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (pbkdf2 $ hmac "SHA-256") >>= \case + Left SomeException{} -> assertFailure "got SomeException, but expected success" + Right{} -> pure () + go (pbkdf2 $ gmac "SHA-256") >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (pbkdf2 "SHA-256") >>= \case + Left SomeException{} -> assertFailure "got SomeException, but expected success" + Right{} -> pure () + + -- OpenPGP S2K + go OpenPGP_S2K >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (openPGP_S2K "2") >>= \case + Left NotImplementedException{} -> pure () + Right{} -> assertFailure "got success, but expected NotImplementedException" + go (openPGP_S2K "SHA-384") >>= \case + Left SomeException{} -> assertFailure "got SomeException, but expected success" + Right{} -> pure () + where + go schemeName + | useTimed = try $ + void $ pwdhashTimed schemeName 200 64 passphrase salt + | otherwise = try $ + void $ pwdhash schemeName 1 0 0 64 passphrase salt + +-- | Run 'pwdhash' and 'pwdhashTimed', and check that their outputs match. +spec_pwdhash :: Spec +spec_pwdhash = + testSuite testParams (\(TestParams n _ _ _) -> chars n) $ + \params@(TestParams pbkdf _ _ _) -> do + it "pwdhash" $ do + _ <- pwdhashCorrected params + pass + it "pwdhashTimed" $ do + _timed@(iterations', parallelism', memory', pwd) <- pwdhashTimed pbkdf 200 64 passphrase salt + pwd' <- pwdhashCorrected (TestParams pbkdf iterations' parallelism' memory') + pwd `shouldBe` pwd' + pass + where + -- For @Argon2@ and @Scrypt@ algorithms, 'botan_pwdhash_timed' returns + -- parameters in a different order than what 'botan_pwdhash' takes in. + pwdhashCorrected :: TestParams -> IO ByteString + pwdhashCorrected (TestParams pbkdf iterations parallelism memory) = + case pbkdf of + "Scrypt" -> pwdhash pbkdf memory iterations parallelism 64 passphrase salt + _ | "Argon" `isPrefixOf` pbkdf -> pwdhash pbkdf memory iterations parallelism 64 passphrase salt + _ -> pwdhash pbkdf iterations parallelism memory 64 passphrase salt diff --git a/botan-low/test/Test/Prelude.hs b/botan-low/test/Test/Prelude.hs index 46b16bf..96be74b 100644 --- a/botan-low/test/Test/Prelude.hs +++ b/botan-low/test/Test/Prelude.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Test.Prelude ( module Prelude , module Test.Hspec diff --git a/doc/ModuleHierarchy.md b/doc/ModuleHierarchy.md index d988265..5c63402 100644 --- a/doc/ModuleHierarchy.md +++ b/doc/ModuleHierarchy.md @@ -24,23 +24,35 @@ Haskell modules in the three packages are called: * `botan`: `Botan.Error` Note that all three packages use the same suffix `.Error`. What follows below is -a list of how sections in the C++ FFI documentation correspond to such module +a list of how sections in the C FFI documentation correspond to such module suffixes. -* Return codes: `Error` -* Versioning: `Version` -* View Functions: `View` -* Utility Functions: `Utility` +* [Return codes][botan:ffi:return-codes]: `Error` +* [Versioning][botan:ffi:versioning]: `Version` +* [View Functions][botan:ffi:view-functions]: `View` +* [Utility Functions][botan:ffi:utility-functions]: `Utility` Note that the C FFI documentation is not complete, so some Haskell modules export bindings to C entities that are not described in the C FFI documentation. +Such modules are instead based on the [C++ API reference +documentation][botan:api:pwdhash]. Again, all three packages use the same module +suffixes: + +* [Password Based Key Derivation][botan:api:pwdhash]: `PwdHash` + Moreover, some modules export Haskell-only definitions that do not correspond -directly to C entities, and some modules do not directly correspond to a C FFI +directly to C entities, and some modules do not directly correspond to a C FFI or C++ documentation section. Such is the case specially in the higher-level packages `botan-low` and `botan`, but it is true for `botan-bindings` to a lesser degree as well. [hs-botan:README]: ../README.md + [botan:ffi]: https://botan.randombit.net/handbook/api_ref/ffi.html [botan:ffi:return-codes]: https://botan.randombit.net/handbook/api_ref/ffi.html#return-codes -[botan:ffi:versioning]: https://botan.randombit.net/handbook/api_ref/ffi.html#return-codes +[botan:ffi:versioning]: https://botan.randombit.net/handbook/api_ref/ffi.html#versioning +[botan:ffi:view-functions]: https://botan.randombit.net/handbook/api_ref/ffi.html#view-functions +[botan:ffi:utility-functions]: https://botan.randombit.net/handbook/api_ref/ffi.html#utility-functions + +[botan:api]: https://botan.randombit.net/handbook/api_ref/contents.html +[botan:api:pwdhash]: https://botan.randombit.net/handbook/api_ref/pbkdf.html#available-schemes