Add instance of Keyed for any 256bit or less Hash

cabal.project

@@ -41,8 +41,8 @@ test-show-details: streaming
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 654f5b7c76f7cc57900b4ddc664a82fc3b925fb0
-  --sha256: 0j4x9zbx5dkww82sqi086h39p456iq5xr476ylmrnpwcpfb4xai4
+  tag: 7de552c29e8c6fb421a4df48281f145feb6c7d2c
+  --sha256: 0icq9y3nnl42fz536da84414av36g37894qnyw4rk3qkalksqwir
   subdir:
     base-deriving-via
     binary

libs/compact-map/compact-map.cabal

@@ -35,6 +35,7 @@ library
   build-depends:       base >=4.11 && <5
                      , array
                      , containers
+                     , cardano-crypto-class
                      , deepseq
                      , prettyprinter
                      , primitive

libs/compact-map/src/Data/Compact/HashMap.hs

@@ -1,18 +1,46 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Data.Compact.HashMap where
 
 import qualified Data.Compact.KeyMap as KM
 import Data.Compact.KeyMap(Key,KeyMap)
 import Data.Set(Set)
 import qualified Data.Set as Set
+import Cardano.Crypto.Hash.Class
+import Data.Proxy
+import Data.Typeable
+import GHC.TypeLits
 
 -- ==========================================================================
 
+
 class Keyed t where
   toKey :: t -> Key
   fromKey :: Key -> t
 
+instance HashAlgorithm h => Keyed (Hash h a) where
+  toKey h =
+    case hashToPackedBytes h of
+      PackedBytes8 a -> KM.Key a 0 0 0
+      PackedBytes28 a b c d -> KM.Key a b c (fromIntegral d)
+      PackedBytes32 a b c d -> KM.Key a b c d
+      _ -> error $ "Unsupported hash size: " <> show (sizeHash (Proxy :: Proxy h))
+  fromKey (KM.Key a b c d) =
+    hashFromPackedBytes $
+    case sameNat (Proxy :: Proxy (SizeHash h)) (Proxy :: Proxy 32) of
+      Just Refl -> PackedBytes32 a b c d
+      Nothing ->
+        case sameNat (Proxy :: Proxy (SizeHash h)) (Proxy :: Proxy 28) of
+          Just Refl -> PackedBytes28 a b c (fromIntegral d)
+          Nothing ->
+            case sameNat (Proxy :: Proxy (SizeHash h)) (Proxy :: Proxy 8) of
+              Just Refl -> PackedBytes8 a
+              Nothing -> error $ "Unsupported hash size: " <> show (sizeHash (Proxy :: Proxy h))
+
+
 data HashMap k v where
    HashMap :: Keyed k => KeyMap v -> HashMap k v
 
@@ -24,7 +52,7 @@ insert k v (HashMap m) = HashMap(KM.insert (toKey k) v m)
 
 insertWithKey :: (k -> v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
 insertWithKey combine key v (HashMap m) = HashMap(KM.insertWithKey comb (toKey key) v m)
-   where comb k v1 v2 = combine (fromKey k) v1 v2          
+   where comb k v1 v2 = combine (fromKey k) v1 v2
 
 restrictKeys :: HashMap k v -> Set k -> HashMap k v
 restrictKeys (HashMap m) set = HashMap(KM.domainRestrict m (Set.map toKey set))