hash-tree 0.1.0 → 0.1.1

raw patch · 4 files changed

+43/−5 lines, 4 files

Files

• ChangeLog.md +9/−0
• Data/HashTree/Internal.hs +5/−3
• hash-tree.cabal +3/−2
• test/HashTreeSpec.hs +26/−0

@@ -0,0 +1,9 @@+# ChangeLog for hash-tree++## 0.1.1++* Security: `verifyConsistencyProof` did not check that the second tree+  size was fully consumed (RFC 9162 Sec 2.1.4.2), so a proof could be+  accepted for a wrong second tree size. It also threw an error for+  over-long proofs and did not reject `first > second`.+* `verifyInclusionProof` now rejects a negative leaf index.

@@ -307,7 +307,7 @@     -- ^ InclusionProof of the target     -> Bool verifyInclusionProof set leafDigest rootDigest (InclusionProof idx tsiz pps)-    | idx >= tsiz = False+    | idx < 0 || idx >= tsiz = False     | otherwise = verify (idx, tsiz - 1) leafDigest pps   where     verify (_, sn) r [] = sn == 0 && r == rootDigest@@ -390,6 +390,7 @@     -> ConsistencyProof ha     -> Bool verifyConsistencyProof set firstHash secondHash (ConsistencyProof first second path)+    | first < 0 || first > second = False     | first == 0 = case path of         [c] -> secondHash == c         _ -> False@@ -401,8 +402,9 @@     path'         | isPowerOf2 first = firstHash : path         | otherwise = path-    verify _ fr sr [] = fr == firstHash && sr == secondHash-    verify (_, 0) _ _ _ = error "verifyConsistencyProof:verify"+    -- RFC 9162 Sec 2.1.4.2: sn must be 0 at the end.+    verify (_, sn) fr sr [] = sn == 0 && fr == firstHash && sr == secondHash+    verify (_, 0) _ _ _ = False     verify fsn@(fn, sn) fr sr (c : cs)         | fn `testBit` 0 || fn == sn =             let fr' = hash2 set c fr

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name:          hash-tree-version:       0.1.0+version:       0.1.1 license:       BSD3 license-file:  LICENSE maintainer:    Kazu Yamamoto <kazu@iij.ad.jp>@@ -13,6 +13,7 @@  category:      Data build-type:    Simple+extra-source-files: ChangeLog.md  source-repository head     type:     git@@ -27,7 +28,7 @@         base >=4 && <5,         bytestring,         containers,-        crypton >=1.1.0 && <1.2,+        crypton >=1.1.0 && <2.1,         ram  test-suite spec

@@ -69,6 +69,32 @@                 Just dm = digest m mht                 Just dn = digest n mht              in verifyConsistencyProof set dm dn proof+    describe "verifyConsistencyProof (exhaustive)" $ do+        let mht = fromList set $ map (BS.pack . pure) [0 .. 24]+            dig k = fromJust $ digest k mht+        it "accepts valid proofs" $+            and [ verifyConsistencyProof set (dig m) (dig n) $ fromJust $ generateConsistencyProof m n mht+                | n <- [1 .. 25], m <- [1 .. n] ] `shouldBe` True+        it "rejects a proof for (1,2) claimed as (1,n)" $+            or [ verifyConsistencyProof set (dig 1) (dig 2) proof{secondTreeSize = n'}+               | n' <- [3 .. 25]+               , let proof = fromJust $ generateConsistencyProof 1 2 mht ] `shouldBe` False+        it "never throws for modified sizes" $+            length [ () | n <- [1 .. 25], m <- [1 .. n], m' <- [-1 .. 26], n' <- [-1 .. 26]+                        , let proof = fromJust $ generateConsistencyProof m n mht+                        , verifyConsistencyProof set (dig m) (dig n) proof{firstTreeSize = m', secondTreeSize = n'} ]+                `shouldSatisfy` (>= 0)+        it "rejects extended proofs and first > second without errors" $+            or ( [ verifyConsistencyProof set (dig m) (dig n) proof{consistency = consistency proof ++ [dig 1]}+                 | n <- [1 .. 25], m <- [1 .. n]+                 , let proof = fromJust $ generateConsistencyProof m n mht ]+              ++ [ verifyConsistencyProof set (dig 7) (dig 3) (ConsistencyProof 7 3 [dig 1]) ] ) `shouldBe` False+    describe "verifyInclusionProof (negative index)" $+        it "rejects a negative leaf index" $ do+            let mht = fromList set ["0", "1"]+                leaf = hash1 set ("0" :: ByteString)+                proof = fromJust $ generateInclusionProof leaf 2 mht+            verifyInclusionProof set leaf (fromJust $ digest 2 mht) proof{leafIndex = -2} `shouldBe` False  adjust :: Int -> Int -> Int adjust x b