diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/lib/Crypto/Encoding/SHA3/TupleHash.hs b/lib/Crypto/Encoding/SHA3/TupleHash.hs --- a/lib/Crypto/Encoding/SHA3/TupleHash.hs +++ b/lib/Crypto/Encoding/SHA3/TupleHash.hs @@ -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. +-- 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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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) diff --git a/tuplehash-utils.cabal b/tuplehash-utils.cabal --- a/tuplehash-utils.cabal +++ b/tuplehash-utils.cabal @@ -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 @@ 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