From 42525d64502f41f4753d9efc98b9a936ac5ba2ac Mon Sep 17 00:00:00 2001
From: redxaxder <abyaly@gmail.com>
Date: Fri, 24 Sep 2021 17:20:05 -0500
Subject: [PATCH] Accessor for words of 32 byte hashes (#238)

---
 .../src/Cardano/Crypto/Hash/Class.hs          | 30 ++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)

diff --git a/cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs b/cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs
index 789311ddc..0b5dfc45d 100644
--- a/cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs
+++ b/cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -26,6 +27,9 @@ module Cardano.Crypto.Hash.Class
   , hashFromBytes
   , hashToBytesShort
   , hashFromBytesShort
+  , ViewHash32 (..)
+  , unsafeMkHash32
+  , viewHash32
 
     -- * Rendering and parsing
   , hashToBytesAsHex
@@ -52,8 +56,10 @@ import Data.List (foldl')
 import Data.Maybe (maybeToList)
 import Data.Proxy (Proxy(..))
 import Data.Typeable (Typeable)
+import Data.Word (Word64)
 import GHC.Generics (Generic)
-import GHC.TypeLits (KnownNat, Nat, natVal)
+import GHC.TypeLits (KnownNat, Nat, natVal, sameNat)
+import Data.Type.Equality ((:~:)(Refl))
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
@@ -299,6 +305,28 @@ instance (HashAlgorithm h, Typeable a) => FromCBOR (Hash h a) where
           expected = sizeHash (Proxy :: Proxy h)
           actual   = BS.length bs
 
+data ViewHash32 h a where
+  ViewHash32 :: SizeHash h ~ 32
+    => Word64
+    -> Word64
+    -> Word64
+    -> Word64
+    -> ViewHash32 h a
+  ViewHashNot32 :: ViewHash32 h a
+
+viewHash32 :: forall h a. HashAlgorithm h => Hash h a -> ViewHash32 h a
+viewHash32 (UnsafeHashRep p) = go p
+  where
+    go :: forall n. PackedBytes n -> ViewHash32 h a
+    go (PackedBytes32 a b c d) =
+      case sameNat (Proxy :: Proxy (SizeHash h)) (Proxy :: Proxy 32) of
+        Just Refl -> ViewHash32 a b c d
+        Nothing -> ViewHashNot32
+    go _ = ViewHashNot32
+
+unsafeMkHash32 ::
+  SizeHash h ~ 32 => Word64 -> Word64 -> Word64 -> Word64 -> Hash h a
+unsafeMkHash32 a b c d = UnsafeHashRep (PackedBytes32 a b c d)
 
 --
 -- Deprecated