Metadata encryption bug

lib/crypto-primitives/src/Cryptography/KDF/PBKDF2.hs

@@ -56,16 +56,21 @@ generateKey
     :: HashAlgorithm h
     => PBKDF2Config h
     -> ByteString
-    -- ^ payload
+    -- ^ password
+    -- Remark/limitation:
+    -- As byte || operation is taken when hashing password,
+    -- the password shorter than 64-byte is padded with \NUL (0x00)
+    -- meaning passwords p, p <> 'NUL', p <> 'NUL' <> 'NUL', ... are indifferentiable and
+    -- result in the same (key,iv) for the rest arguments identical.
     -> Maybe ByteString
     -- ^ salt
     -> (ByteString, ByteString)
     -- ^ (key, iv)
-generateKey PBKDF2Config{hash,iterations,keyLength,ivLength} payload saltM =
+generateKey PBKDF2Config{hash,iterations,keyLength,ivLength} password saltM =
     BS.splitAt keyLength whole
   where
     whole = generate
         (prfHMAC hash)
         (Parameters iterations (keyLength + ivLength))
-        payload
+        password
         (fromMaybe BS.empty saltM)

lib/crypto-primitives/test/Cryptography/KDF/PBKDF2Spec.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cryptography.KDF.PBKDF2Spec
     ( spec
@@ -35,7 +37,17 @@ import Test.Hspec
     , it
     , shouldBe
     )
+import Test.QuickCheck
+    ( Arbitrary (..)
+    , Property
+    , chooseInt
+    , oneof
+    , property
+    , vectorOf
+    , (===)
+    )
 
+import qualified Data.ByteString as BS
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
@@ -313,6 +325,17 @@ spec = do
             { key = "6BBCD65DA84D7BB1D214908270352A56FF25B375E53B7D3F237330666CCBF0DF"
             , iv = "FD40C29618D438E3658388C52EB7974E"
             }
+
+    describe "password and password padded with \NUL produce the same (key, iv) pair" $
+        it "generateKey conf passwd salt == generateKey conf (passwd <> \NUL <> ...) salt" $
+        property @(TestCaseSHA256 -> Property) $
+        \(TestCase algo' iters' keyL' ivL' passwd' salt') -> do
+            let nulsToAdd = 64 - BS.length passwd'
+            let passwdPadded = passwd' <> BS.replicate nulsToAdd 0
+            generateKey (PBKDF2Config algo' iters' keyL' ivL') passwd' salt'
+                ===
+                generateKey (PBKDF2Config algo' iters' keyL' ivL') passwdPadded salt'
+
   where
     toKeyIV TestCase {..} =
         tohex (generateKey (PBKDF2Config algo iters keyL ivL) passwd salt)
@@ -335,3 +358,25 @@ data OpenSSLOutput = OpenSSLOutput
     { key :: Text
     , iv :: Text
     } deriving (Show, Eq)
+
+type TestCaseSHA256 = TestCase SHA256
+
+instance Arbitrary TestCaseSHA256 where
+    arbitrary = do
+        passwd' <-
+            BS.pack <$> do
+            len <- chooseInt (1, 63)
+            vectorOf len arbitrary
+        saltLen <- chooseInt (1,32)
+        salt' <- oneof
+            [ pure Nothing
+            , Just . BS.pack <$> vectorOf saltLen arbitrary
+            ]
+        pure $ TestCase
+            { algo = SHA256
+            , iters = 10000
+            , keyL = 32
+            , ivL = 16
+            , passwd = passwd'
+            , salt = salt'
+            }

lib/primitive/test/spec/Cardano/Wallet/Primitive/Types/MetadataEncryptionSpec.hs

@@ -23,6 +23,9 @@ import Data.ByteArray.Encoding
 import Data.ByteString
     ( ByteString
     )
+import Data.Char
+    ( isAlphaNum
+    )
 import Data.Either
     ( isLeft
     )
@@ -57,6 +60,8 @@ import Test.QuickCheck
 
 import qualified Cardano.Api as Cardano
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.List as L
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -433,10 +438,19 @@ spec = do
 fromHexToM :: Text -> Maybe ByteString
 fromHexToM = rightToMaybe . convertFromBase Base16 . T.encodeUtf8
 
+newtype MetadataPassword = MetadataPassword {unPassword :: ByteString}
+    deriving (Eq, Show)
+
+instance Arbitrary MetadataPassword where
+    arbitrary = do
+        pwdLen <- chooseInt (5,10)
+        chars <- vectorOf pwdLen arbitrary `suchThat` L.all isAlphaNum
+        pure $ MetadataPassword $ B8.pack chars
+
 data TestingSetup = TestingSetup
     { payload :: Cardano.TxMetadata
-    , password :: ByteString
-    , passwordOther :: ByteString
+    , password :: MetadataPassword
+    , passwordOther :: MetadataPassword
     , salt :: ByteString
     } deriving (Eq, Show)
 
@@ -452,10 +466,8 @@ instance Arbitrary TestingSetup where
     arbitrary = do
         msgNum <- chooseInt (1,10)
         txts <- vectorOf msgNum (getMsg <$> arbitrary)
-        pwdLen1 <- chooseInt (5,10)
-        pwdLen2 <- chooseInt (5,10)
-        pwd1 <- BS.pack <$> vectorOf pwdLen1 arbitrary
-        pwd2 <- (BS.pack <$> vectorOf pwdLen2 arbitrary) `suchThat` (/= pwd1)
+        pwd1 <-  arbitrary
+        pwd2 <- arbitrary `suchThat` (/= pwd1)
         salt' <- BS.pack <$> vectorOf 8 arbitrary
         let metadata toEncrypt =
                 Cardano.TxMetadata $ Map.fromList
@@ -478,23 +490,23 @@ instance Arbitrary TestingSetup where
             }
 
 prop_roundtrip :: TestingSetup -> Property
-prop_roundtrip (TestingSetup payload' pwd' _ salt') = do
+prop_roundtrip (TestingSetup payload' (MetadataPassword pwd') _ salt') = do
     (mapLeft
      (const ErrMissingValidEncryptionPayload)
      (toMetadataEncrypted pwd' payload' (Just salt'))
      >>= fromMetadataEncrypted pwd')
         === Right payload'
 
 prop_passphrase :: TestingSetup -> Expectation
-prop_passphrase (TestingSetup payload' pwd1 pwd2 salt') = do
+prop_passphrase (TestingSetup payload' (MetadataPassword pwd1) (MetadataPassword pwd2) salt') = do
     (mapLeft
      (const ErrMissingValidEncryptionPayload)
      (toMetadataEncrypted pwd1 payload' (Just salt'))
      >>= fromMetadataEncrypted pwd2)
         `shouldSatisfy` isLeft
 
 prop_structure_after_enc :: TestingSetup -> Expectation
-prop_structure_after_enc (TestingSetup payload' pwd' _ salt') = do
+prop_structure_after_enc (TestingSetup payload' (MetadataPassword pwd') _ salt') = do
     let hasMsgWithList (Cardano.TxMetaText k, Cardano.TxMetaList _) =
             k == cip83EncryptPayloadKey
         hasMsgWithList _ = False