tuplehash-utils 0.0.0.0 → 0.1.0.0
raw patch · 4 files changed
+193/−6 lines, 4 filesdep +tastydep +tasty-hunitdep +tasty-quickcheckdep ~base
Dependencies added: tasty, tasty-hunit, tasty-quickcheck, tuplehash-utils
Dependency ranges changed: base
Files
- ChangeLog.md +6/−0
- lib/Crypto/Encoding/SHA3/TupleHash.hs +19/−4
- test/Main.hs +149/−0
- tuplehash-utils.cabal +19/−2
ChangeLog.md view
@@ -1,5 +1,11 @@ # Revision history for tuplehash-utils +## 0.1.0.0 -- 2025-01-20++* This package now has a test suite that should prove to be fairly respectable++* Several bugs fixed+ ## 0.0.0.0 -- 2024-03-21 * First version. Needs a proper test suite. Implicitly covered by g3p-hash and
lib/Crypto/Encoding/SHA3/TupleHash.hs view
@@ -1,5 +1,20 @@ {-# LANGUAGE OverloadedStrings, BangPatterns, ScopedTypeVariables, ViewPatterns #-} +-------------------------------------------------------------------------------+-- |+-- Module: Crypto.Encoding.SHA3.TupleHash+-- Copyright: (c) 2024 Auth Global+-- License: Apache2+--+-- See NIST Special Publication 800-185: SHA-3 Derived Functions: cSHAKE, KMAC,+-- TupleHash and ParallelHash. <https://www.nist.gov/publications/sha-3-derived-functions-cshake-kmac-tuplehash-and-parallelhash>+-- Note that this module does not implement TupleHash itself, though it could+-- be used to implement TupleHash given an implementation of Keccak/SHA-3. This+-- only implements the data-encoding portions of TupleHash, and does not+-- implement any kind of cryptographic state machine.+--+-------------------------------------------------------------------------------+ module Crypto.Encoding.SHA3.TupleHash ( leftEncodeZero , leftEncodeInteger@@ -116,7 +131,7 @@ byteLen = fromIntegral (B.length bytes) :: Word encodedByteLength :: ByteString -> Int-encodedByteLength (B.length -> n) = lengthOfLeftEncode n + n+encodedByteLength (B.length -> n) = lengthOfLeftEncodeFromBytes n + n encodedVectorByteLength :: Foldable f => f ByteString -> Int encodedVectorByteLength = foldl' (\a x -> a + encodedByteLength x) 0@@ -138,11 +153,11 @@ bareEncodeInteger n = case compare n 0 of LT -> Nothing- EQ -> Just leftEncodeZero+ EQ -> Just bareEncodeZero GT -> let nSigBytes = shiftR (integerLog2 n) 3 + 1 in Just (B.pack (go (fromIntegral nSigBytes))) where- go nSigBytes = fromIntegral nSigBytes : map getByte (downFrom nSigBytes)+ go nSigBytes = map getByte (downFrom nSigBytes) -- FIXME: using shiftR here results in a quadratic algorithm getByte ix = fromIntegral (shiftR n (8*ix) .&. 0xFF) @@ -162,7 +177,7 @@ where wordLen = finiteBitSize n zeros = countLeadingZeros n- nSigBits = wordLen - zeros + 3+ nSigBits = wordLen - zeros nSigBytes = max 1 (shiftR (nSigBits + 7) 3) lengthOfBareEncodeFromBytes :: (Integral b, FiniteBits b) => b -> Int
+ test/Main.hs view
@@ -0,0 +1,149 @@+module Main (main) where++import Data.Bits(FiniteBits)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Int+import Crypto.Encoding.SHA3.TupleHash++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++f x = 2 ^ x :: Int64+f' x = 2 ^ x+g x = 2 ^ x - 1 :: Int64+g' x = 2 ^ x - 1++getNonNegativeInt :: NonNegative Int64 -> Int64+getNonNegativeInt = getNonNegative++main :: IO ()+main = defaultMain $ testGroup "toplevel"+ [ testProperty "prop_bareEncode" (prop_bareEncode . getNonNegativeInt)+ , testCase "test_bareEncode" (filter (not . prop_bareEncode . f) [0..62] @?= [])+ , testCase "test_bareEncode'" (filter (not . prop_bareEncode . g) [0..63] @?= [])+ , testProperty "prop_leftEncode" (prop_leftEncode . getNonNegativeInt)+ , testCase "test_leftEncode" (filter (not . prop_leftEncode . f) [0..62] @?= [])+ , testCase "test_leftEncode'" (filter (not . prop_leftEncode . g) [0..63] @?= [])+ , testProperty "prop_bareEncodeInteger" (prop_bareEncodeInteger . getNonNegative)+ , testCase "test_bareEncodeInteger" (filter (not . prop_bareEncodeInteger . f') [0..2039] @?= [])+ , testCase "test_bareEncodeInteger'" (filter (not . prop_bareEncodeInteger . g') [0..2040] @?= [])+ , testProperty "prop_leftEncodeInteger" (prop_leftEncodeInteger . getNonNegative)+ , testCase "test_leftEncodeInteger" (filter (not . prop_leftEncodeInteger . f') [0..2039] @?= [])+ , testCase "test_leftEncodeInteger'" (filter (not . prop_leftEncodeInteger . g') [0..2040] @?= [])+ , testProperty "prop_bareEncodeFromBytes" (prop_bareEncodeFromBytes . getNonNegativeInt)+ , testCase "test_bareEncodeFromBytes" (filter (not . prop_bareEncodeFromBytes . f) [0..62] @?= [])+ , testCase "test_bareEncodeFromBytes'" (filter (not . prop_bareEncodeFromBytes . g) [0..63] @?= [])++ , testProperty "prop_leftEncodeFromBytes" (prop_leftEncodeFromBytes . getNonNegativeInt)+ , testCase "test_leftEncodeFromBytes" (filter (not . prop_leftEncodeFromBytes . f) [0..62] @?= [])+ , testCase "test_leftEncodeFromBytes'" (filter (not . prop_leftEncodeFromBytes . g) [0..63] @?= [])+ , testProperty "prop_bareEncodeIntegerFromBytes" prop_bareEncodeIntegerFromBytes+ , testCase "prop_bareEncodeIntegerFromBytes" (filter (not . prop_bareEncodeIntegerFromBytes . f') [0..2048] @?= [])+ , testCase "test_bareEncodeIntegerFromBytes'" (filter (not . prop_bareEncodeIntegerFromBytes . g') [0..2048] @?= [])+ , testProperty "prop_leftEncodeIntegerFromBytes" prop_leftEncodeIntegerFromBytes+ , testCase "test_leftEncodeIntegerFromBytes" (filter (not . prop_leftEncodeIntegerFromBytes . f') [0..2036] @?= [])+ , testCase "test_leftEncodeIntegerFromBytes'" (filter (not . prop_leftEncodeIntegerFromBytes . g') [0..2037] @?= [])+ ]++readBigEndian :: ByteString -> Integer+readBigEndian = B.foldl delta 0+ where+ delta tot next = 256 * tot + fromIntegral next++prop_bareEncode :: (Integral n, FiniteBits n) => n -> Bool+prop_bareEncode n =+ isValidBareEncode n (bareEncode n)++isValidBareEncode :: (Integral n, FiniteBits n) => n -> ByteString -> Bool+isValidBareEncode n b+ = not (B.null b)+ && ((B.head b /= 0) == (n /= 0))+ && B.length b == lengthOfBareEncode n+ && readBigEndian b == fromIntegral n++prop_leftEncode :: (Integral n, FiniteBits n) => n -> Bool+prop_leftEncode n =+ isValidLeftEncode n (leftEncode n)++isValidLeftEncode :: (Integral n, FiniteBits n) => n -> ByteString -> Bool+isValidLeftEncode n b+ = not (B.null b)+ && fromIntegral (B.head b) == B.length b - 1+ && B.length b == lengthOfLeftEncode n+ && isValidBareEncode n (B.tail b)++prop_bareEncodeInteger :: Integer -> Bool+prop_bareEncodeInteger n =+ case bareEncodeInteger n of+ Nothing -> True+ Just b -> isValidBareEncodeInteger n b++isValidBareEncodeInteger :: Integer -> ByteString -> Bool+isValidBareEncodeInteger n b+ = not (B.null b)+ && ((B.head b /= 0) == (n /= 0))+ && Just (B.length b) == lengthOfBareEncodeInteger n+ && readBigEndian b == n++prop_leftEncodeInteger :: Integer -> Bool+prop_leftEncodeInteger n =+ case leftEncodeInteger n of+ Nothing -> True+ Just b -> isValidLeftEncodeInteger n b++isValidLeftEncodeInteger :: Integer -> ByteString -> Bool+isValidLeftEncodeInteger n b+ = not (B.null b)+ && fromIntegral (B.head b) == B.length b - 1+ && Just (B.length b) == lengthOfLeftEncodeInteger n+ && isValidBareEncodeInteger n (B.tail b)++prop_bareEncodeFromBytes :: (Integral n, FiniteBits n) => n -> Bool+prop_bareEncodeFromBytes n =+ isValidBareEncodeFromBytes n (bareEncodeFromBytes n)++isValidBareEncodeFromBytes :: (Integral n, FiniteBits n) => n -> ByteString -> Bool+isValidBareEncodeFromBytes n b+ = not (B.null b)+ && ((B.head b /= 0) == (n /= 0))+ && B.length b == lengthOfBareEncodeFromBytes n+ && readBigEndian b == 8 * fromIntegral n++prop_leftEncodeFromBytes :: (Integral n, FiniteBits n) => n -> Bool+prop_leftEncodeFromBytes n =+ isValidLeftEncodeFromBytes n (leftEncodeFromBytes n)++isValidLeftEncodeFromBytes :: (Integral n, FiniteBits n) => n -> ByteString -> Bool+isValidLeftEncodeFromBytes n b+ = not (B.null b)+ && fromIntegral (B.head b) == B.length b - 1+ && B.length b == lengthOfLeftEncodeFromBytes n+ && isValidBareEncodeFromBytes n (B.tail b)++prop_bareEncodeIntegerFromBytes :: Integer -> Bool+prop_bareEncodeIntegerFromBytes n =+ case bareEncodeIntegerFromBytes n of+ Nothing -> True+ Just b -> isValidBareEncodeIntegerFromBytes n b++isValidBareEncodeIntegerFromBytes :: Integer -> ByteString -> Bool+isValidBareEncodeIntegerFromBytes n b+ = not (B.null b)+ && ((B.head b /= 0) == (n /= 0))+ && Just (B.length b) == lengthOfBareEncodeIntegerFromBytes n+ && readBigEndian b == 8 * n++prop_leftEncodeIntegerFromBytes :: Integer -> Bool+prop_leftEncodeIntegerFromBytes n =+ case leftEncodeIntegerFromBytes n of+ Nothing -> True+ Just b -> isValidLeftEncodeIntegerFromBytes n b++isValidLeftEncodeIntegerFromBytes :: Integer -> ByteString -> Bool+isValidLeftEncodeIntegerFromBytes n b+ = not (B.null b)+ && fromIntegral (B.head b) == B.length b - 1+ && Just (B.length b) == lengthOfLeftEncodeIntegerFromBytes n+ && isValidBareEncodeIntegerFromBytes n (B.tail b)
tuplehash-utils.cabal view
@@ -1,5 +1,5 @@ name: tuplehash-utils-version: 0.0.0.0+version: 0.1.0.0 synopsis: Left Encode and friends from SHA-3's TupleHash description: See NIST Special Publication 800-185: SHA-3 Derived Functions: cSHAKE, KMAC,@@ -7,7 +7,7 @@ <https://www.nist.gov/publications/sha-3-derived-functions-cshake-kmac-tuplehash-and-parallelhash> Note that this does not implement TupleHash itself, though it could be used to implement TupleHash given an implementation of Keccak/SHA-3. This only- implements the data-encoding portions of TupleHash, and does not directly+ implements the data-encoding portions of TupleHash, and does not implement any kind of cryptographic state machine. license: Apache-2.0@@ -30,3 +30,20 @@ integer-logarithms hs-source-dirs: lib default-language: Haskell2010++source-repository head+ type: git+ location: http://github.com/auth-global/self-documenting-cryptography+ subdir: tuplehash-utils++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base+ , bytestring+ , tasty+ , tasty-quickcheck+ , tasty-hunit+ , tuplehash-utils