{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Crypto.Hash.CompactSparseMerkleTree
(
CSMT,
CompactSparseMerkleTree (..),
Size (..),
empty,
singleton,
fromList,
insert,
delete,
lookup,
member,
notMember,
minimumDigest,
maximumDigest,
MembershipProof (..),
Proof (..),
Direction (..),
ProofType (..),
isInclusionProof,
isExclusionProof,
membershipProof,
MerkleRoot (..),
merkleRoot,
validProof,
validInclusionProof,
validExclusionProof,
valid,
depth,
toTree,
drawTree,
)
where
import Crypto.Hash (Digest, HashAlgorithm, hashFinalize, hashInit, hashUpdate, hashUpdates)
import Crypto.Hash.CompactSparseMerkleTree.DataNode (DataNode)
import qualified Crypto.Hash.CompactSparseMerkleTree.DataNode as DN
import Data.Bifunctor (first)
import Data.Bits (FiniteBits (countLeadingZeros))
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Data.Foldable (foldl', toList)
import Data.Functor (void)
import Data.Functor.Classes (Eq1 (liftEq), Ord1 (liftCompare))
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import Data.Tree (Tree)
import qualified Data.Tree as Tree
import Prelude hiding (lookup)
type CSMT = CompactSparseMerkleTree
data CompactSparseMerkleTree (i :: Size) alg a where
Nil :: CSMT 'Empty alg a
Leaf ::
{
CSMT 'NonEmpty alg a -> Digest alg
digest :: Digest alg,
CSMT 'NonEmpty alg a -> a
value :: a
} ->
CSMT 'NonEmpty alg a
Parent ::
{
CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a,
digest :: Digest alg,
CSMT 'NonEmpty alg a -> Digest alg
maxDigest :: Digest alg,
CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
} ->
CSMT 'NonEmpty alg a
data Size
=
Empty
|
NonEmpty
deriving instance (Show a) => Show (CSMT i alg a)
deriving instance Foldable (CSMT i alg)
deriving instance (Eq a) => Eq (CSMT i alg a)
deriving instance (Ord a) => Ord (CSMT i alg a)
instance Eq1 (CSMT i alg) where
liftEq :: (a -> b -> Bool) -> CSMT i alg a -> CSMT i alg b -> Bool
liftEq a -> b -> Bool
eq CSMT i alg a
m CSMT i alg b
n = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (CSMT i alg a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList CSMT i alg a
m) (CSMT i alg b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList CSMT i alg b
n)
instance Ord1 (CSMT i alg) where
liftCompare :: (a -> b -> Ordering) -> CSMT i alg a -> CSMT i alg b -> Ordering
liftCompare a -> b -> Ordering
cmp CSMT i alg a
m CSMT i alg b
n = (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (CSMT i alg a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList CSMT i alg a
m) (CSMT i alg b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList CSMT i alg b
n)
empty :: CSMT 'Empty alg a
empty :: CSMT 'Empty alg a
empty = CSMT 'Empty alg a
forall alg a. CSMT 'Empty alg a
Nil
singleton :: (ByteArrayAccess a, HashAlgorithm alg) => a -> CSMT 'NonEmpty alg a
singleton :: a -> CSMT 'NonEmpty alg a
singleton a
x = Digest alg -> a -> CSMT 'NonEmpty alg a
forall alg a. Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest (a -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Digest a
hashLeaf a
x) a
x
singletonDigest :: Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest :: Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest Digest alg
h a
x = Leaf :: forall alg a. Digest alg -> a -> CSMT 'NonEmpty alg a
Leaf {$sel:digest:Nil :: Digest alg
digest = Digest alg
h, $sel:value:Nil :: a
value = a
x}
insert :: (ByteArrayAccess a, HashAlgorithm alg) => a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insert :: a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insert a
x = Digest alg -> a -> CSMT i alg a -> CSMT 'NonEmpty alg a
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
Digest alg -> a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insertDigest (a -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Digest a
hashLeaf a
x) a
x
insertDigest :: (ByteArrayAccess a, HashAlgorithm alg) => Digest alg -> a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insertDigest :: Digest alg -> a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insertDigest Digest alg
h a
x = \case
CSMT i alg a
Nil -> Digest alg -> a -> CSMT 'NonEmpty alg a
forall alg a. Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest Digest alg
h a
x
root :: CSMT i alg a
root@Leaf {} ->
let newLeaf :: CSMT 'NonEmpty alg a
newLeaf = Digest alg -> a -> CSMT 'NonEmpty alg a
forall alg a. Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest Digest alg
h a
x
in case Digest alg
h Digest alg -> Digest alg -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT i alg a
CSMT 'NonEmpty alg a
root of
Ordering
LT -> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT 'NonEmpty alg a
newLeaf CSMT i alg a
CSMT 'NonEmpty alg a
root
Ordering
EQ -> Digest alg -> a -> CSMT 'NonEmpty alg a
forall alg a. Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest Digest alg
h a
x
Ordering
GT -> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT i alg a
CSMT 'NonEmpty alg a
root CSMT 'NonEmpty alg a
newLeaf
root :: CSMT i alg a
root@Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} ->
case Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall alg a.
Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right of
Ordering
EQ ->
let newLeaf :: CSMT 'NonEmpty alg a
newLeaf = Digest alg -> a -> CSMT 'NonEmpty alg a
forall alg a. Digest alg -> a -> CSMT 'NonEmpty alg a
singletonDigest Digest alg
h a
x
minKey :: Digest alg
minKey = Digest alg -> Digest alg -> Digest alg
forall a. Ord a => a -> a -> a
min (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
left) (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
right)
in case Digest alg
h Digest alg -> Digest alg -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Digest alg
minKey of
Ordering
LT -> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT 'NonEmpty alg a
newLeaf CSMT i alg a
CSMT 'NonEmpty alg a
root
Ordering
__ -> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT i alg a
CSMT 'NonEmpty alg a
root CSMT 'NonEmpty alg a
newLeaf
Ordering
LT -> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent (Digest alg -> a -> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
Digest alg -> a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insertDigest Digest alg
h a
x CSMT 'NonEmpty alg a
left) CSMT 'NonEmpty alg a
right
Ordering
GT -> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT 'NonEmpty alg a
left (Digest alg -> a -> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
Digest alg -> a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insertDigest Digest alg
h a
x CSMT 'NonEmpty alg a
right)
delete :: (ByteArrayAccess a, HashAlgorithm alg) => a -> CSMT i alg a -> (forall j. CSMT j alg a -> b) -> b
delete :: a -> CSMT i alg a -> (forall (j :: Size). CSMT j alg a -> b) -> b
delete a
x = Digest alg
-> CSMT i alg a -> (forall (j :: Size). CSMT j alg a -> b) -> b
forall alg (i :: Size) a b.
HashAlgorithm alg =>
Digest alg
-> CSMT i alg a -> (forall (j :: Size). CSMT j alg a -> b) -> b
deleteDigest (a -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Digest a
hashLeaf a
x)
deleteDigest :: HashAlgorithm alg => Digest alg -> CSMT i alg a -> (forall j. CSMT j alg a -> b) -> b
deleteDigest :: Digest alg
-> CSMT i alg a -> (forall (j :: Size). CSMT j alg a -> b) -> b
deleteDigest Digest alg
h CSMT i alg a
root forall (j :: Size). CSMT j alg a -> b
returnTree = case CSMT i alg a
root of
Nil {} -> CSMT i alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree CSMT i alg a
root
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest}
| Digest alg
h Digest alg -> Digest alg -> Bool
forall a. Eq a => a -> a -> Bool
== Digest alg
digest -> CSMT 'Empty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree CSMT 'Empty alg a
forall alg a. CSMT 'Empty alg a
empty
| Bool
otherwise -> CSMT i alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree CSMT i alg a
root
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} ->
case Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall alg a.
Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right of
Ordering
EQ -> CSMT i alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree CSMT i alg a
root
Ordering
LT -> Digest alg
-> CSMT 'NonEmpty alg a
-> (forall (j :: Size). CSMT j alg a -> b)
-> b
forall alg (i :: Size) a b.
HashAlgorithm alg =>
Digest alg
-> CSMT i alg a -> (forall (j :: Size). CSMT j alg a -> b) -> b
deleteDigest Digest alg
h CSMT 'NonEmpty alg a
left ((forall (j :: Size). CSMT j alg a -> b) -> b)
-> (forall (j :: Size). CSMT j alg a -> b) -> b
forall a b. (a -> b) -> a -> b
$ \case
Nil {} -> CSMT 'NonEmpty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree CSMT 'NonEmpty alg a
right
left' :: CSMT j alg a
left'@Leaf {} -> CSMT 'NonEmpty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree (CSMT 'NonEmpty alg a -> b) -> CSMT 'NonEmpty alg a -> b
forall a b. (a -> b) -> a -> b
$ CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT j alg a
CSMT 'NonEmpty alg a
left' CSMT 'NonEmpty alg a
right
left' :: CSMT j alg a
left'@Parent {} -> CSMT 'NonEmpty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree (CSMT 'NonEmpty alg a -> b) -> CSMT 'NonEmpty alg a -> b
forall a b. (a -> b) -> a -> b
$ CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT j alg a
CSMT 'NonEmpty alg a
left' CSMT 'NonEmpty alg a
right
Ordering
GT -> Digest alg
-> CSMT 'NonEmpty alg a
-> (forall (j :: Size). CSMT j alg a -> b)
-> b
forall alg (i :: Size) a b.
HashAlgorithm alg =>
Digest alg
-> CSMT i alg a -> (forall (j :: Size). CSMT j alg a -> b) -> b
deleteDigest Digest alg
h CSMT 'NonEmpty alg a
right ((forall (j :: Size). CSMT j alg a -> b) -> b)
-> (forall (j :: Size). CSMT j alg a -> b) -> b
forall a b. (a -> b) -> a -> b
$ \case
Nil {} -> CSMT 'NonEmpty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree CSMT 'NonEmpty alg a
left
right' :: CSMT j alg a
right'@Leaf {} -> CSMT 'NonEmpty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree (CSMT 'NonEmpty alg a -> b) -> CSMT 'NonEmpty alg a -> b
forall a b. (a -> b) -> a -> b
$ CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT 'NonEmpty alg a
left CSMT j alg a
CSMT 'NonEmpty alg a
right'
right' :: CSMT j alg a
right'@Parent {} -> CSMT 'NonEmpty alg a -> b
forall (j :: Size). CSMT j alg a -> b
returnTree (CSMT 'NonEmpty alg a -> b) -> CSMT 'NonEmpty alg a -> b
forall a b. (a -> b) -> a -> b
$ CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall alg a.
HashAlgorithm alg =>
CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT 'NonEmpty alg a
left CSMT j alg a
CSMT 'NonEmpty alg a
right'
compareSubTrees :: Digest alg -> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees :: Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h = (CSMT 'NonEmpty alg a -> Int)
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Digest alg -> Digest alg -> Int
forall alg. Digest alg -> Digest alg -> Int
distance Digest alg
h (Digest alg -> Int)
-> (CSMT 'NonEmpty alg a -> Digest alg)
-> CSMT 'NonEmpty alg a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest)
distance :: Digest alg -> Digest alg -> Int
distance :: Digest alg -> Digest alg -> Int
distance Digest alg
a = ByteString -> Int
logBase2 (ByteString -> Int)
-> (Digest alg -> ByteString) -> Digest alg -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest alg -> Digest alg -> ByteString
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
BA.xor Digest alg
a
where
logBase2 :: ByteString -> Int
logBase2 ByteString
x =
Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ByteString -> Int
BS.length ByteString
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- case (Word8 -> Bool) -> [Word8] -> ([Word8], [Word8])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (ByteString -> [Word8]
BS.unpack ByteString
x) of
([Word8]
zeros, [Word8]
nonZeros) ->
Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
zeros Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case [Word8]
nonZeros of
[] -> Int
0
(Word8
w : [Word8]
_) -> Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word8
w
maximumDigest :: CSMT 'NonEmpty alg a -> Digest alg
maximumDigest :: CSMT 'NonEmpty alg a -> Digest alg
maximumDigest Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} = Digest alg
digest
maximumDigest Parent {Digest alg
maxDigest :: Digest alg
$sel:maxDigest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maxDigest} = Digest alg
maxDigest
minimumDigest :: CSMT 'NonEmpty alg a -> Digest alg
minimumDigest :: CSMT 'NonEmpty alg a -> Digest alg
minimumDigest = \case
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} -> Digest alg
digest
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left} -> CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
minimumDigest CSMT 'NonEmpty alg a
left
parent :: HashAlgorithm alg => CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent :: CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
parent CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right =
Parent :: forall alg a.
CSMT 'NonEmpty alg a
-> Digest alg
-> Digest alg
-> CSMT 'NonEmpty alg a
-> CSMT 'NonEmpty alg a
Parent
{ CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: CSMT 'NonEmpty alg a
left,
$sel:digest:Nil :: Digest alg
digest = Digest alg -> Digest alg -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> ba -> Digest a
hashParent (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest CSMT 'NonEmpty alg a
left) (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest CSMT 'NonEmpty alg a
right),
$sel:maxDigest:Nil :: Digest alg
maxDigest = Digest alg -> Digest alg -> Digest alg
forall a. Ord a => a -> a -> a
max (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
left) (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
right),
CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: CSMT 'NonEmpty alg a
right
}
hashLeaf :: (HashAlgorithm a, ByteArrayAccess ba) => ba -> Digest a
hashLeaf :: ba -> Digest a
hashLeaf = Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context a -> Digest a) -> (ba -> Context a) -> ba -> Digest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> ba -> Context a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (Context a -> ByteString -> Context a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context a
forall a. HashAlgorithm a => Context a
hashInit (Word8 -> ByteString
BS.singleton Word8
0))
hashParent :: (HashAlgorithm a, ByteArrayAccess ba) => ba -> ba -> Digest a
hashParent :: ba -> ba -> Digest a
hashParent ba
x ba
y = Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context a -> Digest a) -> Context a -> Digest a
forall a b. (a -> b) -> a -> b
$ Context a -> [ba] -> Context a
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates (Context a -> ByteString -> Context a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context a
forall a. HashAlgorithm a => Context a
hashInit (Word8 -> ByteString
BS.singleton Word8
1)) [ba
x, ba
y]
data MembershipProof alg = forall p. MembershipProof (Proof Direction p alg)
data Proof d (p :: ProofType) alg where
InclusionProof ::
{
Proof d 'Inclusion alg -> Digest alg
includedDigest :: Digest alg,
Proof d 'Inclusion alg -> [(Digest alg, d)]
rootPath :: [(Digest alg, d)]
} ->
Proof d 'Inclusion alg
ExclusionProof ::
{
Proof d 'Exclusion alg -> Digest alg
excludedDigest :: Digest alg,
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediatePredecessor :: Maybe (Proof () 'Inclusion alg),
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediateSuccessor :: Maybe (Proof () 'Inclusion alg),
Proof d 'Exclusion alg -> [(Digest alg, d)]
commonRootPath :: [(Digest alg, d)]
} ->
Proof d 'Exclusion alg
deriving instance Show d => Show (Proof d alg p)
data Direction
=
L
|
R
deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq)
deriving instance Show (MembershipProof alg)
data ProofType
=
Inclusion
|
Exclusion
member :: (ByteArrayAccess a, HashAlgorithm alg) => a -> CSMT i alg a -> Bool
member :: a -> CSMT i alg a -> Bool
member a
x = MembershipProof alg -> Bool
forall alg. MembershipProof alg -> Bool
isInclusionProof (MembershipProof alg -> Bool)
-> (CSMT i alg a -> MembershipProof alg) -> CSMT i alg a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CSMT i alg a -> MembershipProof alg
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
a -> CSMT i alg a -> MembershipProof alg
membershipProof a
x
notMember :: (ByteArrayAccess a, HashAlgorithm alg) => a -> CSMT i alg a -> Bool
notMember :: a -> CSMT i alg a -> Bool
notMember a
x = Bool -> Bool
not (Bool -> Bool) -> (CSMT i alg a -> Bool) -> CSMT i alg a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CSMT i alg a -> Bool
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
a -> CSMT i alg a -> Bool
member a
x
lookup :: Digest alg -> CSMT i alg a -> Maybe a
lookup :: Digest alg -> CSMT i alg a -> Maybe a
lookup Digest alg
h = \case
Nil {} -> Maybe a
forall a. Maybe a
Nothing
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest, a
value :: a
$sel:value:Nil :: forall alg a. CSMT 'NonEmpty alg a -> a
value}
| Digest alg
h Digest alg -> Digest alg -> Bool
forall a. Eq a => a -> a -> Bool
== Digest alg
digest -> a -> Maybe a
forall a. a -> Maybe a
Just a
value
| Bool
otherwise -> Maybe a
forall a. Maybe a
Nothing
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} ->
case Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall alg a.
Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right of
Ordering
EQ -> Maybe a
forall a. Maybe a
Nothing
Ordering
LT -> Digest alg -> CSMT 'NonEmpty alg a -> Maybe a
forall alg (i :: Size) a. Digest alg -> CSMT i alg a -> Maybe a
lookup Digest alg
h CSMT 'NonEmpty alg a
left
Ordering
GT -> Digest alg -> CSMT 'NonEmpty alg a -> Maybe a
forall alg (i :: Size) a. Digest alg -> CSMT i alg a -> Maybe a
lookup Digest alg
h CSMT 'NonEmpty alg a
right
isInclusionProof :: MembershipProof alg -> Bool
isInclusionProof :: MembershipProof alg -> Bool
isInclusionProof = \case
MembershipProof (InclusionProof {}) -> Bool
True
MembershipProof alg
_ -> Bool
False
isExclusionProof :: MembershipProof alg -> Bool
isExclusionProof :: MembershipProof alg -> Bool
isExclusionProof = Bool -> Bool
not (Bool -> Bool)
-> (MembershipProof alg -> Bool) -> MembershipProof alg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MembershipProof alg -> Bool
forall alg. MembershipProof alg -> Bool
isInclusionProof
membershipProof :: (ByteArrayAccess a, HashAlgorithm alg) => a -> CSMT i alg a -> MembershipProof alg
membershipProof :: a -> CSMT i alg a -> MembershipProof alg
membershipProof a
x = [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT i alg a -> MembershipProof alg
forall alg a (i :: Size).
[(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT i alg a -> MembershipProof alg
membershipProofDigest [] (a -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Digest a
hashLeaf a
x)
membershipProofDigest :: [(CSMT 'NonEmpty alg a, Direction)] -> Digest alg -> CSMT i alg a -> MembershipProof alg
membershipProofDigest :: [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT i alg a -> MembershipProof alg
membershipProofDigest [(CSMT 'NonEmpty alg a, Direction)]
path Digest alg
h = \case
Nil {} ->
Proof Direction 'Exclusion alg -> MembershipProof alg
forall alg (p :: ProofType).
Proof Direction p alg -> MembershipProof alg
MembershipProof (Proof Direction 'Exclusion alg -> MembershipProof alg)
-> Proof Direction 'Exclusion alg -> MembershipProof alg
forall a b. (a -> b) -> a -> b
$ Digest alg -> Proof Direction 'Exclusion alg
forall alg d. Digest alg -> Proof d 'Exclusion alg
trivialExclusionProof Digest alg
h
leaf :: CSMT i alg a
leaf@Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} -> case Digest alg
h Digest alg -> Digest alg -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Digest alg
digest of
Ordering
EQ ->
Proof Direction 'Inclusion alg -> MembershipProof alg
forall alg (p :: ProofType).
Proof Direction p alg -> MembershipProof alg
MembershipProof (Digest alg -> Proof Any 'Inclusion alg
forall alg d. Digest alg -> Proof d 'Inclusion alg
trivialInclusionProof Digest alg
digest) {$sel:rootPath:InclusionProof :: [(Digest alg, Direction)]
rootPath = [(CSMT 'NonEmpty alg a, Direction)] -> [(Digest alg, Direction)]
forall alg a d. [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
toRootPath [(CSMT 'NonEmpty alg a, Direction)]
path}
Ordering
__ -> [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
forall alg a.
[(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
nonMembershipProof [(CSMT 'NonEmpty alg a, Direction)]
path Digest alg
h CSMT i alg a
CSMT 'NonEmpty alg a
leaf
root :: CSMT i alg a
root@Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} ->
case Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall alg a.
Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right of
Ordering
EQ -> case Digest alg
h Digest alg -> Digest alg -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT i alg a
CSMT 'NonEmpty alg a
root of
Ordering
LT -> [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
forall alg a.
[(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
nonMembershipProof ((CSMT 'NonEmpty alg a
right, Direction
R) (CSMT 'NonEmpty alg a, Direction)
-> [(CSMT 'NonEmpty alg a, Direction)]
-> [(CSMT 'NonEmpty alg a, Direction)]
forall a. a -> [a] -> [a]
: [(CSMT 'NonEmpty alg a, Direction)]
path) Digest alg
h CSMT 'NonEmpty alg a
left
Ordering
__ -> [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
forall alg a.
[(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
nonMembershipProof ((CSMT 'NonEmpty alg a
left, Direction
L) (CSMT 'NonEmpty alg a, Direction)
-> [(CSMT 'NonEmpty alg a, Direction)]
-> [(CSMT 'NonEmpty alg a, Direction)]
forall a. a -> [a] -> [a]
: [(CSMT 'NonEmpty alg a, Direction)]
path) Digest alg
h CSMT 'NonEmpty alg a
right
Ordering
LT -> [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
forall alg a (i :: Size).
[(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT i alg a -> MembershipProof alg
membershipProofDigest ((CSMT 'NonEmpty alg a
right, Direction
R) (CSMT 'NonEmpty alg a, Direction)
-> [(CSMT 'NonEmpty alg a, Direction)]
-> [(CSMT 'NonEmpty alg a, Direction)]
forall a. a -> [a] -> [a]
: [(CSMT 'NonEmpty alg a, Direction)]
path) Digest alg
h CSMT 'NonEmpty alg a
left
Ordering
GT -> [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
forall alg a (i :: Size).
[(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT i alg a -> MembershipProof alg
membershipProofDigest ((CSMT 'NonEmpty alg a
left, Direction
L) (CSMT 'NonEmpty alg a, Direction)
-> [(CSMT 'NonEmpty alg a, Direction)]
-> [(CSMT 'NonEmpty alg a, Direction)]
forall a. a -> [a] -> [a]
: [(CSMT 'NonEmpty alg a, Direction)]
path) Digest alg
h CSMT 'NonEmpty alg a
right
nonMembershipProof :: [(CSMT 'NonEmpty alg a, Direction)] -> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
nonMembershipProof :: [(CSMT 'NonEmpty alg a, Direction)]
-> Digest alg -> CSMT 'NonEmpty alg a -> MembershipProof alg
nonMembershipProof [(CSMT 'NonEmpty alg a, Direction)]
path Digest alg
h CSMT 'NonEmpty alg a
t =
let exclusionProof :: Proof Direction 'Exclusion alg
exclusionProof = Digest alg -> Proof Direction 'Exclusion alg
forall alg d. Digest alg -> Proof d 'Exclusion alg
trivialExclusionProof Digest alg
h
in case Digest alg
h Digest alg -> Digest alg -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
t of
Ordering
LT ->
case Direction
-> [(CSMT 'NonEmpty alg a, Direction)]
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, Direction)])
forall d alg a.
Eq d =>
d
-> [(CSMT 'NonEmpty alg a, d)]
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)])
spanDirection Direction
R [(CSMT 'NonEmpty alg a, Direction)]
path of
([(Digest alg, ())]
successorPath, []) ->
Proof Direction 'Exclusion alg -> MembershipProof alg
forall alg (p :: ProofType).
Proof Direction p alg -> MembershipProof alg
MembershipProof (Proof Direction 'Exclusion alg -> MembershipProof alg)
-> Proof Direction 'Exclusion alg -> MembershipProof alg
forall a b. (a -> b) -> a -> b
$
Proof Direction 'Exclusion alg
exclusionProof
{ $sel:immediateSuccessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a. a -> Maybe a
Just (Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg))
-> Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a b. (a -> b) -> a -> b
$ [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof' [(Digest alg, ())]
successorPath CSMT 'NonEmpty alg a
t
}
([(Digest alg, ())]
successorPath, (CSMT 'NonEmpty alg a
sibling, Direction
_) : [(CSMT 'NonEmpty alg a, Direction)]
commonPath) ->
Proof Direction 'Exclusion alg -> MembershipProof alg
forall alg (p :: ProofType).
Proof Direction p alg -> MembershipProof alg
MembershipProof (Proof Direction 'Exclusion alg -> MembershipProof alg)
-> Proof Direction 'Exclusion alg -> MembershipProof alg
forall a b. (a -> b) -> a -> b
$
Proof Direction 'Exclusion alg
exclusionProof
{ $sel:immediateSuccessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a. a -> Maybe a
Just (Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg))
-> Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a b. (a -> b) -> a -> b
$ [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof' [(Digest alg, ())]
successorPath CSMT 'NonEmpty alg a
t,
$sel:immediatePredecessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a. a -> Maybe a
Just (Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg))
-> Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a b. (a -> b) -> a -> b
$ CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a. CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof CSMT 'NonEmpty alg a
sibling,
$sel:commonRootPath:InclusionProof :: [(Digest alg, Direction)]
commonRootPath = [(CSMT 'NonEmpty alg a, Direction)] -> [(Digest alg, Direction)]
forall alg a d. [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
toRootPath [(CSMT 'NonEmpty alg a, Direction)]
commonPath
}
Ordering
__ ->
case Direction
-> [(CSMT 'NonEmpty alg a, Direction)]
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, Direction)])
forall d alg a.
Eq d =>
d
-> [(CSMT 'NonEmpty alg a, d)]
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)])
spanDirection Direction
L [(CSMT 'NonEmpty alg a, Direction)]
path of
([(Digest alg, ())]
predecessorPath, []) ->
Proof Direction 'Exclusion alg -> MembershipProof alg
forall alg (p :: ProofType).
Proof Direction p alg -> MembershipProof alg
MembershipProof (Proof Direction 'Exclusion alg -> MembershipProof alg)
-> Proof Direction 'Exclusion alg -> MembershipProof alg
forall a b. (a -> b) -> a -> b
$
Proof Direction 'Exclusion alg
exclusionProof
{ $sel:immediatePredecessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a. a -> Maybe a
Just (Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg))
-> Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a b. (a -> b) -> a -> b
$ [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof' [(Digest alg, ())]
predecessorPath CSMT 'NonEmpty alg a
t
}
([(Digest alg, ())]
predecessorPath, (CSMT 'NonEmpty alg a
sibling, Direction
_) : [(CSMT 'NonEmpty alg a, Direction)]
commonPath) ->
Proof Direction 'Exclusion alg -> MembershipProof alg
forall alg (p :: ProofType).
Proof Direction p alg -> MembershipProof alg
MembershipProof (Proof Direction 'Exclusion alg -> MembershipProof alg)
-> Proof Direction 'Exclusion alg -> MembershipProof alg
forall a b. (a -> b) -> a -> b
$
Proof Direction 'Exclusion alg
exclusionProof
{ $sel:immediatePredecessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a. a -> Maybe a
Just (Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg))
-> Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a b. (a -> b) -> a -> b
$ [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof' [(Digest alg, ())]
predecessorPath CSMT 'NonEmpty alg a
t,
$sel:immediateSuccessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a. a -> Maybe a
Just (Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg))
-> Proof () 'Inclusion alg -> Maybe (Proof () 'Inclusion alg)
forall a b. (a -> b) -> a -> b
$ CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a. CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof CSMT 'NonEmpty alg a
sibling,
$sel:commonRootPath:InclusionProof :: [(Digest alg, Direction)]
commonRootPath = [(CSMT 'NonEmpty alg a, Direction)] -> [(Digest alg, Direction)]
forall alg a d. [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
toRootPath [(CSMT 'NonEmpty alg a, Direction)]
commonPath
}
spanDirection :: Eq d => d -> [(CSMT 'NonEmpty alg a, d)] -> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)])
spanDirection :: d
-> [(CSMT 'NonEmpty alg a, d)]
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)])
spanDirection d
d = ([(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, ())])
-> ([(CSMT 'NonEmpty alg a, d)], [(CSMT 'NonEmpty alg a, d)])
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, ())]
forall alg a d. [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, ())]
toUniRootPath (([(CSMT 'NonEmpty alg a, d)], [(CSMT 'NonEmpty alg a, d)])
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)]))
-> ([(CSMT 'NonEmpty alg a, d)]
-> ([(CSMT 'NonEmpty alg a, d)], [(CSMT 'NonEmpty alg a, d)]))
-> [(CSMT 'NonEmpty alg a, d)]
-> ([(Digest alg, ())], [(CSMT 'NonEmpty alg a, d)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CSMT 'NonEmpty alg a, d) -> Bool)
-> [(CSMT 'NonEmpty alg a, d)]
-> ([(CSMT 'NonEmpty alg a, d)], [(CSMT 'NonEmpty alg a, d)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((d
d d -> d -> Bool
forall a. Eq a => a -> a -> Bool
==) (d -> Bool)
-> ((CSMT 'NonEmpty alg a, d) -> d)
-> (CSMT 'NonEmpty alg a, d)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CSMT 'NonEmpty alg a, d) -> d
forall a b. (a, b) -> b
snd)
toUniRootPath :: [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, ())]
toUniRootPath :: [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, ())]
toUniRootPath = ((Digest alg, d) -> (Digest alg, ()))
-> [(Digest alg, d)] -> [(Digest alg, ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Digest alg, d) -> (Digest alg, ())
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([(Digest alg, d)] -> [(Digest alg, ())])
-> ([(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)])
-> [(CSMT 'NonEmpty alg a, d)]
-> [(Digest alg, ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
forall alg a d. [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
toRootPath
toRootPath :: [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
toRootPath :: [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
toRootPath = ((CSMT 'NonEmpty alg a, d) -> (Digest alg, d))
-> [(CSMT 'NonEmpty alg a, d)] -> [(Digest alg, d)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CSMT 'NonEmpty alg a -> Digest alg)
-> (CSMT 'NonEmpty alg a, d) -> (Digest alg, d)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest)
trivialInclusionProof :: Digest alg -> Proof d 'Inclusion alg
trivialInclusionProof :: Digest alg -> Proof d 'Inclusion alg
trivialInclusionProof Digest alg
h =
InclusionProof :: forall alg d.
Digest alg -> [(Digest alg, d)] -> Proof d 'Inclusion alg
InclusionProof
{ $sel:includedDigest:InclusionProof :: Digest alg
includedDigest = Digest alg
h,
$sel:rootPath:InclusionProof :: [(Digest alg, d)]
rootPath = [(Digest alg, d)]
forall a. Monoid a => a
mempty
}
trivialExclusionProof :: Digest alg -> Proof d 'Exclusion alg
trivialExclusionProof :: Digest alg -> Proof d 'Exclusion alg
trivialExclusionProof Digest alg
h =
ExclusionProof :: forall alg d.
Digest alg
-> Maybe (Proof () 'Inclusion alg)
-> Maybe (Proof () 'Inclusion alg)
-> [(Digest alg, d)]
-> Proof d 'Exclusion alg
ExclusionProof
{ $sel:excludedDigest:InclusionProof :: Digest alg
excludedDigest = Digest alg
h,
$sel:commonRootPath:InclusionProof :: [(Digest alg, d)]
commonRootPath = [],
$sel:immediatePredecessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Maybe (Proof () 'Inclusion alg)
forall a. Maybe a
Nothing,
$sel:immediateSuccessor:InclusionProof :: Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Maybe (Proof () 'Inclusion alg)
forall a. Maybe a
Nothing
}
maximumDigestInclusionProof :: CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof :: CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof = [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof' []
maximumDigestInclusionProof' :: [(Digest alg, ())] -> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof' :: [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof' [(Digest alg, ())]
path = \case
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} -> (Digest alg -> Proof Any 'Inclusion alg
forall alg d. Digest alg -> Proof d 'Inclusion alg
trivialInclusionProof Digest alg
digest) {$sel:rootPath:InclusionProof :: [(Digest alg, ())]
rootPath = [(Digest alg, ())]
path}
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} -> [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
maximumDigestInclusionProof' ((CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest CSMT 'NonEmpty alg a
left, ()) (Digest alg, ()) -> [(Digest alg, ())] -> [(Digest alg, ())]
forall a. a -> [a] -> [a]
: [(Digest alg, ())]
path) CSMT 'NonEmpty alg a
right
minimumDigestInclusionProof :: CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof :: CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof = [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof' []
minimumDigestInclusionProof' :: [(Digest alg, ())] -> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof' :: [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof' [(Digest alg, ())]
path = \case
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} -> (Digest alg -> Proof Any 'Inclusion alg
forall alg d. Digest alg -> Proof d 'Inclusion alg
trivialInclusionProof Digest alg
digest) {$sel:rootPath:InclusionProof :: [(Digest alg, ())]
rootPath = [(Digest alg, ())]
path}
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} -> [(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
forall alg a.
[(Digest alg, ())]
-> CSMT 'NonEmpty alg a -> Proof () 'Inclusion alg
minimumDigestInclusionProof' ((CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest CSMT 'NonEmpty alg a
right, ()) (Digest alg, ()) -> [(Digest alg, ())] -> [(Digest alg, ())]
forall a. a -> [a] -> [a]
: [(Digest alg, ())]
path) CSMT 'NonEmpty alg a
left
data MerkleRoot alg
=
EmptyMerkleRoot
|
MerkleRoot (Digest alg)
deriving (Int -> MerkleRoot alg -> ShowS
[MerkleRoot alg] -> ShowS
MerkleRoot alg -> String
(Int -> MerkleRoot alg -> ShowS)
-> (MerkleRoot alg -> String)
-> ([MerkleRoot alg] -> ShowS)
-> Show (MerkleRoot alg)
forall alg. Int -> MerkleRoot alg -> ShowS
forall alg. [MerkleRoot alg] -> ShowS
forall alg. MerkleRoot alg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MerkleRoot alg] -> ShowS
$cshowList :: forall alg. [MerkleRoot alg] -> ShowS
show :: MerkleRoot alg -> String
$cshow :: forall alg. MerkleRoot alg -> String
showsPrec :: Int -> MerkleRoot alg -> ShowS
$cshowsPrec :: forall alg. Int -> MerkleRoot alg -> ShowS
Show, MerkleRoot alg -> MerkleRoot alg -> Bool
(MerkleRoot alg -> MerkleRoot alg -> Bool)
-> (MerkleRoot alg -> MerkleRoot alg -> Bool)
-> Eq (MerkleRoot alg)
forall alg. MerkleRoot alg -> MerkleRoot alg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MerkleRoot alg -> MerkleRoot alg -> Bool
$c/= :: forall alg. MerkleRoot alg -> MerkleRoot alg -> Bool
== :: MerkleRoot alg -> MerkleRoot alg -> Bool
$c== :: forall alg. MerkleRoot alg -> MerkleRoot alg -> Bool
Eq)
merkleRoot :: CSMT i alg a -> MerkleRoot alg
merkleRoot :: CSMT i alg a -> MerkleRoot alg
merkleRoot = \case
Nil {} -> MerkleRoot alg
forall alg. MerkleRoot alg
EmptyMerkleRoot
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} -> Digest alg -> MerkleRoot alg
forall alg. Digest alg -> MerkleRoot alg
MerkleRoot Digest alg
digest
Parent {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest} -> Digest alg -> MerkleRoot alg
forall alg. Digest alg -> MerkleRoot alg
MerkleRoot Digest alg
digest
validProof :: HashAlgorithm alg => MerkleRoot alg -> MembershipProof alg -> Bool
validProof :: MerkleRoot alg -> MembershipProof alg -> Bool
validProof MerkleRoot alg
root = \case
MembershipProof proof :: Proof Direction p alg
proof@InclusionProof {} -> MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
forall alg.
HashAlgorithm alg =>
MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
validInclusionProof MerkleRoot alg
root Proof Direction p alg
Proof Direction 'Inclusion alg
proof
MembershipProof proof :: Proof Direction p alg
proof@ExclusionProof {} -> MerkleRoot alg -> Proof Direction 'Exclusion alg -> Bool
forall alg.
HashAlgorithm alg =>
MerkleRoot alg -> Proof Direction 'Exclusion alg -> Bool
validExclusionProof MerkleRoot alg
root Proof Direction p alg
Proof Direction 'Exclusion alg
proof
validInclusionProof :: HashAlgorithm alg => MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
validInclusionProof :: MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
validInclusionProof MerkleRoot alg
EmptyMerkleRoot Proof Direction 'Inclusion alg
_ = Bool
False
validInclusionProof (MerkleRoot Digest alg
root) Proof Direction 'Inclusion alg
proof = Digest alg
root Digest alg -> Digest alg -> Bool
forall a. Eq a => a -> a -> Bool
== Proof Direction 'Inclusion alg -> Digest alg
forall alg.
HashAlgorithm alg =>
Proof Direction 'Inclusion alg -> Digest alg
inclusionProofMerkleRoot Proof Direction 'Inclusion alg
proof
inclusionProofMerkleRoot :: HashAlgorithm alg => Proof Direction 'Inclusion alg -> Digest alg
inclusionProofMerkleRoot :: Proof Direction 'Inclusion alg -> Digest alg
inclusionProofMerkleRoot InclusionProof {Digest alg
includedDigest :: Digest alg
$sel:includedDigest:InclusionProof :: forall d alg. Proof d 'Inclusion alg -> Digest alg
includedDigest, [(Digest alg, Direction)]
rootPath :: [(Digest alg, Direction)]
$sel:rootPath:InclusionProof :: forall d alg. Proof d 'Inclusion alg -> [(Digest alg, d)]
rootPath} =
(Digest alg -> (Digest alg, Direction) -> Digest alg)
-> Digest alg -> [(Digest alg, Direction)] -> Digest alg
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
( \Digest alg
result (Digest alg
siblingDigest, Direction
direction) -> (Digest alg -> Digest alg -> Digest alg)
-> (Digest alg, Digest alg) -> Digest alg
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Digest alg -> Digest alg -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> ba -> Digest a
hashParent ((Digest alg, Digest alg) -> Digest alg)
-> (Digest alg, Digest alg) -> Digest alg
forall a b. (a -> b) -> a -> b
$
case Direction
direction of
Direction
L -> (Digest alg
siblingDigest, Digest alg
result)
Direction
R -> (Digest alg
result, Digest alg
siblingDigest)
)
Digest alg
includedDigest
[(Digest alg, Direction)]
rootPath
validExclusionProof :: HashAlgorithm alg => MerkleRoot alg -> Proof Direction 'Exclusion alg -> Bool
validExclusionProof :: MerkleRoot alg -> Proof Direction 'Exclusion alg -> Bool
validExclusionProof MerkleRoot alg
root = \case
ExclusionProof {$sel:immediatePredecessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Maybe (Proof () 'Inclusion alg)
Nothing, $sel:immediateSuccessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Maybe (Proof () 'Inclusion alg)
Nothing} ->
MerkleRoot alg
root MerkleRoot alg -> MerkleRoot alg -> Bool
forall a. Eq a => a -> a -> Bool
== MerkleRoot alg
forall alg. MerkleRoot alg
EmptyMerkleRoot
ExclusionProof {$sel:immediatePredecessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Just Proof () 'Inclusion alg
p, Digest alg
excludedDigest :: Digest alg
$sel:excludedDigest:InclusionProof :: forall d alg. Proof d 'Exclusion alg -> Digest alg
excludedDigest, $sel:immediateSuccessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Maybe (Proof () 'Inclusion alg)
Nothing}
| Proof () 'Inclusion alg -> Digest alg
forall d alg. Proof d 'Inclusion alg -> Digest alg
includedDigest Proof () 'Inclusion alg
p Digest alg -> Digest alg -> Bool
forall a. Ord a => a -> a -> Bool
< Digest alg
excludedDigest ->
MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
forall alg.
HashAlgorithm alg =>
MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
validInclusionProof MerkleRoot alg
root (Proof Direction 'Inclusion alg -> Bool)
-> Proof Direction 'Inclusion alg -> Bool
forall a b. (a -> b) -> a -> b
$ (() -> Direction)
-> Proof () 'Inclusion alg -> Proof Direction 'Inclusion alg
forall d d' alg.
(d -> d') -> Proof d 'Inclusion alg -> Proof d' 'Inclusion alg
mapProofDirection (Direction -> () -> Direction
forall a b. a -> b -> a
const Direction
L) Proof () 'Inclusion alg
p
ExclusionProof {$sel:immediatePredecessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Maybe (Proof () 'Inclusion alg)
Nothing, Digest alg
excludedDigest :: Digest alg
$sel:excludedDigest:InclusionProof :: forall d alg. Proof d 'Exclusion alg -> Digest alg
excludedDigest, $sel:immediateSuccessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Just Proof () 'Inclusion alg
q}
| Digest alg
excludedDigest Digest alg -> Digest alg -> Bool
forall a. Ord a => a -> a -> Bool
< Proof () 'Inclusion alg -> Digest alg
forall d alg. Proof d 'Inclusion alg -> Digest alg
includedDigest Proof () 'Inclusion alg
q ->
MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
forall alg.
HashAlgorithm alg =>
MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
validInclusionProof MerkleRoot alg
root (Proof Direction 'Inclusion alg -> Bool)
-> Proof Direction 'Inclusion alg -> Bool
forall a b. (a -> b) -> a -> b
$ (() -> Direction)
-> Proof () 'Inclusion alg -> Proof Direction 'Inclusion alg
forall d d' alg.
(d -> d') -> Proof d 'Inclusion alg -> Proof d' 'Inclusion alg
mapProofDirection (Direction -> () -> Direction
forall a b. a -> b -> a
const Direction
R) Proof () 'Inclusion alg
q
ExclusionProof {$sel:immediatePredecessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediatePredecessor = Just Proof () 'Inclusion alg
p, [(Digest alg, Direction)]
commonRootPath :: [(Digest alg, Direction)]
$sel:commonRootPath:InclusionProof :: forall d alg. Proof d 'Exclusion alg -> [(Digest alg, d)]
commonRootPath, Digest alg
excludedDigest :: Digest alg
$sel:excludedDigest:InclusionProof :: forall d alg. Proof d 'Exclusion alg -> Digest alg
excludedDigest, $sel:immediateSuccessor:InclusionProof :: forall d alg.
Proof d 'Exclusion alg -> Maybe (Proof () 'Inclusion alg)
immediateSuccessor = Just Proof () 'Inclusion alg
q}
| Proof () 'Inclusion alg -> Digest alg
forall d alg. Proof d 'Inclusion alg -> Digest alg
includedDigest Proof () 'Inclusion alg
p Digest alg -> Digest alg -> Bool
forall a. Ord a => a -> a -> Bool
< Digest alg
excludedDigest,
Digest alg
excludedDigest Digest alg -> Digest alg -> Bool
forall a. Ord a => a -> a -> Bool
< Proof () 'Inclusion alg -> Digest alg
forall d alg. Proof d 'Inclusion alg -> Digest alg
includedDigest Proof () 'Inclusion alg
q ->
let leftMerkleRoot :: Digest alg
leftMerkleRoot = Proof Direction 'Inclusion alg -> Digest alg
forall alg.
HashAlgorithm alg =>
Proof Direction 'Inclusion alg -> Digest alg
inclusionProofMerkleRoot (Proof Direction 'Inclusion alg -> Digest alg)
-> Proof Direction 'Inclusion alg -> Digest alg
forall a b. (a -> b) -> a -> b
$ (() -> Direction)
-> Proof () 'Inclusion alg -> Proof Direction 'Inclusion alg
forall d d' alg.
(d -> d') -> Proof d 'Inclusion alg -> Proof d' 'Inclusion alg
mapProofDirection (Direction -> () -> Direction
forall a b. a -> b -> a
const Direction
L) Proof () 'Inclusion alg
p
rightMerkleRoot :: Digest alg
rightMerkleRoot = Proof Direction 'Inclusion alg -> Digest alg
forall alg.
HashAlgorithm alg =>
Proof Direction 'Inclusion alg -> Digest alg
inclusionProofMerkleRoot (Proof Direction 'Inclusion alg -> Digest alg)
-> Proof Direction 'Inclusion alg -> Digest alg
forall a b. (a -> b) -> a -> b
$ (() -> Direction)
-> Proof () 'Inclusion alg -> Proof Direction 'Inclusion alg
forall d d' alg.
(d -> d') -> Proof d 'Inclusion alg -> Proof d' 'Inclusion alg
mapProofDirection (Direction -> () -> Direction
forall a b. a -> b -> a
const Direction
R) Proof () 'Inclusion alg
q
includedDigest :: Digest alg
includedDigest = Digest alg -> Digest alg -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> ba -> Digest a
hashParent Digest alg
leftMerkleRoot Digest alg
rightMerkleRoot
in MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
forall alg.
HashAlgorithm alg =>
MerkleRoot alg -> Proof Direction 'Inclusion alg -> Bool
validInclusionProof MerkleRoot alg
root (Proof Direction 'Inclusion alg -> Bool)
-> Proof Direction 'Inclusion alg -> Bool
forall a b. (a -> b) -> a -> b
$
InclusionProof :: forall alg d.
Digest alg -> [(Digest alg, d)] -> Proof d 'Inclusion alg
InclusionProof
{ Digest alg
includedDigest :: Digest alg
$sel:includedDigest:InclusionProof :: Digest alg
includedDigest,
$sel:rootPath:InclusionProof :: [(Digest alg, Direction)]
rootPath = [(Digest alg, Direction)]
commonRootPath
}
Proof Direction 'Exclusion alg
_ -> Bool
False
mapProofDirection :: (d -> d') -> Proof d 'Inclusion alg -> Proof d' 'Inclusion alg
mapProofDirection :: (d -> d') -> Proof d 'Inclusion alg -> Proof d' 'Inclusion alg
mapProofDirection d -> d'
f proof :: Proof d 'Inclusion alg
proof@InclusionProof {[(Digest alg, d)]
rootPath :: [(Digest alg, d)]
$sel:rootPath:InclusionProof :: forall d alg. Proof d 'Inclusion alg -> [(Digest alg, d)]
rootPath} = Proof d 'Inclusion alg
proof {$sel:rootPath:InclusionProof :: [(Digest alg, d')]
rootPath = ((Digest alg, d) -> (Digest alg, d'))
-> [(Digest alg, d)] -> [(Digest alg, d')]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((d -> d') -> (Digest alg, d) -> (Digest alg, d')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap d -> d'
f) [(Digest alg, d)]
rootPath}
valid :: (ByteArrayAccess a, HashAlgorithm alg) => CSMT i alg a -> Bool
valid :: CSMT i alg a -> Bool
valid = (Digest alg -> Bool) -> CSMT i alg a -> Bool
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
(Digest alg -> Bool) -> CSMT i alg a -> Bool
valid' (Bool -> Digest alg -> Bool
forall a b. a -> b -> a
const Bool
True)
where
valid' :: (ByteArrayAccess a, HashAlgorithm alg) => (Digest alg -> Bool) -> CSMT i alg a -> Bool
valid' :: (Digest alg -> Bool) -> CSMT i alg a -> Bool
valid' Digest alg -> Bool
validPath = \case
Nil {} -> Bool
True
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest, a
value :: a
$sel:value:Nil :: forall alg a. CSMT 'NonEmpty alg a -> a
value} -> a -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Digest a
hashLeaf a
value Digest alg -> Digest alg -> Bool
forall a. Eq a => a -> a -> Bool
== Digest alg
digest Bool -> Bool -> Bool
&& Digest alg -> Bool
validPath Digest alg
digest
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, $sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest = Digest alg
parentDigest, Digest alg
maxDigest :: Digest alg
$sel:maxDigest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maxDigest, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} ->
CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
left Digest alg -> Digest alg -> Bool
forall a. Ord a => a -> a -> Bool
<= Digest alg
maxDigest
Bool -> Bool -> Bool
&& CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maximumDigest CSMT 'NonEmpty alg a
right Digest alg -> Digest alg -> Bool
forall a. Ord a => a -> a -> Bool
<= Digest alg
maxDigest
Bool -> Bool -> Bool
&& Digest alg
parentDigest Digest alg -> Digest alg -> Bool
forall a. Eq a => a -> a -> Bool
== Digest alg -> Digest alg -> Digest alg
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> ba -> Digest a
hashParent (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest CSMT 'NonEmpty alg a
left) (CSMT 'NonEmpty alg a -> Digest alg
forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest CSMT 'NonEmpty alg a
right)
Bool -> Bool -> Bool
&& (Digest alg -> Bool) -> CSMT 'NonEmpty alg a -> Bool
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
(Digest alg -> Bool) -> CSMT i alg a -> Bool
valid' (\Digest alg
h -> Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall alg a.
Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
&& Digest alg -> Bool
validPath Digest alg
h) CSMT 'NonEmpty alg a
left
Bool -> Bool -> Bool
&& (Digest alg -> Bool) -> CSMT 'NonEmpty alg a -> Bool
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
(Digest alg -> Bool) -> CSMT i alg a -> Bool
valid' (\Digest alg
h -> Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
forall alg a.
Digest alg
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a -> Ordering
compareSubTrees Digest alg
h CSMT 'NonEmpty alg a
left CSMT 'NonEmpty alg a
right Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& Digest alg -> Bool
validPath Digest alg
h) CSMT 'NonEmpty alg a
right
fromList :: (ByteArrayAccess a, HashAlgorithm alg) => NonEmpty a -> CSMT 'NonEmpty alg a
fromList :: NonEmpty a -> CSMT 'NonEmpty alg a
fromList = \case
(a
x :| []) -> a -> CSMT 'NonEmpty alg a
forall a alg.
(ByteArrayAccess a, HashAlgorithm alg) =>
a -> CSMT 'NonEmpty alg a
singleton a
x
(a
x :| a
y : [a]
ys) -> a -> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall a alg (i :: Size).
(ByteArrayAccess a, HashAlgorithm alg) =>
a -> CSMT i alg a -> CSMT 'NonEmpty alg a
insert a
x (CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a)
-> CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> CSMT 'NonEmpty alg a
forall a alg.
(ByteArrayAccess a, HashAlgorithm alg) =>
NonEmpty a -> CSMT 'NonEmpty alg a
fromList (a
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
ys)
depth :: (Num n, Ord n) => CSMT i alg a -> n
depth :: CSMT i alg a -> n
depth = \case
CSMT i alg a
Nil -> n
0
Leaf {} -> n
1
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} -> n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ n -> n -> n
forall a. Ord a => a -> a -> a
max (CSMT 'NonEmpty alg a -> n
forall n (i :: Size) alg a. (Num n, Ord n) => CSMT i alg a -> n
depth CSMT 'NonEmpty alg a
left) (CSMT 'NonEmpty alg a -> n
forall n (i :: Size) alg a. (Num n, Ord n) => CSMT i alg a -> n
depth CSMT 'NonEmpty alg a
right)
toTree :: CSMT i alg a -> Maybe (Tree (DataNode alg a))
toTree :: CSMT i alg a -> Maybe (Tree (DataNode alg a))
toTree = \case
CSMT i alg a
Nil -> Maybe (Tree (DataNode alg a))
forall a. Maybe a
Nothing
Leaf {Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest, a
value :: a
$sel:value:Nil :: forall alg a. CSMT 'NonEmpty alg a -> a
value} ->
Tree (DataNode alg a) -> Maybe (Tree (DataNode alg a))
forall a. a -> Maybe a
Just (Tree (DataNode alg a) -> Maybe (Tree (DataNode alg a)))
-> Tree (DataNode alg a) -> Maybe (Tree (DataNode alg a))
forall a b. (a -> b) -> a -> b
$
DataNode alg a -> Forest (DataNode alg a) -> Tree (DataNode alg a)
forall a. a -> Forest a -> Tree a
Tree.Node
( ExternalNode :: forall alg a. Digest alg -> a -> DataNode alg a
DN.ExternalNode
{ Digest alg
digest :: Digest alg
digest :: Digest alg
digest,
a
value :: a
value :: a
value
}
)
[]
Parent {CSMT 'NonEmpty alg a
left :: CSMT 'NonEmpty alg a
$sel:left:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
left, Digest alg
digest :: Digest alg
$sel:digest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
digest, Digest alg
maxDigest :: Digest alg
$sel:maxDigest:Nil :: forall alg a. CSMT 'NonEmpty alg a -> Digest alg
maxDigest, CSMT 'NonEmpty alg a
right :: CSMT 'NonEmpty alg a
$sel:right:Nil :: forall alg a. CSMT 'NonEmpty alg a -> CSMT 'NonEmpty alg a
right} ->
Tree (DataNode alg a) -> Maybe (Tree (DataNode alg a))
forall a. a -> Maybe a
Just (Tree (DataNode alg a) -> Maybe (Tree (DataNode alg a)))
-> Tree (DataNode alg a) -> Maybe (Tree (DataNode alg a))
forall a b. (a -> b) -> a -> b
$
DataNode alg a -> Forest (DataNode alg a) -> Tree (DataNode alg a)
forall a. a -> Forest a -> Tree a
Tree.Node
( InternalNode :: forall alg a. Digest alg -> Digest alg -> DataNode alg a
DN.InternalNode
{ Digest alg
digest :: Digest alg
digest :: Digest alg
digest,
Digest alg
maxDigest :: Digest alg
maxDigest :: Digest alg
maxDigest
}
)
(Forest (DataNode alg a) -> Tree (DataNode alg a))
-> Forest (DataNode alg a) -> Tree (DataNode alg a)
forall a b. (a -> b) -> a -> b
$ (CSMT 'NonEmpty alg a -> Maybe (Tree (DataNode alg a)))
-> [CSMT 'NonEmpty alg a] -> Forest (DataNode alg a)
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CSMT 'NonEmpty alg a -> Maybe (Tree (DataNode alg a))
forall (i :: Size) alg a.
CSMT i alg a -> Maybe (Tree (DataNode alg a))
toTree [CSMT 'NonEmpty alg a
left, CSMT 'NonEmpty alg a
right]
drawTree :: Show a => CSMT i alg a -> String
drawTree :: CSMT i alg a -> String
drawTree = String
-> (Tree (DataNode alg a) -> String)
-> Maybe (Tree (DataNode alg a))
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Tree String -> String
Tree.drawTree (Tree String -> String)
-> (Tree (DataNode alg a) -> Tree String)
-> Tree (DataNode alg a)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataNode alg a -> String) -> Tree (DataNode alg a) -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataNode alg a -> String
forall a. Show a => a -> String
show) (Maybe (Tree (DataNode alg a)) -> String)
-> (CSMT i alg a -> Maybe (Tree (DataNode alg a)))
-> CSMT i alg a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSMT i alg a -> Maybe (Tree (DataNode alg a))
forall (i :: Size) alg a.
CSMT i alg a -> Maybe (Tree (DataNode alg a))
toTree