{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Chain.Common.Merkle (
MerkleRoot (..),
MerkleTree (..),
mtRoot,
mkMerkleTree,
mkMerkleTreeDecoded,
MerkleNode (..),
mkBranch,
mkLeaf,
mkLeafDecoded,
) where
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
newtype MerkleRoot a = MerkleRoot
{ forall a. MerkleRoot a -> Hash Raw
getMerkleRoot :: Hash Raw
}
deriving (Int -> MerkleRoot a -> ShowS
[MerkleRoot a] -> ShowS
MerkleRoot a -> String
(Int -> MerkleRoot a -> ShowS)
-> (MerkleRoot a -> String)
-> ([MerkleRoot a] -> ShowS)
-> Show (MerkleRoot a)
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
$cshowsPrec :: forall a. Int -> MerkleRoot a -> ShowS
showsPrec :: Int -> MerkleRoot a -> ShowS
$cshow :: forall a. MerkleRoot a -> String
show :: MerkleRoot a -> String
$cshowList :: forall a. [MerkleRoot a] -> ShowS
showList :: [MerkleRoot a] -> ShowS
Show, MerkleRoot a -> MerkleRoot a -> Bool
(MerkleRoot a -> MerkleRoot a -> Bool)
-> (MerkleRoot a -> MerkleRoot a -> Bool) -> Eq (MerkleRoot a)
forall a. MerkleRoot a -> MerkleRoot a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, Eq (MerkleRoot a)
Eq (MerkleRoot a) =>
(MerkleRoot a -> MerkleRoot a -> Ordering)
-> (MerkleRoot a -> MerkleRoot a -> Bool)
-> (MerkleRoot a -> MerkleRoot a -> Bool)
-> (MerkleRoot a -> MerkleRoot a -> Bool)
-> (MerkleRoot a -> MerkleRoot a -> Bool)
-> (MerkleRoot a -> MerkleRoot a -> MerkleRoot a)
-> (MerkleRoot a -> MerkleRoot a -> MerkleRoot a)
-> Ord (MerkleRoot a)
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
$ccompare :: forall a. MerkleRoot a -> MerkleRoot a -> Ordering
compare :: MerkleRoot a -> MerkleRoot a -> Ordering
$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
>= :: MerkleRoot a -> MerkleRoot a -> Bool
$cmax :: forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
max :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a
$cmin :: forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
min :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a
Ord, (forall x. MerkleRoot a -> Rep (MerkleRoot a) x)
-> (forall x. Rep (MerkleRoot a) x -> MerkleRoot a)
-> Generic (MerkleRoot a)
forall x. Rep (MerkleRoot a) x -> MerkleRoot a
forall x. MerkleRoot a -> Rep (MerkleRoot a) x
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
$cfrom :: forall a x. MerkleRoot a -> Rep (MerkleRoot a) x
from :: forall x. MerkleRoot a -> Rep (MerkleRoot a) x
$cto :: forall a x. Rep (MerkleRoot a) x -> MerkleRoot a
to :: forall x. Rep (MerkleRoot a) x -> MerkleRoot a
Generic)
deriving anyclass (MerkleRoot a -> ()
(MerkleRoot a -> ()) -> NFData (MerkleRoot a)
forall a. MerkleRoot a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. MerkleRoot a -> ()
rnf :: MerkleRoot a -> ()
NFData, Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
Proxy (MerkleRoot a) -> String
(Context -> MerkleRoot a -> IO (Maybe ThunkInfo))
-> (Context -> MerkleRoot a -> IO (Maybe ThunkInfo))
-> (Proxy (MerkleRoot a) -> String)
-> NoThunks (MerkleRoot a)
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
$cnoThunks :: forall a. Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
noThunks :: Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a. Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> MerkleRoot a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. Proxy (MerkleRoot a) -> String
showTypeOf :: Proxy (MerkleRoot a) -> String
NoThunks)
instance Buildable (MerkleRoot a) where
build :: MerkleRoot a -> Builder
build (MerkleRoot Hash Raw
h) = Builder
"MerkleRoot|" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Hash Raw -> Builder
forall p. Buildable p => p -> Builder
build Hash Raw
h
instance ToJSON a => ToJSON (MerkleRoot a)
instance EncCBOR a => ToCBOR (MerkleRoot a) where
toCBOR :: MerkleRoot a -> Encoding
toCBOR = MerkleRoot a -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
instance DecCBOR a => FromCBOR (MerkleRoot a) where
fromCBOR :: forall s. Decoder s (MerkleRoot a)
fromCBOR = Decoder s (MerkleRoot a)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance EncCBOR a => EncCBOR (MerkleRoot a) where
encCBOR :: MerkleRoot a -> Encoding
encCBOR = Hash Raw -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Hash Raw -> Encoding)
-> (MerkleRoot a -> Hash Raw) -> MerkleRoot a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MerkleRoot a -> Hash Raw
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 t. EncCBOR t => Proxy t -> Size)
-> Proxy (Hash Raw) -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Proxy (Hash Raw) -> Size)
-> (Proxy (MerkleRoot a) -> Proxy (Hash Raw))
-> Proxy (MerkleRoot a)
-> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MerkleRoot a -> Hash Raw)
-> Proxy (MerkleRoot a) -> Proxy (Hash Raw)
forall a b. (a -> b) -> Proxy a -> Proxy b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MerkleRoot a -> Hash Raw
forall a. MerkleRoot a -> Hash Raw
getMerkleRoot
instance DecCBOR a => DecCBOR (MerkleRoot a) where
decCBOR :: forall s. Decoder s (MerkleRoot a)
decCBOR = Hash Raw -> MerkleRoot a
forall a. Hash Raw -> MerkleRoot a
MerkleRoot (Hash Raw -> MerkleRoot a)
-> Decoder s (Hash Raw) -> Decoder s (MerkleRoot a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Hash Raw)
forall s. Decoder s (Hash Raw)
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 (Hash Raw -> 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 =
Hash Raw -> MerkleRoot a
forall a. Hash Raw -> MerkleRoot a
MerkleRoot
(Hash Raw -> MerkleRoot a)
-> (Builder -> Hash Raw) -> Builder -> MerkleRoot a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
(ByteString -> Hash Raw)
-> (Builder -> ByteString) -> Builder -> Hash Raw
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
(Builder -> MerkleRoot a) -> Builder -> MerkleRoot a
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[Word8 -> Builder
word8 Word8
1, MerkleRoot a -> Builder
forall a. MerkleRoot a -> Builder
merkleRootToBuilder MerkleRoot a
a, MerkleRoot a -> Builder
forall a. MerkleRoot a -> Builder
merkleRootToBuilder MerkleRoot a
b]
emptyHash :: MerkleRoot a
emptyHash :: forall a. MerkleRoot a
emptyHash = Hash Raw -> MerkleRoot a
forall a. Hash Raw -> MerkleRoot a
MerkleRoot (ByteString -> Hash Raw
hashRaw ByteString
forall a. Monoid a => a
mempty)
data MerkleTree a
= MerkleEmpty
| MerkleTree !Word32 !(MerkleNode a)
deriving (MerkleTree a -> MerkleTree a -> Bool
(MerkleTree a -> MerkleTree a -> Bool)
-> (MerkleTree a -> MerkleTree a -> Bool) -> Eq (MerkleTree a)
forall a. Eq a => MerkleTree a -> MerkleTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: MerkleTree a -> MerkleTree a -> Bool
Eq, (forall x. MerkleTree a -> Rep (MerkleTree a) x)
-> (forall x. Rep (MerkleTree a) x -> MerkleTree a)
-> Generic (MerkleTree a)
forall x. Rep (MerkleTree a) x -> MerkleTree a
forall x. MerkleTree a -> Rep (MerkleTree a) x
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
$cfrom :: forall a x. MerkleTree a -> Rep (MerkleTree a) x
from :: forall x. MerkleTree a -> Rep (MerkleTree a) x
$cto :: forall a x. Rep (MerkleTree a) x -> MerkleTree a
to :: forall x. Rep (MerkleTree a) x -> MerkleTree a
Generic)
deriving anyclass (MerkleTree a -> ()
(MerkleTree a -> ()) -> NFData (MerkleTree a)
forall a. NFData a => MerkleTree a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => MerkleTree a -> ()
rnf :: MerkleTree a -> ()
NFData)
instance Foldable MerkleTree where
foldMap :: forall m a. Monoid m => (a -> m) -> MerkleTree a -> m
foldMap a -> m
_ MerkleTree a
MerkleEmpty = m
forall a. Monoid a => a
mempty
foldMap a -> m
f (MerkleTree Word32
_ MerkleNode a
n) = (a -> m) -> MerkleNode a -> m
forall m a. Monoid m => (a -> m) -> MerkleNode a -> m
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
_) = Word32 -> Int
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: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a b. (Show a, ConvertText String b) => a -> b
show (MerkleTree a -> [a]
forall a. MerkleTree a -> [a]
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 = MerkleTree a -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR
instance (DecCBOR a, EncCBOR a) => FromCBOR (MerkleTree a) where
fromCBOR :: forall s. Decoder s (MerkleTree a)
fromCBOR = Decoder s (MerkleTree a)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
instance EncCBOR a => EncCBOR (MerkleTree a) where
encCBOR :: MerkleTree a -> Encoding
encCBOR = [a] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([a] -> Encoding)
-> (MerkleTree a -> [a]) -> MerkleTree a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MerkleTree a -> [a]
forall a. MerkleTree a -> [a]
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 = [a] -> MerkleTree a
forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree ([a] -> MerkleTree a) -> Decoder s [a] -> Decoder s (MerkleTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [a]
forall s. Decoder s [a]
forall a s. DecCBOR a => Decoder s a
decCBOR
mkMerkleTree :: EncCBOR a => [a] -> MerkleTree a
mkMerkleTree :: forall a. EncCBOR a => [a] -> MerkleTree a
mkMerkleTree = (Const a Any -> MerkleNode a) -> [Const a Any] -> MerkleTree a
forall (f :: * -> * -> *) a b.
(f a b -> MerkleNode a) -> [f a b] -> MerkleTree a
mkMerkleTree' (a -> MerkleNode a
forall a. EncCBOR a => a -> MerkleNode a
mkLeaf (a -> MerkleNode a)
-> (Const a Any -> a) -> Const a Any -> MerkleNode a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Const a Any -> a
forall {k} a (b :: k). Const a b -> a
getConst) ([Const a Any] -> MerkleTree a)
-> ([a] -> [Const a Any]) -> [a] -> MerkleTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Const a Any) -> [a] -> [Const a Any]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Const a Any
forall {k} a (b :: k). a -> Const a b
Const
mkMerkleTreeDecoded :: [Annotated a ByteString] -> MerkleTree a
mkMerkleTreeDecoded :: forall a. [Annotated a ByteString] -> MerkleTree a
mkMerkleTreeDecoded = (Annotated a ByteString -> MerkleNode a)
-> [Annotated a ByteString] -> MerkleTree a
forall (f :: * -> * -> *) a b.
(f a b -> MerkleNode a) -> [f a b] -> MerkleTree a
mkMerkleTree' Annotated a ByteString -> MerkleNode a
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
_ [] = MerkleTree a
forall a. MerkleTree a
MerkleEmpty
mkMerkleTree' f a b -> MerkleNode a
leafBuilder [f a b]
ls = Word32 -> MerkleNode a -> MerkleTree a
forall a. Word32 -> MerkleNode a -> MerkleTree a
MerkleTree (Int -> Word32
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 = [f a b] -> Int
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 = MerkleNode a -> MerkleNode a -> MerkleNode a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) [f a b]
r)
where
i :: Int
i = Int -> Int
forall a. (Bits a, Num a) => a -> a
powerOfTwo Int
len
([f a b]
l, [f a b]
r) = Int -> [f a b] -> ([f a b], [f a b])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [f a b]
xs
powerOfTwo :: forall a. (Bits a, Num a) => a -> a
powerOfTwo :: forall a. (Bits a, Num a) => a -> a
powerOfTwo a
n
| a
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
| Bool
otherwise = a -> a
go a
n
where
go :: a -> a
go :: a -> a
go a
w = if a
w a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
w else a -> a
go (a
w a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
1))
mtRoot :: MerkleTree a -> MerkleRoot a
mtRoot :: forall a. MerkleTree a -> MerkleRoot a
mtRoot MerkleTree a
MerkleEmpty = MerkleRoot a
forall a. MerkleRoot a
emptyHash
mtRoot (MerkleTree Word32
_ MerkleNode a
n) = MerkleNode a -> MerkleRoot a
forall a. MerkleNode a -> MerkleRoot a
nodeRoot MerkleNode a
n
data MerkleNode a
=
MerkleBranch !(MerkleRoot a) !(MerkleNode a) !(MerkleNode a)
|
MerkleLeaf !(MerkleRoot a) a
deriving (MerkleNode a -> MerkleNode a -> Bool
(MerkleNode a -> MerkleNode a -> Bool)
-> (MerkleNode a -> MerkleNode a -> Bool) -> Eq (MerkleNode a)
forall a. Eq a => MerkleNode a -> MerkleNode a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: MerkleNode a -> MerkleNode a -> Bool
Eq, Int -> MerkleNode a -> ShowS
[MerkleNode a] -> ShowS
MerkleNode a -> String
(Int -> MerkleNode a -> ShowS)
-> (MerkleNode a -> String)
-> ([MerkleNode a] -> ShowS)
-> Show (MerkleNode a)
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
$cshowsPrec :: forall a. Show a => Int -> MerkleNode a -> ShowS
showsPrec :: Int -> MerkleNode a -> ShowS
$cshow :: forall a. Show a => MerkleNode a -> String
show :: MerkleNode a -> String
$cshowList :: forall a. Show a => [MerkleNode a] -> ShowS
showList :: [MerkleNode a] -> ShowS
Show, (forall x. MerkleNode a -> Rep (MerkleNode a) x)
-> (forall x. Rep (MerkleNode a) x -> MerkleNode a)
-> Generic (MerkleNode a)
forall x. Rep (MerkleNode a) x -> MerkleNode a
forall x. MerkleNode a -> Rep (MerkleNode a) x
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
$cfrom :: forall a x. MerkleNode a -> Rep (MerkleNode a) x
from :: forall x. MerkleNode a -> Rep (MerkleNode a) x
$cto :: forall a x. Rep (MerkleNode a) x -> MerkleNode a
to :: forall x. Rep (MerkleNode a) x -> MerkleNode a
Generic)
deriving anyclass (MerkleNode a -> ()
(MerkleNode a -> ()) -> NFData (MerkleNode a)
forall a. NFData a => MerkleNode a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => MerkleNode a -> ()
rnf :: 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 ->
(a -> m) -> MerkleNode a -> m
forall m a. Monoid m => (a -> m) -> MerkleNode a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f MerkleNode a
mLeft m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> MerkleNode a -> m
forall m a. Monoid m => (a -> m) -> MerkleNode a -> m
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) ByteString
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 = MerkleRoot a -> a -> MerkleNode a
forall a. MerkleRoot a -> a -> MerkleNode a
MerkleLeaf MerkleRoot a
mRoot a
a
where
mRoot :: MerkleRoot a
mRoot :: MerkleRoot a
mRoot =
Hash Raw -> MerkleRoot a
forall a. Hash Raw -> MerkleRoot a
MerkleRoot
(Hash Raw -> MerkleRoot a) -> Hash Raw -> MerkleRoot a
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash Raw
hashRaw
(Builder -> ByteString
toLazyByteString (Word8 -> Builder
word8 Word8
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Version -> a -> Builder
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 = MerkleRoot a -> a -> MerkleNode a
forall a. MerkleRoot a -> a -> MerkleNode a
MerkleLeaf MerkleRoot a
forall a. MerkleRoot a
mRoot (Annotated a ByteString -> a
forall b a. Annotated b a -> b
unAnnotated Annotated a ByteString
a)
where
mRoot :: MerkleRoot a
mRoot :: forall a. MerkleRoot a
mRoot = Hash Raw -> MerkleRoot a
forall a. Hash Raw -> MerkleRoot a
MerkleRoot (Hash Raw -> MerkleRoot a)
-> (Annotated a ByteString -> Hash Raw)
-> Annotated a ByteString
-> MerkleRoot a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Hash (BaseType (Annotated a ByteString)) -> Hash Raw
forall a b. Coercible a b => a -> b
coerce (Hash (BaseType (Annotated a ByteString)) -> Hash Raw)
-> (Annotated a ByteString
-> Hash (BaseType (Annotated a ByteString)))
-> Annotated a ByteString
-> Hash Raw
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Annotated a ByteString -> Hash (BaseType (Annotated a ByteString))
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded (Annotated a ByteString -> MerkleRoot a)
-> Annotated a ByteString -> MerkleRoot a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
prependTag (ByteString -> ByteString)
-> Annotated a ByteString -> Annotated a ByteString
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)) ByteString -> ByteString -> ByteString
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 = MerkleRoot a -> MerkleNode a -> MerkleNode a -> MerkleNode a
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 = MerkleRoot a -> MerkleRoot a -> MerkleRoot a
forall a. MerkleRoot a -> MerkleRoot a -> MerkleRoot a
mkRoot (MerkleNode a -> MerkleRoot a
forall a. MerkleNode a -> MerkleRoot a
nodeRoot MerkleNode a
nodeA) (MerkleNode a -> MerkleRoot a
forall a. MerkleNode a -> MerkleRoot a
nodeRoot MerkleNode a
nodeB)