{- |
Module      : Singular.Registry.Trie.Pure
Description : Pure MPF computations and a mutable compatibility adapter
License     : Apache-2.0

Snapshots compute with 'rootFromDb', 'stateTrie', 'membershipFromDb' and
'exclusionFromDb', without IO allocation. The legacy 'mkPureTrie' and
'mkPureTrieFromRef' names refer to the in-memory backend: their 'Trie IO'
handles are mutable compatibility adapters, not pure computations.

The caller owns each adapter for one serial builder, replay or mirror
lifetime. A shared 'IORef' requires external serialization of the whole
session, including reads and writes; these adapters provide no locking or
thread-safety guarantee. Speculation belongs to the manager, not this handle.

All keys and values are hashed through MPF
conventions ('mkMPFHash') so proof paths match
what the Aiken on-chain validator expects.
-}
module Singular.Registry.Trie.Pure
    ( -- * Construction
      mkPureTrie
    , mkPureTrieFromRef

      -- * Pure snapshot computations
    , getRootFromDb
    , rootFromDb
    , stateTrie
    , membershipFromDb
    , exclusionFromDb
    , verifyExclusion

      -- * Proofs against a trusted root
    , provesMember
    , provesAbsent
    ) where

import Control.Monad.State.Strict (State, get, gets, put)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.IORef
    ( IORef
    , modifyIORef'
    , newIORef
    , readIORef
    )

import MPF.Backend.Pure
    ( MPFInMemoryDB
    , MPFPure
    , emptyMPFInMemoryDB
    , runMPFPure
    , runMPFPureTransaction
    )
import MPF.Backend.Standalone
    ( MPFStandalone (..)
    , MPFStandaloneCodecs (..)
    )
import MPF.Deletion (deleting)
import MPF.Hashes
    ( MPFHash
    , isoMPFHash
    , mkMPFHash
    , mpfHashing
    , nullHash
    , parseMPFHash
    , renderMPFHash
    , root
    )
import MPF.Insertion (inserting)
import MPF.Interface
    ( FromHexKV (..)
    , HexKey
    , byteStringToHexKey
    , hexKeyPrism
    )
import MPF.Proof.Exclusion
    ( MPFExclusionProof
    , mkMPFExclusionProof
    , verifyMPFExclusionProof
    )
import MPF.Proof.Insertion
    ( MPFProof
    , mkMPFInclusionProof
    )
import MPF.Verify (verifyAikenInclusionProof)

import Singular.Registry.Ledger (Root (..))
import Singular.Registry.Proof (serializeProof, toProofSteps)
import Singular.Registry.Trie (Trie (..))
import Singular.Registry.Types (ProofStep)

mpfHashCodecs :: MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs :: MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs =
    MPFStandaloneCodecs
        { mpfKeyCodec :: Prism' ByteString HexKey
mpfKeyCodec = p HexKey (f HexKey) -> p ByteString (f ByteString)
Prism' ByteString HexKey
hexKeyPrism
        , mpfValueCodec :: Prism' ByteString MPFHash
mpfValueCodec = p MPFHash (f MPFHash) -> p ByteString (f ByteString)
Iso' ByteString MPFHash
Prism' ByteString MPFHash
isoMPFHash
        , mpfNodeCodec :: Prism' ByteString MPFHash
mpfNodeCodec = p MPFHash (f MPFHash) -> p ByteString (f ByteString)
Iso' ByteString MPFHash
Prism' ByteString MPFHash
isoMPFHash
        }

fromHexKVIdentity :: FromHexKV HexKey MPFHash MPFHash
fromHexKVIdentity :: FromHexKV HexKey MPFHash MPFHash
fromHexKVIdentity =
    FromHexKV
        { fromHexK :: HexKey -> HexKey
fromHexK = HexKey -> HexKey
forall a. a -> a
id
        , fromHexV :: MPFHash -> MPFHash
fromHexV = MPFHash -> MPFHash
forall a. a -> a
id
        , hexTreePrefix :: MPFHash -> HexKey
hexTreePrefix = HexKey -> MPFHash -> HexKey
forall a b. a -> b -> a
const []
        }

hashKeyPath :: ByteString -> HexKey
hashKeyPath :: ByteString -> HexKey
hashKeyPath =
    ByteString -> HexKey
byteStringToHexKey (ByteString -> HexKey)
-> (ByteString -> ByteString) -> ByteString -> HexKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPFHash -> ByteString
renderMPFHash (MPFHash -> ByteString)
-> (ByteString -> MPFHash) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> MPFHash
mkMPFHash

insertByteStringM :: ByteString -> ByteString -> MPFPure ()
insertByteStringM :: ByteString -> ByteString -> MPFPure ()
insertByteStringM ByteString
k ByteString
v =
    MPFStandaloneCodecs HexKey MPFHash MPFHash
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     ()
-> MPFPure ()
forall k v a b.
MPFStandaloneCodecs k v a
-> Transaction
     MPFPure MPFStandaloneCF (MPFStandalone k v a) MPFStandaloneOp b
-> MPFPure b
runMPFPureTransaction MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs (Transaction
   MPFPure
   MPFStandaloneCF
   (MPFStandalone HexKey MPFHash MPFHash)
   MPFStandaloneOp
   ()
 -> MPFPure ())
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     ()
-> MPFPure ()
forall a b. (a -> b) -> a -> b
$
        HexKey
-> FromHexKV HexKey MPFHash MPFHash
-> MPFHashing MPFHash
-> Selector (MPFStandalone HexKey MPFHash MPFHash) HexKey MPFHash
-> Selector
     (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
-> HexKey
-> MPFHash
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     ()
forall (m :: * -> *) k (d :: * -> *) v a cf ops.
(Monad m, Ord k, GCompare d) =>
HexKey
-> FromHexKV k v a
-> MPFHashing a
-> Selector d k v
-> Selector d HexKey (HexIndirect a)
-> k
-> v
-> Transaction m cf d ops ()
inserting
            []
            FromHexKV HexKey MPFHash MPFHash
fromHexKVIdentity
            MPFHashing MPFHash
mpfHashing
            Selector (MPFStandalone HexKey MPFHash MPFHash) HexKey MPFHash
forall k v a. MPFStandalone k v a (KV k v)
MPFStandaloneKVCol
            Selector
  (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
forall k v a. MPFStandalone k v a (KV HexKey (HexIndirect a))
MPFStandaloneMPFCol
            (ByteString -> HexKey
hashKeyPath ByteString
k)
            (ByteString -> MPFHash
mkMPFHash ByteString
v)

deleteMPFM :: HexKey -> MPFPure ()
deleteMPFM :: HexKey -> MPFPure ()
deleteMPFM HexKey
k =
    MPFStandaloneCodecs HexKey MPFHash MPFHash
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     ()
-> MPFPure ()
forall k v a b.
MPFStandaloneCodecs k v a
-> Transaction
     MPFPure MPFStandaloneCF (MPFStandalone k v a) MPFStandaloneOp b
-> MPFPure b
runMPFPureTransaction MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs (Transaction
   MPFPure
   MPFStandaloneCF
   (MPFStandalone HexKey MPFHash MPFHash)
   MPFStandaloneOp
   ()
 -> MPFPure ())
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     ()
-> MPFPure ()
forall a b. (a -> b) -> a -> b
$
        HexKey
-> FromHexKV HexKey MPFHash MPFHash
-> MPFHashing MPFHash
-> Selector (MPFStandalone HexKey MPFHash MPFHash) HexKey MPFHash
-> Selector
     (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
-> HexKey
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     ()
forall (m :: * -> *) k (d :: * -> *) v a cf ops.
(Monad m, Ord k, GCompare d) =>
HexKey
-> FromHexKV k v a
-> MPFHashing a
-> Selector d k v
-> Selector d HexKey (HexIndirect a)
-> k
-> Transaction m cf d ops ()
deleting
            []
            FromHexKV HexKey MPFHash MPFHash
fromHexKVIdentity
            MPFHashing MPFHash
mpfHashing
            Selector (MPFStandalone HexKey MPFHash MPFHash) HexKey MPFHash
forall k v a. MPFStandalone k v a (KV k v)
MPFStandaloneKVCol
            Selector
  (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
forall k v a. MPFStandalone k v a (KV HexKey (HexIndirect a))
MPFStandaloneMPFCol
            HexKey
k

proofMPFM :: HexKey -> MPFPure (Maybe (MPFProof MPFHash))
proofMPFM :: HexKey -> MPFPure (Maybe (MPFProof MPFHash))
proofMPFM HexKey
k =
    MPFStandaloneCodecs HexKey MPFHash MPFHash
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe (MPFProof MPFHash))
-> MPFPure (Maybe (MPFProof MPFHash))
forall k v a b.
MPFStandaloneCodecs k v a
-> Transaction
     MPFPure MPFStandaloneCF (MPFStandalone k v a) MPFStandaloneOp b
-> MPFPure b
runMPFPureTransaction MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs (Transaction
   MPFPure
   MPFStandaloneCF
   (MPFStandalone HexKey MPFHash MPFHash)
   MPFStandaloneOp
   (Maybe (MPFProof MPFHash))
 -> MPFPure (Maybe (MPFProof MPFHash)))
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe (MPFProof MPFHash))
-> MPFPure (Maybe (MPFProof MPFHash))
forall a b. (a -> b) -> a -> b
$
        HexKey
-> FromHexKV HexKey MPFHash MPFHash
-> MPFHashing MPFHash
-> Selector
     (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
-> HexKey
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe (MPFProof MPFHash))
forall (m :: * -> *) (d :: * -> *) k v a cf ops.
(Monad m, GCompare d) =>
HexKey
-> FromHexKV k v a
-> MPFHashing a
-> Selector d HexKey (HexIndirect a)
-> k
-> Transaction m cf d ops (Maybe (MPFProof a))
mkMPFInclusionProof
            []
            FromHexKV HexKey MPFHash MPFHash
fromHexKVIdentity
            MPFHashing MPFHash
mpfHashing
            Selector
  (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
forall k v a. MPFStandalone k v a (KV HexKey (HexIndirect a))
MPFStandaloneMPFCol
            HexKey
k

exclusionMPFM :: HexKey -> MPFPure (Maybe (MPFExclusionProof MPFHash))
exclusionMPFM :: HexKey -> MPFPure (Maybe (MPFExclusionProof MPFHash))
exclusionMPFM HexKey
k =
    MPFStandaloneCodecs HexKey MPFHash MPFHash
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe (MPFExclusionProof MPFHash))
-> MPFPure (Maybe (MPFExclusionProof MPFHash))
forall k v a b.
MPFStandaloneCodecs k v a
-> Transaction
     MPFPure MPFStandaloneCF (MPFStandalone k v a) MPFStandaloneOp b
-> MPFPure b
runMPFPureTransaction MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs (Transaction
   MPFPure
   MPFStandaloneCF
   (MPFStandalone HexKey MPFHash MPFHash)
   MPFStandaloneOp
   (Maybe (MPFExclusionProof MPFHash))
 -> MPFPure (Maybe (MPFExclusionProof MPFHash)))
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe (MPFExclusionProof MPFHash))
-> MPFPure (Maybe (MPFExclusionProof MPFHash))
forall a b. (a -> b) -> a -> b
$
        HexKey
-> FromHexKV HexKey MPFHash MPFHash
-> MPFHashing MPFHash
-> Selector
     (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
-> HexKey
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe (MPFExclusionProof MPFHash))
forall (m :: * -> *) (d :: * -> *) k v a cf ops.
(Monad m, GCompare d) =>
HexKey
-> FromHexKV k v a
-> MPFHashing a
-> Selector d HexKey (HexIndirect a)
-> k
-> Transaction m cf d ops (Maybe (MPFExclusionProof a))
mkMPFExclusionProof
            []
            FromHexKV HexKey MPFHash MPFHash
fromHexKVIdentity
            MPFHashing MPFHash
mpfHashing
            Selector
  (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
forall k v a. MPFStandalone k v a (KV HexKey (HexIndirect a))
MPFStandaloneMPFCol
            HexKey
k

{- | Whether the tree nodes of a database prove this key bound to this
value under a trusted root (#299). Only the tree the root commits to is
read, never the key index kept beside it, and the proof is checked in
the encoding the on-chain validator folds, against the trusted root
rather than the database's own.
-}
provesMember
    :: MPFInMemoryDB -> ByteString -> ByteString -> ByteString -> Bool
provesMember :: MPFInMemoryDB -> ByteString -> ByteString -> ByteString -> Bool
provesMember MPFInMemoryDB
db ByteString
trusted ByteString
key ByteString
value =
    case (Maybe (MPFProof MPFHash), MPFInMemoryDB)
-> Maybe (MPFProof MPFHash)
forall a b. (a, b) -> a
fst (MPFInMemoryDB
-> MPFPure (Maybe (MPFProof MPFHash))
-> (Maybe (MPFProof MPFHash), MPFInMemoryDB)
forall b. MPFInMemoryDB -> MPFPure b -> (b, MPFInMemoryDB)
runMPFPure MPFInMemoryDB
db (HexKey -> MPFPure (Maybe (MPFProof MPFHash))
proofMPFM (ByteString -> HexKey
hashKeyPath ByteString
key))) of
        Maybe (MPFProof MPFHash)
Nothing -> Bool
False
        Just MPFProof MPFHash
proof ->
            ByteString -> ByteString -> ByteString -> ByteString -> Bool
verifyAikenInclusionProof ByteString
trusted ByteString
key ByteString
value (MPFProof MPFHash -> ByteString
serializeProof MPFProof MPFHash
proof)

{- | Whether the tree nodes of a database prove this key bound to
nothing under a trusted root (#299), from the tree alone, as
'provesMember' does. The all-zero root is the empty tree's.
-}
provesAbsent :: MPFInMemoryDB -> ByteString -> ByteString -> Bool
provesAbsent :: MPFInMemoryDB -> ByteString -> ByteString -> Bool
provesAbsent MPFInMemoryDB
db ByteString
trusted ByteString
key =
    case (Maybe (MPFExclusionProof MPFHash), MPFInMemoryDB)
-> Maybe (MPFExclusionProof MPFHash)
forall a b. (a, b) -> a
fst (MPFInMemoryDB
-> MPFPure (Maybe (MPFExclusionProof MPFHash))
-> (Maybe (MPFExclusionProof MPFHash), MPFInMemoryDB)
forall b. MPFInMemoryDB -> MPFPure b -> (b, MPFInMemoryDB)
runMPFPure MPFInMemoryDB
db (HexKey -> MPFPure (Maybe (MPFExclusionProof MPFHash))
exclusionMPFM (ByteString -> HexKey
hashKeyPath ByteString
key))) of
        Maybe (MPFExclusionProof MPFHash)
Nothing -> Bool
False
        Just MPFExclusionProof MPFHash
proof -> MPFHashing MPFHash
-> Maybe MPFHash -> MPFExclusionProof MPFHash -> Bool
forall a.
Eq a =>
MPFHashing a -> Maybe a -> MPFExclusionProof a -> Bool
verifyMPFExclusionProof MPFHashing MPFHash
mpfHashing Maybe MPFHash
trustedRoot MPFExclusionProof MPFHash
proof
  where
    trustedRoot :: Maybe MPFHash
trustedRoot
        | ByteString
trusted ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== MPFHash -> ByteString
renderMPFHash MPFHash
nullHash = Maybe MPFHash
forall a. Maybe a
Nothing
        | Bool
otherwise = ByteString -> Maybe MPFHash
parseMPFHash ByteString
trusted

-- | The serialized membership proof produced from the authenticated nodes.
membershipFromDb :: MPFInMemoryDB -> ByteString -> Maybe ByteString
membershipFromDb :: MPFInMemoryDB -> ByteString -> Maybe ByteString
membershipFromDb MPFInMemoryDB
db ByteString
key =
    MPFProof MPFHash -> ByteString
serializeProof (MPFProof MPFHash -> ByteString)
-> Maybe (MPFProof MPFHash) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (MPFProof MPFHash), MPFInMemoryDB)
-> Maybe (MPFProof MPFHash)
forall a b. (a, b) -> a
fst (MPFInMemoryDB
-> MPFPure (Maybe (MPFProof MPFHash))
-> (Maybe (MPFProof MPFHash), MPFInMemoryDB)
forall b. MPFInMemoryDB -> MPFPure b -> (b, MPFInMemoryDB)
runMPFPure MPFInMemoryDB
db (HexKey -> MPFPure (Maybe (MPFProof MPFHash))
proofMPFM (ByteString -> HexKey
hashKeyPath ByteString
key)))

-- | An exclusion proof produced from the same authenticated nodes.
exclusionFromDb
    :: MPFInMemoryDB -> ByteString -> Maybe (MPFExclusionProof MPFHash)
exclusionFromDb :: MPFInMemoryDB -> ByteString -> Maybe (MPFExclusionProof MPFHash)
exclusionFromDb MPFInMemoryDB
db ByteString
key = (Maybe (MPFExclusionProof MPFHash), MPFInMemoryDB)
-> Maybe (MPFExclusionProof MPFHash)
forall a b. (a, b) -> a
fst (MPFInMemoryDB
-> MPFPure (Maybe (MPFExclusionProof MPFHash))
-> (Maybe (MPFExclusionProof MPFHash), MPFInMemoryDB)
forall b. MPFInMemoryDB -> MPFPure b -> (b, MPFInMemoryDB)
runMPFPure MPFInMemoryDB
db (HexKey -> MPFPure (Maybe (MPFExclusionProof MPFHash))
exclusionMPFM (ByteString -> HexKey
hashKeyPath ByteString
key)))

-- | Check an exclusion proof against its key and the caller's selected root.
verifyExclusion :: MPFExclusionProof MPFHash -> ByteString -> Bool
verifyExclusion :: MPFExclusionProof MPFHash -> ByteString -> Bool
verifyExclusion MPFExclusionProof MPFHash
proof ByteString
trusted
    | ByteString
trusted ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== MPFHash -> ByteString
renderMPFHash MPFHash
nullHash =
        MPFHashing MPFHash
-> Maybe MPFHash -> MPFExclusionProof MPFHash -> Bool
forall a.
Eq a =>
MPFHashing a -> Maybe a -> MPFExclusionProof a -> Bool
verifyMPFExclusionProof MPFHashing MPFHash
mpfHashing Maybe MPFHash
forall a. Maybe a
Nothing MPFExclusionProof MPFHash
proof
    | Bool
otherwise = case ByteString -> Maybe MPFHash
parseMPFHash ByteString
trusted of
        Maybe MPFHash
Nothing -> Bool
False
        Just MPFHash
rootHash -> MPFHashing MPFHash
-> Maybe MPFHash -> MPFExclusionProof MPFHash -> Bool
forall a.
Eq a =>
MPFHashing a -> Maybe a -> MPFExclusionProof a -> Bool
verifyMPFExclusionProof MPFHashing MPFHash
mpfHashing (MPFHash -> Maybe MPFHash
forall a. a -> Maybe a
Just MPFHash
rootHash) MPFExclusionProof MPFHash
proof

-- | The pure root computation shared with the existing IO facade.
rootFromDb :: MPFInMemoryDB -> Root
rootFromDb :: MPFInMemoryDB -> Root
rootFromDb MPFInMemoryDB
db =
    case (Maybe ByteString, MPFInMemoryDB) -> Maybe ByteString
forall a b. (a, b) -> a
fst (MPFInMemoryDB
-> MPFPure (Maybe ByteString) -> (Maybe ByteString, MPFInMemoryDB)
forall b. MPFInMemoryDB -> MPFPure b -> (b, MPFInMemoryDB)
runMPFPure MPFInMemoryDB
db MPFPure (Maybe ByteString)
rootHashM) of
        Maybe ByteString
Nothing -> ByteString -> Root
Root (Int -> Word8 -> ByteString
B.replicate Int
32 Word8
0)
        Just ByteString
h -> ByteString -> Root
Root ByteString
h

-- | The existing MPF operations in genuine State, with no IORef or IO.
stateTrie :: Trie (State MPFInMemoryDB)
stateTrie :: Trie (State MPFInMemoryDB)
stateTrie =
    Trie
        { insert :: ByteString -> ByteString -> State MPFInMemoryDB Root
insert = \ByteString
key ByteString
value -> MPFPure () -> State MPFInMemoryDB Root
forall {m :: * -> *}.
MonadState MPFInMemoryDB m =>
MPFPure () -> m Root
mutate (ByteString -> ByteString -> MPFPure ()
insertByteStringM ByteString
key ByteString
value)
        , delete :: ByteString -> State MPFInMemoryDB Root
delete = MPFPure () -> State MPFInMemoryDB Root
forall {m :: * -> *}.
MonadState MPFInMemoryDB m =>
MPFPure () -> m Root
mutate (MPFPure () -> State MPFInMemoryDB Root)
-> (ByteString -> MPFPure ())
-> ByteString
-> State MPFInMemoryDB Root
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexKey -> MPFPure ()
deleteMPFM (HexKey -> MPFPure ())
-> (ByteString -> HexKey) -> ByteString -> MPFPure ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HexKey
hashKeyPath
        , lookup :: ByteString -> State MPFInMemoryDB (Maybe ByteString)
lookup = \ByteString
key -> (MPFInMemoryDB -> Maybe ByteString)
-> State MPFInMemoryDB (Maybe ByteString)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MPFInMemoryDB -> Maybe ByteString)
 -> State MPFInMemoryDB (Maybe ByteString))
-> (MPFInMemoryDB -> Maybe ByteString)
-> State MPFInMemoryDB (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \MPFInMemoryDB
db ->
            case MPFInMemoryDB -> ByteString -> Maybe ByteString
membershipFromDb MPFInMemoryDB
db ByteString
key of
                Maybe ByteString
Nothing -> Maybe ByteString
forall a. Maybe a
Nothing
                Just ByteString
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (MPFHash -> ByteString
renderMPFHash (ByteString -> MPFHash
mkMPFHash ByteString
key))
        , getRoot :: State MPFInMemoryDB Root
getRoot = (MPFInMemoryDB -> Root) -> State MPFInMemoryDB Root
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPFInMemoryDB -> Root
rootFromDb
        , getProofSteps :: ByteString -> State MPFInMemoryDB (Maybe [ProofStep])
getProofSteps = \ByteString
key -> (MPFInMemoryDB -> Maybe [ProofStep])
-> State MPFInMemoryDB (Maybe [ProofStep])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MPFInMemoryDB -> Maybe [ProofStep])
 -> State MPFInMemoryDB (Maybe [ProofStep]))
-> (MPFInMemoryDB -> Maybe [ProofStep])
-> State MPFInMemoryDB (Maybe [ProofStep])
forall a b. (a -> b) -> a -> b
$ \MPFInMemoryDB
db ->
            MPFProof MPFHash -> [ProofStep]
toProofSteps (MPFProof MPFHash -> [ProofStep])
-> Maybe (MPFProof MPFHash) -> Maybe [ProofStep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (MPFProof MPFHash), MPFInMemoryDB)
-> Maybe (MPFProof MPFHash)
forall a b. (a, b) -> a
fst (MPFInMemoryDB
-> MPFPure (Maybe (MPFProof MPFHash))
-> (Maybe (MPFProof MPFHash), MPFInMemoryDB)
forall b. MPFInMemoryDB -> MPFPure b -> (b, MPFInMemoryDB)
runMPFPure MPFInMemoryDB
db (HexKey -> MPFPure (Maybe (MPFProof MPFHash))
proofMPFM (ByteString -> HexKey
hashKeyPath ByteString
key)))
        }
  where
    mutate :: MPFPure () -> m Root
mutate MPFPure ()
action = do
        db <- m MPFInMemoryDB
forall s (m :: * -> *). MonadState s m => m s
get
        let ((), changed) = runMPFPure db action
        put changed
        pure (rootFromDb changed)

rootHashM :: MPFPure (Maybe ByteString)
rootHashM :: MPFPure (Maybe ByteString)
rootHashM =
    MPFStandaloneCodecs HexKey MPFHash MPFHash
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe ByteString)
-> MPFPure (Maybe ByteString)
forall k v a b.
MPFStandaloneCodecs k v a
-> Transaction
     MPFPure MPFStandaloneCF (MPFStandalone k v a) MPFStandaloneOp b
-> MPFPure b
runMPFPureTransaction MPFStandaloneCodecs HexKey MPFHash MPFHash
mpfHashCodecs (Transaction
   MPFPure
   MPFStandaloneCF
   (MPFStandalone HexKey MPFHash MPFHash)
   MPFStandaloneOp
   (Maybe ByteString)
 -> MPFPure (Maybe ByteString))
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe ByteString)
-> MPFPure (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
        Selector
  (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
-> HexKey
-> Transaction
     MPFPure
     MPFStandaloneCF
     (MPFStandalone HexKey MPFHash MPFHash)
     MPFStandaloneOp
     (Maybe ByteString)
forall (m :: * -> *) (d :: * -> *) cf ops.
(Monad m, GCompare d) =>
Selector d HexKey (HexIndirect MPFHash)
-> HexKey -> Transaction m cf d ops (Maybe ByteString)
root Selector
  (MPFStandalone HexKey MPFHash MPFHash) HexKey (HexIndirect MPFHash)
forall k v a. MPFStandalone k v a (KV HexKey (HexIndirect a))
MPFStandaloneMPFCol []

{- | Create a new empty 'Trie IO' backed by a fresh
'IORef' holding an empty in-memory MPF database.
-}
mkPureTrie :: IO (Trie IO)
mkPureTrie :: IO (Trie IO)
mkPureTrie = do
    ref <- MPFInMemoryDB -> IO (IORef MPFInMemoryDB)
forall a. a -> IO (IORef a)
newIORef MPFInMemoryDB
emptyMPFInMemoryDB
    pure (mkPureTrieFromRef ref)

{- | Build a 'Trie IO' from an existing 'IORef'.
The caller owns the reference and must serialize every session sharing it.
Allows sharing the database with a 'TrieManager'; this adds no synchronization.
-}
mkPureTrieFromRef :: IORef MPFInMemoryDB -> Trie IO
mkPureTrieFromRef :: IORef MPFInMemoryDB -> Trie IO
mkPureTrieFromRef IORef MPFInMemoryDB
ref =
    Trie
        { insert :: ByteString -> ByteString -> IO Root
insert = IORef MPFInMemoryDB -> ByteString -> ByteString -> IO Root
pureInsert IORef MPFInMemoryDB
ref
        , delete :: ByteString -> IO Root
delete = IORef MPFInMemoryDB -> ByteString -> IO Root
pureDelete IORef MPFInMemoryDB
ref
        , lookup :: ByteString -> IO (Maybe ByteString)
lookup = IORef MPFInMemoryDB -> ByteString -> IO (Maybe ByteString)
pureLookup IORef MPFInMemoryDB
ref
        , getRoot :: IO Root
getRoot = IORef MPFInMemoryDB -> IO Root
pureGetRoot IORef MPFInMemoryDB
ref
        , getProofSteps :: ByteString -> IO (Maybe [ProofStep])
getProofSteps = IORef MPFInMemoryDB -> ByteString -> IO (Maybe [ProofStep])
pureGetProofSteps IORef MPFInMemoryDB
ref
        }

-- | Insert a key-value pair.
pureInsert
    :: IORef MPFInMemoryDB
    -> ByteString
    -> ByteString
    -> IO Root
pureInsert :: IORef MPFInMemoryDB -> ByteString -> ByteString -> IO Root
pureInsert IORef MPFInMemoryDB
ref ByteString
k ByteString
v = do
    db <- IORef MPFInMemoryDB -> IO MPFInMemoryDB
forall a. IORef a -> IO a
readIORef IORef MPFInMemoryDB
ref
    let ((), db') =
            runMPFPure db (insertByteStringM k v)
    modifyIORef' ref (const db')
    getRootFromDb db'

-- | Delete a key from the trie.
pureDelete
    :: IORef MPFInMemoryDB
    -> ByteString
    -> IO Root
pureDelete :: IORef MPFInMemoryDB -> ByteString -> IO Root
pureDelete IORef MPFInMemoryDB
ref ByteString
k = do
    db <- IORef MPFInMemoryDB -> IO MPFInMemoryDB
forall a. IORef a -> IO a
readIORef IORef MPFInMemoryDB
ref
    let hexKey =
            ByteString -> HexKey
byteStringToHexKey (ByteString -> HexKey) -> ByteString -> HexKey
forall a b. (a -> b) -> a -> b
$
                MPFHash -> ByteString
renderMPFHash (MPFHash -> ByteString) -> MPFHash -> ByteString
forall a b. (a -> b) -> a -> b
$
                    ByteString -> MPFHash
mkMPFHash ByteString
k
        ((), db') =
            runMPFPure db (deleteMPFM hexKey)
    modifyIORef' ref (const db')
    getRootFromDb db'

-- | Look up a value by key.
pureLookup
    :: IORef MPFInMemoryDB
    -> ByteString
    -> IO (Maybe ByteString)
pureLookup :: IORef MPFInMemoryDB -> ByteString -> IO (Maybe ByteString)
pureLookup IORef MPFInMemoryDB
ref ByteString
k = do
    db <- IORef MPFInMemoryDB -> IO MPFInMemoryDB
forall a. IORef a -> IO a
readIORef IORef MPFInMemoryDB
ref
    let hexKey =
            ByteString -> HexKey
byteStringToHexKey (ByteString -> HexKey) -> ByteString -> HexKey
forall a b. (a -> b) -> a -> b
$
                MPFHash -> ByteString
renderMPFHash (MPFHash -> ByteString) -> MPFHash -> ByteString
forall a b. (a -> b) -> a -> b
$
                    ByteString -> MPFHash
mkMPFHash ByteString
k
        (mProof, _) =
            runMPFPure db (proofMPFM hexKey)
    pure $ case mProof of
        Maybe (MPFProof MPFHash)
Nothing -> Maybe ByteString
forall a. Maybe a
Nothing
        Just MPFProof MPFHash
_ ->
            ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (MPFHash -> ByteString
renderMPFHash (ByteString -> MPFHash
mkMPFHash ByteString
k))

-- | Get current root hash.
pureGetRoot :: IORef MPFInMemoryDB -> IO Root
pureGetRoot :: IORef MPFInMemoryDB -> IO Root
pureGetRoot IORef MPFInMemoryDB
ref = IORef MPFInMemoryDB -> IO MPFInMemoryDB
forall a. IORef a -> IO a
readIORef IORef MPFInMemoryDB
ref IO MPFInMemoryDB -> (MPFInMemoryDB -> IO Root) -> IO Root
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MPFInMemoryDB -> IO Root
getRootFromDb

-- | Get root hash from a database snapshot.
getRootFromDb :: MPFInMemoryDB -> IO Root
getRootFromDb :: MPFInMemoryDB -> IO Root
getRootFromDb = Root -> IO Root
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Root -> IO Root)
-> (MPFInMemoryDB -> Root) -> MPFInMemoryDB -> IO Root
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPFInMemoryDB -> Root
rootFromDb

-- | Generate on-chain proof steps for a key.
pureGetProofSteps
    :: IORef MPFInMemoryDB
    -> ByteString
    -> IO (Maybe [ProofStep])
pureGetProofSteps :: IORef MPFInMemoryDB -> ByteString -> IO (Maybe [ProofStep])
pureGetProofSteps IORef MPFInMemoryDB
ref ByteString
k = do
    db <- IORef MPFInMemoryDB -> IO MPFInMemoryDB
forall a. IORef a -> IO a
readIORef IORef MPFInMemoryDB
ref
    let hexKey =
            ByteString -> HexKey
byteStringToHexKey (ByteString -> HexKey) -> ByteString -> HexKey
forall a b. (a -> b) -> a -> b
$
                MPFHash -> ByteString
renderMPFHash (MPFHash -> ByteString) -> MPFHash -> ByteString
forall a b. (a -> b) -> a -> b
$
                    ByteString -> MPFHash
mkMPFHash ByteString
k
        (mProof, _) =
            runMPFPure db (proofMPFM hexKey)
    pure $ case mProof of
        Maybe (MPFProof MPFHash)
Nothing -> Maybe [ProofStep]
forall a. Maybe a
Nothing
        Just MPFProof MPFHash
proof -> [ProofStep] -> Maybe [ProofStep]
forall a. a -> Maybe a
Just (MPFProof MPFHash -> [ProofStep]
toProofSteps MPFProof MPFHash
proof)