{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Merkle tree implementation.
--
-- See <https://tools.ietf.org/html/rfc6962>.
module Cardano.Chain.Common.Merkle (
  -- * MerkleRoot
  MerkleRoot (..),

  -- * MerkleTree
  MerkleTree (..),
  mtRoot,
  mkMerkleTree,
  mkMerkleTreeDecoded,

  -- * MerkleNode
  MerkleNode (..),
  mkBranch,
  mkLeaf,
  mkLeafDecoded,
)
where

-- Cardano.Prelude has its own Rube Goldberg variant of 'Foldable' which we do not
-- want. It would be great if we could write
--   import           Cardano.Prelude hiding (toList, foldMap)
-- but HLint insists that this is not OK because toList and foldMap are never
-- used unqualified. The hiding in fact makes it clearer for the human reader
-- what's going on.

import Cardano.Crypto (Hash, hashDecoded, hashRaw, hashToBytes)
import Cardano.Crypto.Raw (Raw)
import Cardano.Ledger.Binary (
  Annotated (..),
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  byronProtVer,
  fromByronCBOR,
  serializeBuilder,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Data.ByteString.Builder (Builder, byteString, word8)
import qualified Data.ByteString.Builder.Extra as Builder
import qualified Data.ByteString.Lazy as LBS
import Data.Coerce (coerce)
import qualified Data.Foldable as F
import Formatting.Buildable (Buildable (..))
import NoThunks.Class (NoThunks (..))
import qualified Prelude

--------------------------------------------------------------------------------
-- MerkleRoot
--------------------------------------------------------------------------------

-- | Data type for root of Merkle tree
newtype MerkleRoot a = MerkleRoot
  { forall a. MerkleRoot a -> Hash Raw
getMerkleRoot :: Hash Raw
  -- ^ returns root 'Hash' of Merkle Tree
  }
  deriving (Int -> MerkleRoot a -> ShowS
forall a. Int -> MerkleRoot a -> ShowS
forall a. [MerkleRoot a] -> ShowS
forall a. MerkleRoot a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MerkleRoot a] -> ShowS
$cshowList :: forall a. [MerkleRoot a] -> ShowS
show :: MerkleRoot a -> String
$cshow :: forall a. MerkleRoot a -> String
showsPrec :: Int -> MerkleRoot a -> ShowS
$cshowsPrec :: forall a. Int -> MerkleRoot a -> ShowS
Show, MerkleRoot a -> MerkleRoot a -> Bool
forall a. MerkleRoot a -> MerkleRoot a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MerkleRoot a -> MerkleRoot a -> Bool
$c/= :: forall a. MerkleRoot a -> MerkleRoot a -> Bool
== :: MerkleRoot a -> MerkleRoot a -> Bool
$c== :: forall a. MerkleRoot a -> MerkleRoot a -> Bool
Eq, MerkleRoot a -> MerkleRoot a -> Bool
MerkleRoot a -> MerkleRoot a -> Ordering
MerkleRoot a -> MerkleRoot a -> MerkleRoot a
forall a. Eq (MerkleRoot a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. MerkleRoot a -> MerkleRoot a -> Bool
forall a. MerkleRoot a -> MerkleRoot a -> Ordering
forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
min :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a
$cmin :: forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
max :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a
$cmax :: forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
>= :: MerkleRoot a -> MerkleRoot a -> Bool
$c>= :: forall a. MerkleRoot a -> MerkleRoot a -> Bool
> :: MerkleRoot a -> MerkleRoot a -> Bool
$c> :: forall a. MerkleRoot a -> MerkleRoot a -> Bool
<= :: MerkleRoot a -> MerkleRoot a -> Bool
$c<= :: forall a. MerkleRoot a -> MerkleRoot a -> Bool
< :: MerkleRoot a -> MerkleRoot a -> Bool
$c< :: forall a. MerkleRoot a -> MerkleRoot a -> Bool
compare :: MerkleRoot a -> MerkleRoot a -> Ordering
$ccompare :: forall a. MerkleRoot a -> MerkleRoot a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MerkleRoot a) x -> MerkleRoot a
forall a x. MerkleRoot a -> Rep (MerkleRoot a) x
$cto :: forall a x. Rep (MerkleRoot a) x -> MerkleRoot a
$cfrom :: forall a x. MerkleRoot a -> Rep (MerkleRoot a) x
Generic)
  deriving anyclass (forall a. MerkleRoot a -> ()
forall a. (a -> ()) -> NFData a
rnf :: MerkleRoot a -> ()
$crnf :: forall a. MerkleRoot a -> ()
NFData, forall a. Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
forall a. Proxy (MerkleRoot a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (MerkleRoot a) -> String
$cshowTypeOf :: forall a. Proxy (MerkleRoot a) -> String
wNoThunks :: Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a. Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
noThunks :: Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a. Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
NoThunks)

instance Buildable (MerkleRoot a) where
  build :: MerkleRoot a -> Builder
build (MerkleRoot Hash Raw
h) = Builder
"MerkleRoot|" forall a. Semigroup a => a -> a -> a
<> forall p. Buildable p => p -> Builder
build Hash Raw
h

-- Used for debugging purposes only
instance ToJSON a => ToJSON (MerkleRoot a)

instance EncCBOR a => ToCBOR (MerkleRoot a) where
  toCBOR :: MerkleRoot a -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance DecCBOR a => FromCBOR (MerkleRoot a) where
  fromCBOR :: forall s. Decoder s (MerkleRoot a)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR a => EncCBOR (MerkleRoot a) where
  encCBOR :: MerkleRoot a -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. MerkleRoot a -> Hash Raw
getMerkleRoot
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (MerkleRoot a) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size = forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. MerkleRoot a -> Hash Raw
getMerkleRoot

instance DecCBOR a => DecCBOR (MerkleRoot a) where
  decCBOR :: forall s. Decoder s (MerkleRoot a)
decCBOR = forall a. Hash Raw -> MerkleRoot a
MerkleRoot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

merkleRootToBuilder :: MerkleRoot a -> Builder
merkleRootToBuilder :: forall a. MerkleRoot a -> Builder
merkleRootToBuilder (MerkleRoot Hash Raw
h) = ByteString -> Builder
byteString (forall algo a. AbstractHash algo a -> ByteString
hashToBytes Hash Raw
h)

mkRoot :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a
mkRoot :: forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
mkRoot MerkleRoot a
a MerkleRoot a
b =
  forall a. Hash Raw -> MerkleRoot a
MerkleRoot
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Hash Raw
hashRaw
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> ByteString
toLazyByteString
    forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
      [Word8 -> Builder
word8 Word8
1, forall a. MerkleRoot a -> Builder
merkleRootToBuilder MerkleRoot a
a, forall a. MerkleRoot a -> Builder
merkleRootToBuilder MerkleRoot a
b]

emptyHash :: MerkleRoot a
emptyHash :: forall a. MerkleRoot a
emptyHash = forall a. Hash Raw -> MerkleRoot a
MerkleRoot (ByteString -> Hash Raw
hashRaw forall a. Monoid a => a
mempty)

--------------------------------------------------------------------------------
-- MerkleTree
--------------------------------------------------------------------------------

data MerkleTree a
  = MerkleEmpty
  | MerkleTree !Word32 !(MerkleNode a)
  deriving (MerkleTree a -> MerkleTree a -> Bool
forall a. Eq a => MerkleTree a -> MerkleTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MerkleTree a -> MerkleTree a -> Bool
$c/= :: forall a. Eq a => MerkleTree a -> MerkleTree a -> Bool
== :: MerkleTree a -> MerkleTree a -> Bool
$c== :: forall a. Eq a => MerkleTree a -> MerkleTree a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MerkleTree a) x -> MerkleTree a
forall a x. MerkleTree a -> Rep (MerkleTree a) x
$cto :: forall a x. Rep (MerkleTree a) x -> MerkleTree a
$cfrom :: forall a x. MerkleTree a -> Rep (MerkleTree a) x
Generic)
  deriving anyclass (forall a. NFData a => MerkleTree a -> ()
forall a. (a -> ()) -> NFData a
rnf :: MerkleTree a -> ()
$crnf :: forall a. NFData a => MerkleTree a -> ()
NFData)

instance Foldable MerkleTree where
  foldMap :: forall m a. Monoid m => (a -> m) -> MerkleTree a -> m
foldMap a -> m
_ MerkleTree a
MerkleEmpty = forall a. Monoid a => a
mempty
  foldMap a -> m
f (MerkleTree Word32
_ MerkleNode a
n) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f MerkleNode a
n

  null :: forall a. MerkleTree a -> Bool
null MerkleTree a
MerkleEmpty = Bool
True
  null MerkleTree a
_ = Bool
False

  length :: forall a. MerkleTree a -> Int
length MerkleTree a
MerkleEmpty = Int
0
  length (MerkleTree Word32
s MerkleNode a
_) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s

instance Show a => Show (MerkleTree a) where
  show :: MerkleTree a -> String
show MerkleTree a
tree = String
"Merkle tree: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, ConvertText String b) => a -> b
show (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList MerkleTree a
tree)

instance EncCBOR a => ToCBOR (MerkleTree a) where
  toCBOR :: MerkleTree a -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance (DecCBOR a, EncCBOR a) => FromCBOR (MerkleTree a) where
  fromCBOR :: forall s. Decoder s (MerkleTree a)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- This instance is both faster and more space-efficient (as confirmed by a
-- benchmark). Hashing turns out to be faster than decoding extra data.
instance EncCBOR a => EncCBOR (MerkleTree a) where
  encCBOR :: MerkleTree a -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

instance (DecCBOR a, EncCBOR a) => DecCBOR (MerkleTree a) where
  decCBOR :: forall s. Decoder s (MerkleTree a)
decCBOR = forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | Smart constructor for 'MerkleTree'
mkMerkleTree :: EncCBOR a => [a] -> MerkleTree a
mkMerkleTree :: forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree = forall (f :: * -> * -> *) a b.
(f a b -> MerkleNode a) -> [f a b] -> MerkleTree a
mkMerkleTree' (forall a. EncCBOR a => a -> MerkleNode a
mkLeaf forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} a (b :: k). Const a b -> a
getConst) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} a (b :: k). a -> Const a b
Const

-- | Reconstruct a 'MerkleTree' from a decoded list of items
mkMerkleTreeDecoded :: [Annotated a ByteString] -> MerkleTree a
mkMerkleTreeDecoded :: forall a. [Annotated a ByteString] -> MerkleTree a
mkMerkleTreeDecoded = forall (f :: * -> * -> *) a b.
(f a b -> MerkleNode a) -> [f a b] -> MerkleTree a
mkMerkleTree' forall a. Annotated a ByteString -> MerkleNode a
mkLeafDecoded

mkMerkleTree' ::
  forall f a b. (f a b -> MerkleNode a) -> [f a b] -> MerkleTree a
mkMerkleTree' :: forall (f :: * -> * -> *) a b.
(f a b -> MerkleNode a) -> [f a b] -> MerkleTree a
mkMerkleTree' f a b -> MerkleNode a
_ [] = forall a. MerkleTree a
MerkleEmpty
mkMerkleTree' f a b -> MerkleNode a
leafBuilder [f a b]
ls = forall a. Word32 -> MerkleNode a -> MerkleTree a
MerkleTree (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lsLen) (Int -> [f a b] -> MerkleNode a
go Int
lsLen [f a b]
ls)
  where
    lsLen :: Int
lsLen = forall a. HasLength a => a -> Int
length [f a b]
ls
    go :: Int -> [f a b] -> MerkleNode a
    go :: Int -> [f a b] -> MerkleNode a
go Int
_ [f a b
x] = f a b -> MerkleNode a
leafBuilder f a b
x
    go Int
len [f a b]
xs = forall a. MerkleNode a -> MerkleNode a -> MerkleNode a
mkBranch (Int -> [f a b] -> MerkleNode a
go Int
i [f a b]
l) (Int -> [f a b] -> MerkleNode a
go (Int
len forall a. Num a => a -> a -> a
- Int
i) [f a b]
r)
      where
        i :: Int
i = forall a. (Bits a, Num a) => a -> a
powerOfTwo Int
len
        ([f a b]
l, [f a b]
r) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [f a b]
xs

-- | Return the largest power of two such that it's smaller than X.
--
-- >>> powerOfTwo 64
-- 32
-- >>> powerOfTwo 65
-- 64
powerOfTwo :: forall a. (Bits a, Num a) => a -> a
powerOfTwo :: forall a. (Bits a, Num a) => a -> a
powerOfTwo a
n
  | a
n forall a. Bits a => a -> a -> a
.&. (a
n forall a. Num a => a -> a -> a
- a
1) forall a. Eq a => a -> a -> Bool
== a
0 = a
n forall a. Bits a => a -> Int -> a
`shiftR` Int
1
  | Bool
otherwise = a -> a
go a
n
  where
    {- “x .&. (x - 1)” clears the least significant bit:

           ↓
       01101000     x
       01100111     x - 1
       --------
       01100000     x .&. (x - 1)

       I could've used something like “until (\x -> x*2 > w) (*2) 1”,
       but bit tricks are fun. -}
    go :: a -> a
    go :: a -> a
go a
w = if a
w forall a. Bits a => a -> a -> a
.&. (a
w forall a. Num a => a -> a -> a
- a
1) forall a. Eq a => a -> a -> Bool
== a
0 then a
w else a -> a
go (a
w forall a. Bits a => a -> a -> a
.&. (a
w forall a. Num a => a -> a -> a
- a
1))

-- | Returns root of Merkle tree
mtRoot :: MerkleTree a -> MerkleRoot a
mtRoot :: forall a. MerkleTree a -> MerkleRoot a
mtRoot MerkleTree a
MerkleEmpty = forall a. MerkleRoot a
emptyHash
mtRoot (MerkleTree Word32
_ MerkleNode a
n) = forall a. MerkleNode a -> MerkleRoot a
nodeRoot MerkleNode a
n

--------------------------------------------------------------------------------
-- MerkleNode
--------------------------------------------------------------------------------

data MerkleNode a
  = -- | MerkleBranch mRoot mLeft mRight
    MerkleBranch !(MerkleRoot a) !(MerkleNode a) !(MerkleNode a)
  | -- | MerkleLeaf mRoot mVal
    MerkleLeaf !(MerkleRoot a) a
  deriving (MerkleNode a -> MerkleNode a -> Bool
forall a. Eq a => MerkleNode a -> MerkleNode a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MerkleNode a -> MerkleNode a -> Bool
$c/= :: forall a. Eq a => MerkleNode a -> MerkleNode a -> Bool
== :: MerkleNode a -> MerkleNode a -> Bool
$c== :: forall a. Eq a => MerkleNode a -> MerkleNode a -> Bool
Eq, Int -> MerkleNode a -> ShowS
forall a. Show a => Int -> MerkleNode a -> ShowS
forall a. Show a => [MerkleNode a] -> ShowS
forall a. Show a => MerkleNode a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MerkleNode a] -> ShowS
$cshowList :: forall a. Show a => [MerkleNode a] -> ShowS
show :: MerkleNode a -> String
$cshow :: forall a. Show a => MerkleNode a -> String
showsPrec :: Int -> MerkleNode a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MerkleNode a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MerkleNode a) x -> MerkleNode a
forall a x. MerkleNode a -> Rep (MerkleNode a) x
$cto :: forall a x. Rep (MerkleNode a) x -> MerkleNode a
$cfrom :: forall a x. MerkleNode a -> Rep (MerkleNode a) x
Generic)
  deriving anyclass (forall a. NFData a => MerkleNode a -> ()
forall a. (a -> ()) -> NFData a
rnf :: MerkleNode a -> ()
$crnf :: forall a. NFData a => MerkleNode a -> ()
NFData)

instance Foldable MerkleNode where
  foldMap :: forall m a. Monoid m => (a -> m) -> MerkleNode a -> m
foldMap a -> m
f MerkleNode a
x = case MerkleNode a
x of
    MerkleLeaf MerkleRoot a
_ a
mVal -> a -> m
f a
mVal
    MerkleBranch MerkleRoot a
_ MerkleNode a
mLeft MerkleNode a
mRight ->
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f MerkleNode a
mLeft forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f MerkleNode a
mRight

toLazyByteString :: Builder -> LBS.ByteString
toLazyByteString :: Builder -> ByteString
toLazyByteString =
  AllocationStrategy -> ByteString -> Builder -> ByteString
Builder.toLazyByteStringWith (Int -> Int -> AllocationStrategy
Builder.safeStrategy Int
1024 Int
4096) forall a. Monoid a => a
mempty

nodeRoot :: MerkleNode a -> MerkleRoot a
nodeRoot :: forall a. MerkleNode a -> MerkleRoot a
nodeRoot (MerkleLeaf MerkleRoot a
root a
_) = MerkleRoot a
root
nodeRoot (MerkleBranch MerkleRoot a
root MerkleNode a
_ MerkleNode a
_) = MerkleRoot a
root

mkLeaf :: forall a. EncCBOR a => a -> MerkleNode a
mkLeaf :: forall a. EncCBOR a => a -> MerkleNode a
mkLeaf a
a = forall a. MerkleRoot a -> a -> MerkleNode a
MerkleLeaf MerkleRoot a
mRoot a
a
  where
    mRoot :: MerkleRoot a
    mRoot :: MerkleRoot a
mRoot =
      forall a. Hash Raw -> MerkleRoot a
MerkleRoot
        forall a b. (a -> b) -> a -> b
$ ByteString -> Hash Raw
hashRaw
          (Builder -> ByteString
toLazyByteString (Word8 -> Builder
word8 Word8
0 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => Version -> a -> Builder
serializeBuilder Version
byronProtVer a
a))

mkLeafDecoded :: Annotated a ByteString -> MerkleNode a
mkLeafDecoded :: forall a. Annotated a ByteString -> MerkleNode a
mkLeafDecoded Annotated a ByteString
a = forall a. MerkleRoot a -> a -> MerkleNode a
MerkleLeaf forall a. MerkleRoot a
mRoot (forall b a. Annotated b a -> b
unAnnotated Annotated a ByteString
a)
  where
    mRoot :: MerkleRoot a
    mRoot :: forall a. MerkleRoot a
mRoot = forall a. Hash Raw -> MerkleRoot a
MerkleRoot forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
prependTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotated a ByteString
a

    prependTag :: ByteString -> ByteString
prependTag = (ByteString -> ByteString
LBS.toStrict (Builder -> ByteString
toLazyByteString (Word8 -> Builder
word8 Word8
0)) forall a. Semigroup a => a -> a -> a
<>)

mkBranch :: MerkleNode a -> MerkleNode a -> MerkleNode a
mkBranch :: forall a. MerkleNode a -> MerkleNode a -> MerkleNode a
mkBranch MerkleNode a
nodeA MerkleNode a
nodeB = forall a.
MerkleRoot a -> MerkleNode a -> MerkleNode a -> MerkleNode a
MerkleBranch MerkleRoot a
root MerkleNode a
nodeA MerkleNode a
nodeB
  where
    root :: MerkleRoot a
root = forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
mkRoot (forall a. MerkleNode a -> MerkleRoot a
nodeRoot MerkleNode a
nodeA) (forall a. MerkleNode a -> MerkleRoot a
nodeRoot MerkleNode a
nodeB)