Move SizeHash type family to Cardano.Crypto.Hash.HashAlgorithm

cardano-crypto-class/src/Cardano/Crypto/Hash/Blake2b.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Implementation of the Blake2b hashing algorithm, with various sizes.
 module Cardano.Crypto.Hash.Blake2b
@@ -16,11 +18,11 @@ data Blake2b_224
 data Blake2b_256
 
 instance HashAlgorithm Blake2b_224 where
+  type SizeHash Blake2b_224 = 28
   hashAlgorithmName _ = "blake2b_224"
-  sizeHash _ = 28
   digest _ = BA.convert . H.hash @_ @H.Blake2b_224
 
 instance HashAlgorithm Blake2b_256 where
+  type SizeHash Blake2b_256 = 32
   hashAlgorithmName _ = "blake2b_256"
-  sizeHash _ = 32
   digest _ = BA.convert . H.hash @_ @H.Blake2b_256

cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs

@@ -1,10 +1,16 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Abstract hashing functionality.
 module Cardano.Crypto.Hash.Class
   ( HashAlgorithm (..)
+  , sizeHash
+  , byteCount
   , ByteString
   , Hash(..)
   , castHash
@@ -47,24 +53,28 @@ import Data.Typeable (Typeable)
 import Data.Word (Word8)
 import GHC.Generics (Generic)
 import GHC.Stack
+import GHC.TypeLits (Nat, KnownNat, natVal)
 import Numeric.Natural
 
 import Cardano.Prelude (Base16ParseError, NoUnexpectedThunks, parseBase16)
 
-class Typeable h => HashAlgorithm h where
+class (Typeable h, KnownNat (SizeHash h)) => HashAlgorithm h where
+  -- size of hash digest
+  type SizeHash h :: Nat
 
   hashAlgorithmName :: proxy h -> String
 
-  -- | The size in bytes of the output of 'digest'
-  sizeHash :: proxy h -> Word
-
-  byteCount :: proxy h -> Natural
-  byteCount = fromIntegral . sizeHash
-
   digest :: HasCallStack => proxy h -> ByteString -> ByteString
 
+
+byteCount :: HashAlgorithm h => proxy h -> Natural
+byteCount = fromIntegral . sizeHash
 {-# DEPRECATED byteCount "Use sizeHash" #-}
 
+-- | The size in bytes of the output of 'digest'
+sizeHash :: forall h proxy. HashAlgorithm h => proxy h -> Word
+sizeHash _ = fromInteger (natVal (Proxy @(SizeHash h)))
+
 newtype Hash h a = UnsafeHash {getHash :: ByteString}
   deriving (Eq, Ord, Generic, NFData, NoUnexpectedThunks)
 
@@ -95,7 +105,7 @@ instance (HashAlgorithm h, Typeable a) => FromCBOR (Hash h a) where
     bs <- decodeBytes
     let la = SB.length bs
         le :: Int
-        le = fromIntegral $ byteCount (Proxy :: Proxy h)
+        le = fromIntegral $ sizeHash (Proxy :: Proxy h)
     if la == le
     then return $ UnsafeHash bs
     else fail $ "expected " ++ show le ++ " byte(s), but got " ++ show la
@@ -163,7 +173,7 @@ hashFromBytesAsHex hexrep
 
 hashFromBytes :: forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
 hashFromBytes bytes
-  | SB.length bytes == fromIntegral (byteCount (Proxy :: Proxy h))
+  | SB.length bytes == fromIntegral (sizeHash (Proxy :: Proxy h))
   = Just (UnsafeHash bytes)
 
   | otherwise

cardano-crypto-class/src/Cardano/Crypto/Hash/MD5.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Implementation of the MD5 hashing algorithm.
 module Cardano.Crypto.Hash.MD5
@@ -13,8 +15,8 @@ import qualified Data.ByteArray as BA
 data MD5
 
 instance HashAlgorithm MD5 where
+  type SizeHash MD5 = 16
   hashAlgorithmName _ = "md5"
-  sizeHash _ = 16
   digest _ = convert . H.hash
 
 convert :: H.Digest H.MD5 -> ByteString

cardano-crypto-class/src/Cardano/Crypto/Hash/NeverUsed.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
 module Cardano.Crypto.Hash.NeverUsed (NeverHash) where
 
 import Cardano.Crypto.Hash.Class
@@ -8,6 +10,6 @@ import Cardano.Crypto.Hash.Class
 data NeverHash
 
 instance HashAlgorithm NeverHash where
+  type SizeHash NeverHash = 0
   hashAlgorithmName _ = "never"
-  sizeHash _ = 0
   digest = error "HASH not available"

cardano-crypto-class/src/Cardano/Crypto/Hash/SHA256.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Implementation of the SHA256 hashing algorithm.
 module Cardano.Crypto.Hash.SHA256
@@ -13,8 +15,8 @@ import qualified Data.ByteArray as BA
 data SHA256
 
 instance HashAlgorithm SHA256 where
+  type SizeHash SHA256 = 32
   hashAlgorithmName _ = "sha256"
-  sizeHash _ = 32
   digest _ = convert . H.hash
 
 convert :: H.Digest H.SHA256 -> ByteString

cardano-crypto-class/src/Cardano/Crypto/Hash/SHA3_256.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Implementation of the SHA3_256 hashing algorithm.
 module Cardano.Crypto.Hash.SHA3_256
@@ -13,8 +15,8 @@ import qualified Data.ByteArray as BA
 data SHA3_256
 
 instance HashAlgorithm SHA3_256 where
+  type SizeHash SHA3_256 = 32
   hashAlgorithmName _ = "sha3-256"
-  sizeHash _ = 32
   digest _ = convert . H.hash
 
 convert :: H.Digest H.SHA3_256 -> ByteString

cardano-crypto-class/src/Cardano/Crypto/Hash/Short.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- | Implementation of short hashing algorithm, suitable for testing as
 -- it's not very collision-resistant.
@@ -16,8 +18,8 @@ import qualified Data.ByteString as B
 data ShortHash
 
 instance HashAlgorithm ShortHash where
+  type SizeHash ShortHash = 4
   hashAlgorithmName _ = "md5_short"
-  sizeHash _ = 4
   digest p =
     B.take (fromIntegral (sizeHash p)) .
       BA.convert .

cardano-crypto-class/src/Cardano/Crypto/KES/Sum.hs

@@ -95,7 +95,7 @@ type Sum7KES d h = SumKES h (Sum6KES d h)
 data SumKES h d
 
 instance ( KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d
-         , NaCl.SizeHash h ~ SeedSizeKES d -- can be relaxed
+         , SizeHash h ~ SeedSizeKES d -- can be relaxed
          )
       => KESAlgorithm (SumKES h d) where
 
@@ -309,12 +309,12 @@ deriving instance Eq   (VerKeyKES (SumKES h d))
 
 instance KESAlgorithm d => NoUnexpectedThunks (SignKeyKES (SumKES h d))
 
-instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
       => ToCBOR (VerKeyKES (SumKES h d)) where
   toCBOR = encodeVerKeyKES
   encodedSizeExpr _size = encodedVerKeyKESSizeExpr
 
-instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
       => FromCBOR (VerKeyKES (SumKES h d)) where
   fromCBOR = decodeVerKeyKES
 
@@ -323,16 +323,16 @@ instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash
 -- SignKey instances
 --
 
-deriving instance (KnownNat (NaCl.SizeHash h), KESAlgorithm d) => Show (SignKeyKES (SumKES h d))
+deriving instance (KnownNat (SizeHash h), KESAlgorithm d) => Show (SignKeyKES (SumKES h d))
 
 instance KESAlgorithm d => NoUnexpectedThunks (VerKeyKES  (SumKES h d))
 
-instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
       => ToCBOR (SignKeyKES (SumKES h d)) where
   toCBOR = encodeSignKeyKES
   encodedSizeExpr _size = encodedSignKeyKESSizeExpr
 
-instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
       => FromCBOR (SignKeyKES (SumKES h d)) where
   fromCBOR = decodeSignKeyKES
 
@@ -346,12 +346,12 @@ deriving instance KESAlgorithm d => Eq   (SigKES (SumKES h d))
 
 instance KESAlgorithm d => NoUnexpectedThunks (SigKES (SumKES h d))
 
-instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
       => ToCBOR (SigKES (SumKES h d)) where
   toCBOR = encodeSigKES
   encodedSizeExpr _size = encodedSigKESSizeExpr
 
-instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, NaCl.SizeHash h ~ SeedSizeKES d)
+instance (KESAlgorithm d, NaCl.SodiumHashAlgorithm h, Typeable d, SizeHash h ~ SeedSizeKES d)
       => FromCBOR (SigKES (SumKES h d)) where
   fromCBOR = decodeSigKES
 

cardano-crypto-class/src/Cardano/Crypto/Libsodium/Hash.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 module Cardano.Crypto.Libsodium.Hash (
     SodiumHashAlgorithm (..),
     digestMLockedStorable,
@@ -22,14 +23,15 @@ import Foreign.C.Types (CSize)
 import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)
 import Foreign.Storable (Storable (sizeOf, poke))
 import Data.Word (Word8)
+import Data.Type.Equality ((:~:)(..))
 import GHC.IO.Exception (ioException)
 import GHC.TypeLits
 import System.IO.Unsafe (unsafeDupablePerformIO)
 import GHC.IO.Handle.Text (memcpy)
 
 import qualified Data.ByteString as SB
 
-import Cardano.Crypto.Hash (HashAlgorithm, SHA256, Blake2b_256)
+import Cardano.Crypto.Hash (HashAlgorithm(SizeHash), SHA256, Blake2b_256)
 import Cardano.Crypto.FiniteBytes (FiniteBytes)
 import Cardano.Crypto.Libsodium.C
 import Cardano.Crypto.Libsodium.Memory.Internal
@@ -39,10 +41,7 @@ import Cardano.Crypto.Libsodium.MLockedBytes.Internal
 -- Type-Class
 -------------------------------------------------------------------------------
 
-class (HashAlgorithm h, KnownNat (SizeHash h)) => SodiumHashAlgorithm h where
-    -- | The size in bytes of the output of 'digest'
-    type SizeHash h :: Nat
-
+class HashAlgorithm h => SodiumHashAlgorithm h where
     digestMLocked
         :: proxy h
         -> Ptr a  -- ^ input
@@ -103,7 +102,6 @@ expandHash h (MLFB sfptr) = unsafeDupablePerformIO $ do
 -------------------------------------------------------------------------------
 
 instance SodiumHashAlgorithm SHA256 where
-    type SizeHash SHA256 = CRYPTO_SHA256_BYTES
 
     digestMLocked :: forall proxy a. proxy SHA256 -> Ptr a -> Int -> IO (MLockedFiniteBytes (SizeHash SHA256))
     digestMLocked _ input inputlen = do
@@ -116,9 +114,11 @@ instance SodiumHashAlgorithm SHA256 where
 
         return (MLFB output)
 
-instance SodiumHashAlgorithm Blake2b_256 where
-    type SizeHash Blake2b_256 = CRYPTO_BLAKE2B_256_BYTES
+-- Test that manually written numbers are the same as in libsodium
+_testSHA256 :: SizeHash SHA256 :~: CRYPTO_SHA256_BYTES
+_testSHA256 = Refl
 
+instance SodiumHashAlgorithm Blake2b_256 where
     digestMLocked :: forall proxy a. proxy Blake2b_256 -> Ptr a -> Int -> IO (MLockedFiniteBytes (SizeHash Blake2b_256))
     digestMLocked _ input inputlen = do
         output <- allocMLockedForeignPtr
@@ -132,3 +132,6 @@ instance SodiumHashAlgorithm Blake2b_256 where
                 ioException $ errnoToIOError "digestMLocked @Blake2b_256: c_crypto_hash_sha256" errno Nothing Nothing
 
         return (MLFB output)
+
+_testBlake2b256 :: SizeHash Blake2b_256 :~: CRYPTO_BLAKE2B_256_BYTES
+_testBlake2b256 = Refl