Skip to content

Commit

Permalink
implement HeaderOracle and get SPV functions to use that
Browse files Browse the repository at this point in the history
Change-Id: Ie1996cf9f50c73f16a4e5a1fa30aea67e648d188

remove redundant prett-show dependency

Change-Id: I2a4e0ca1a615c0edf28576ee763af6b16aebc234
  • Loading branch information
chessai committed Dec 9, 2024
1 parent 2644675 commit 6746f22
Show file tree
Hide file tree
Showing 6 changed files with 202 additions and 276 deletions.
2 changes: 1 addition & 1 deletion chainweb.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -154,6 +154,7 @@ library
, Chainweb.BlockHeader.Genesis.Mainnet10to19Payload
, Chainweb.BlockHeader.Validation
, Chainweb.BlockHeaderDB
, Chainweb.BlockHeaderDB.HeaderOracle
, Chainweb.BlockHeaderDB.Internal
, Chainweb.BlockHeaderDB.PruneForks
, Chainweb.BlockHeaderDB.RemoteDB
Expand Down Expand Up @@ -677,7 +678,6 @@ test-suite chainweb-tests
, lens >= 4.17
, lens-aeson >= 1.2.2
, loglevel >= 0.1
, pretty-show
, memory >=0.14
, merkle-log >=0.2
, mtl >= 2.3
Expand Down
124 changes: 124 additions & 0 deletions src/Chainweb/BlockHeaderDB/HeaderOracle.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,124 @@
{-# language
DerivingStrategies
, ImportQualifiedPost
, LambdaCase
, OverloadedRecordDot
, RecordWildCards
, ScopedTypeVariables
, TypeApplications
#-}

module Chainweb.BlockHeaderDB.HeaderOracle
(
-- * Oracle type
HeaderOracle
-- ** Accessors
, lowerBound
, upperBound

-- * Oracle creation
, create
, createSpv
-- ** Oracle creation Exceptions
, InvalidHeaderOracleBounds(..)

-- * Oracle querying
, query
, HeaderOracleResponse(..)
)
where

import Chainweb.BlockHash (BlockHash)
import Chainweb.BlockHeader (BlockHeader, blockHash, blockHeight, genesisBlockHeader)
import Chainweb.BlockHeaderDB (BlockHeaderDb)
import Chainweb.TreeDB (seekAncestor)
import Chainweb.TreeDB qualified as TreeDB
import Chainweb.Version (_chainwebVersion)
import Chainweb.Version.Guards (spvProofExpirationWindow)
import Control.Exception (Exception(..), throwIO)
import Control.Lens (view)
import Numeric.Natural (Natural)

-- | A 'HeaderOracle' is a 'BlockHeaderDb' with a lower and upper bound, and the only
-- query on it is whether a given block is within those bounds.
data HeaderOracle = HeaderOracle
{ lowerBound :: !BlockHeader
, upperBound :: !BlockHeader
, db :: !BlockHeaderDb
}

-- | Create a new 'HeaderOracle' specifically for SPV verification, with the given upper bound.
--
-- The lower bound of the oracle is determined by the 'spvProofExpirationWindow'.
createSpv :: BlockHeaderDb -> BlockHeader -> IO HeaderOracle
createSpv db upperBound = do
let mWindow = spvProofExpirationWindow (_chainwebVersion upperBound) (view blockHeight upperBound)
let gh = genesisBlockHeader (_chainwebVersion upperBound) upperBound
let defaultOracle = create db gh upperBound

case mWindow of
Nothing -> do
defaultOracle
Just window -> do
mWindowthAncestor <- do
let w = fromIntegral @_ @Natural window
let ur = TreeDB.rank upperBound
let gr = TreeDB.rank gh
-- Saturated subtraction with the genesis rank as origin
if w + gr <= ur
then do
seekAncestor db upperBound (ur - w)
else do
return Nothing
case mWindowthAncestor of
Nothing -> do
defaultOracle
Just windowthAncestor -> do
create db windowthAncestor upperBound

-- | Exception thrown when creating a new 'HeaderOracle' with invalid bounds.
data InvalidHeaderOracleBounds = InvalidHeaderOracleBounds !BlockHash !BlockHash
deriving stock (Eq, Show)

instance Exception InvalidHeaderOracleBounds where
displayException (InvalidHeaderOracleBounds l u) = "Header Oracle `create` called with a (lower, upper) pair, where `lower` is not an ancestor of `upper`: " ++ show (l, u)

-- | Create a new 'HeaderOracle' with the given lower and upper bounds.
--
-- Throws an 'InvalidHeaderOracleBounds' exception if the lower bound is not an ancestor of the upper bound.
create :: BlockHeaderDb -> BlockHeader -> BlockHeader -> IO HeaderOracle
create db lowerBound upperBound = do
valid <- TreeDB.ancestorOf db (view blockHash lowerBound) (view blockHash upperBound)
if valid
then do
return HeaderOracle
{ ..
}
else do
throwIO $ InvalidHeaderOracleBounds (view blockHash lowerBound) (view blockHash upperBound)

-- TODO: add note about we can't have two different errors here, because shallow nodes can't determine which one is the case
-- eg we cant have data Response = TooLate | OutOfBounds | Success

-- | The response from the oracle when querying a block.
data HeaderOracleResponse
= OutOfBounds
-- ^ The block is not within the oracle's bounds.
| InBounds
-- ^ The block is within the oracle's bounds.
deriving stock (Eq)

-- | Query the oracle, asking if the block is within its bounds.
query :: ()
=> HeaderOracle
-> BlockHash
-> IO HeaderOracleResponse
query oracle subject = do
-- Check if the lower bound is an ancestor of the header
-- Check if the header is an ancestor of the upper bound
r <- (&&)
<$> TreeDB.ancestorOf oracle.db (view blockHash oracle.lowerBound) subject
<*> TreeDB.ancestorOf oracle.db subject (view blockHash oracle.upperBound)
return $ if r
then InBounds
else OutOfBounds
12 changes: 8 additions & 4 deletions src/Chainweb/Pact/SPV.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,7 @@ import Chainweb.Pact.Utils (aeson)
import Chainweb.Payload
import Chainweb.Payload.PayloadStore
import Chainweb.SPV
import Chainweb.BlockHeaderDB.HeaderOracle qualified as Oracle
import Chainweb.SPV.VerifyProof
import Chainweb.TreeDB
import Chainweb.Utils
Expand Down Expand Up @@ -117,7 +118,9 @@ verifySPV
-> Object Name
-- ^ the proof object to validate
-> IO (Either Text (Object Name))
verifySPV bdb bh typ proof = runExceptT $ go typ proof
verifySPV bdb bh typ proof = do
oracle <- Oracle.createSpv bdb bh
runExceptT $ go oracle typ proof
where
cid = CW._chainId bdb
enableBridge = CW.enableSPVBridge (CW._chainwebVersion bh) cid (view blockHeight bh)
Expand All @@ -129,7 +132,7 @@ verifySPV bdb bh typ proof = runExceptT $ go typ proof
TObject o _ -> return o
_ -> throwError "spv-verified tx output has invalid type"

go s o = case s of
go oracle s o = case s of

-- Ethereum Receipt Proof
"ETH" | enableBridge -> except (extractEthProof o) >>=
Expand All @@ -152,7 +155,7 @@ verifySPV bdb bh typ proof = runExceptT $ go typ proof
-- 3. Extract tx outputs as a pact object and return the
-- object.

TransactionOutput p <- catchAndDisplaySPVError bh $ liftIO $ verifyTransactionOutputProofAt_ bdb u bh
TransactionOutput p <- catchAndDisplaySPVError bh $ liftIO $ verifyTransactionOutputProof oracle u

q <- case decodeStrict' p :: Maybe (CommandResult Hash) of
Nothing -> forkedThrower bh "unable to decode spv transaction output"
Expand Down Expand Up @@ -251,6 +254,7 @@ verifyCont
-- ^ bytestring of 'TransactionOutputP roof' object to validate
-> IO (Either Text PactExec)
verifyCont bdb bh (ContProof cp) = runExceptT $ do
oracle <- liftIO $ Oracle.createSpv bdb bh
let errorMessageType =
if CW.chainweb221Pact
(CW._chainwebVersion bh)
Expand All @@ -275,7 +279,7 @@ verifyCont bdb bh (ContProof cp) = runExceptT $ do
-- 3. Extract continuation 'PactExec' from decoded result
-- and return the cont exec object

TransactionOutput p <- catchAndDisplaySPVError bh $ liftIO $ verifyTransactionOutputProofAt_ bdb u bh
TransactionOutput p <- catchAndDisplaySPVError bh $ liftIO $ verifyTransactionOutputProof oracle u

q <- case decodeStrict' p :: Maybe (CommandResult Hash) of
Nothing -> forkedThrower bh "unable to decode spv transaction output"
Expand Down
Loading

0 comments on commit 6746f22

Please sign in to comment.