Add instance of Keyed for any 256bit or less Hash

IntersectMBO · Oct 26, 2021 · 569a103 · 569a103
1 parent e556459
commit 569a103
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 2 deletions.
diff --git a/cabal.project b/cabal.project
@@ -42,8 +42,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

diff --git a/libs/compact-map/compact-map.cabal b/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

diff --git a/libs/compact-map/src/Data/Compact/HashMap.hs b/libs/compact-map/src/Data/Compact/HashMap.hs
@@ -1,18 +1,44 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Data.Compact.HashMap where
 
+import Cardano.Crypto.Hash.Class
 import Data.Compact.KeyMap (Key, KeyMap)
 import qualified Data.Compact.KeyMap as KM
+import Data.Proxy
 import Data.Set (Set)
 import qualified Data.Set as Set
+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