From 6f8c30ddeabb3d9d51257f9e33a680539d1c9969 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Wed, 10 Apr 2024 18:29:03 -0400 Subject: [PATCH 1/9] Add Verifiers to cw-data Now txHandler & txsHandler returns a TxDetail with list of verifiers (in json) to an api consumer. --- cabal.project | 4 ++-- haskell-src/exec/Chainweb/Lookups.hs | 1 + haskell-src/exec/Chainweb/Server.hs | 1 + haskell-src/lib/ChainwebDb/Types/Transaction.hs | 1 + 4 files changed, 5 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index a820ded8..22e28ed4 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/chainweb-api.git - tag: 1b2de025cfdc09698bfb1ec3807cd85405d6a339 - --sha256: sha256-06jvD1kmkmthcRkyWhVLTbytwabghInxqXQD/Lm7kbA= + tag: b7eb7ffc3d6da99afe194205631a8f052308b7f4 + --sha256: sha256-8Eamd+POoA8qEWJJZ2BPMDjlfVMvbBzOHXZP3QX8eEQ= source-repository-package type: git diff --git a/haskell-src/exec/Chainweb/Lookups.hs b/haskell-src/exec/Chainweb/Lookups.hs index 1bcd44e5..8d333a79 100644 --- a/haskell-src/exec/Chainweb/Lookups.hs +++ b/haskell-src/exec/Chainweb/Lookups.hs @@ -318,6 +318,7 @@ mkTransaction b (tx,txo) = Transaction , _tx_continuation = PgJSONB <$> _toutContinuation txo , _tx_txid = fromIntegral <$> _toutTxId txo , _tx_numEvents = Just $ fromIntegral $ length $ _toutEvents txo + , _tx_verifiers = PgJSONB <$> tx ^? to (CW._transaction_cmdStr) . key "verifiers" } where cmd = CW._transaction_cmd tx diff --git a/haskell-src/exec/Chainweb/Server.hs b/haskell-src/exec/Chainweb/Server.hs index d151df74..c07ac828 100644 --- a/haskell-src/exec/Chainweb/Server.hs +++ b/haskell-src/exec/Chainweb/Server.hs @@ -386,6 +386,7 @@ toApiTxDetail tx contHist blk evs signers sigs = TxDetail , _txDetail_previousSteps = V.toList (chSteps contHist) <$ chCode contHist , _txDetail_signers = signers , _txDetail_sigs = sigs + , _txDetail_verifiers = unPgJsonb <$> _tx_verifiers tx } where unMaybeValue = maybe Null unPgJsonb diff --git a/haskell-src/lib/ChainwebDb/Types/Transaction.hs b/haskell-src/lib/ChainwebDb/Types/Transaction.hs index abce1f90..b80adac8 100644 --- a/haskell-src/lib/ChainwebDb/Types/Transaction.hs +++ b/haskell-src/lib/ChainwebDb/Types/Transaction.hs @@ -54,6 +54,7 @@ data TransactionT f = Transaction , _tx_continuation :: C f (Maybe (PgJSONB Value)) , _tx_txid :: C f (Maybe Int64) , _tx_numEvents :: C f (Maybe Int64) + , _tx_verifiers :: C f (Maybe (PgJSONB Value)) } deriving stock (Generic) deriving anyclass (Beamable) From 89eb0c72f406b0331eef67fa239e6609292d0f67 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Thu, 11 Apr 2024 23:12:11 -0400 Subject: [PATCH 2/9] Include verifiers table --- cabal.project | 4 +- haskell-src/chainweb-data.cabal | 1 + haskell-src/exec/Chainweb/Listen.hs | 3 +- haskell-src/exec/Chainweb/Lookups.hs | 23 +++++++++- haskell-src/exec/Chainweb/Server.hs | 24 ++++++++-- haskell-src/exec/Chainweb/Worker.hs | 27 ++++++++--- haskell-src/lib/ChainwebData/Spec.hs | 18 +++++++- haskell-src/lib/ChainwebDb/Database.hs | 10 +++++ .../lib/ChainwebDb/Types/Transaction.hs | 1 - haskell-src/lib/ChainwebDb/Types/Verifier.hs | 45 +++++++++++++++++++ 10 files changed, 141 insertions(+), 15 deletions(-) create mode 100644 haskell-src/lib/ChainwebDb/Types/Verifier.hs diff --git a/cabal.project b/cabal.project index 22e28ed4..a228ff1c 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/chainweb-api.git - tag: b7eb7ffc3d6da99afe194205631a8f052308b7f4 - --sha256: sha256-8Eamd+POoA8qEWJJZ2BPMDjlfVMvbBzOHXZP3QX8eEQ= + tag: eb57e84608fe91d171065c26a7877a01da952f75 + --sha256: sha256-Y9ZM7PNNkmi9ps3uf6Cva5h3n12qfmYqLca2w4wRkJw= source-repository-package type: git diff --git a/haskell-src/chainweb-data.cabal b/haskell-src/chainweb-data.cabal index a5298dec..c47dc396 100644 --- a/haskell-src/chainweb-data.cabal +++ b/haskell-src/chainweb-data.cabal @@ -74,6 +74,7 @@ library ChainwebDb.Types.Signer ChainwebDb.Types.Transaction ChainwebDb.Types.Transfer + ChainwebDb.Types.Verifier build-depends: base64-bytestring >=1.0 , cryptohash diff --git a/haskell-src/exec/Chainweb/Listen.hs b/haskell-src/exec/Chainweb/Listen.hs index 8d78fe77..4a81bc60 100644 --- a/haskell-src/exec/Chainweb/Listen.hs +++ b/haskell-src/exec/Chainweb/Listen.hs @@ -89,12 +89,13 @@ insertNewHeader version pool ph pl = do !t = mkBlockTransactions b pl !es = mkBlockEvents (fromIntegral $ _blockHeader_height $ _hwp_header ph) (_blockHeader_chainId $ _hwp_header ph) (DbHash $ hashB64U $ _blockHeader_hash $ _hwp_header ph) pl !ss = concat $ map (mkTransactionSigners . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pl) + !vs = concat $ map (mkTransactionVerifiers . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pl) !k = bpwoMinerKeys pl err = printf "insertNewHeader failed because we don't know how to work this version %s" version withEventsMinHeight version err $ \minHeight -> do let !tf = mkTransferRows (fromIntegral $ _blockHeader_height $ _hwp_header ph) (_blockHeader_chainId $ _hwp_header ph) (DbHash $ hashB64U $ _blockHeader_hash $ _hwp_header ph) (posixSecondsToUTCTime $ _blockHeader_creationTime $ _hwp_header ph) pl minHeight - writes pool b k t es ss tf + writes pool b k t es ss tf vs mkRequest :: UrlScheme -> ChainwebVersion -> Request mkRequest us (ChainwebVersion cv) = defaultRequest diff --git a/haskell-src/exec/Chainweb/Lookups.hs b/haskell-src/exec/Chainweb/Lookups.hs index 8d333a79..30a671fb 100644 --- a/haskell-src/exec/Chainweb/Lookups.hs +++ b/haskell-src/exec/Chainweb/Lookups.hs @@ -20,6 +20,7 @@ module Chainweb.Lookups , mkBlockEventsWithCreationTime , mkCoinbaseEvents , mkTransactionSigners + , mkTransactionVerifiers , mkTransferRows , bpwoMinerKeys @@ -38,6 +39,7 @@ import Chainweb.Api.NodeInfo import Chainweb.Api.PactCommand import Chainweb.Api.Payload import Chainweb.Api.Sig +import qualified Chainweb.Api.Verifier as CW import qualified Chainweb.Api.Signer as CW import qualified Chainweb.Api.Transaction as CW import ChainwebData.Env @@ -49,6 +51,7 @@ import ChainwebDb.Types.Event import ChainwebDb.Types.Signer import ChainwebDb.Types.Transaction import ChainwebDb.Types.Transfer +import ChainwebDb.Types.Verifier import Control.Applicative import Control.Lens import Control.Monad @@ -58,7 +61,9 @@ import Data.Aeson.Lens import Data.Aeson.Types import Data.ByteString.Lazy (ByteString,toStrict) import Data.Foldable +import Data.Functor.Compose (Compose(..)) import Data.Int +import Data.List (zipWith4) import Data.Maybe import Data.String (fromString) import qualified Data.Text as T @@ -278,6 +283,23 @@ mkTransactionSigners t = zipWith3 mkSigner signers sigs [0..] (PgJSONB $ map toJSON $ CW._signer_capList signer) (Signature $ unSig sig) +mkTransactionVerifiers :: CW.Transaction -> [Verifier] +mkTransactionVerifiers t = zipWith4 mkVerifier [0..] names proofs capLists + where + verifiers :: Compose Maybe [] CW.Verifier + verifiers = Compose $ t ^? to CW._transaction_cmdStr . key "verifiers" . _JSON + names = toList $ CW._verifier_name <$> verifiers + proofs = toList $ CW._verifier_proof <$> verifiers + capLists = toList $ CW._verifier_capList <$> verifiers + requestkey = CW._transaction_hash t + mkVerifier idx name proof capList = Verifier + { _verifier_requestkey = DbHash $ hashB64U requestkey + , _verifier_idx = idx + , _verifier_name = name + , _verifier_proof = proof + , _verifier_caps = PgJSONB $ map toJSON capList + } + mkCoinbaseEvents :: Int64 -> ChainId -> DbHash BlockHash -> BlockPayloadWithOutputs -> [Event] mkCoinbaseEvents height cid blockhash pl = _blockPayloadWithOutputs_coinbase pl & coinbaseTO @@ -318,7 +340,6 @@ mkTransaction b (tx,txo) = Transaction , _tx_continuation = PgJSONB <$> _toutContinuation txo , _tx_txid = fromIntegral <$> _toutTxId txo , _tx_numEvents = Just $ fromIntegral $ length $ _toutEvents txo - , _tx_verifiers = PgJSONB <$> tx ^? to (CW._transaction_cmdStr) . key "verifiers" } where cmd = CW._transaction_cmd tx diff --git a/haskell-src/exec/Chainweb/Server.hs b/haskell-src/exec/Chainweb/Server.hs index c07ac828..935cc008 100644 --- a/haskell-src/exec/Chainweb/Server.hs +++ b/haskell-src/exec/Chainweb/Server.hs @@ -62,6 +62,7 @@ import Chainweb.Api.Common (BlockHeight) import Chainweb.Api.StringEncoded (StringEncoded(..)) import qualified Chainweb.Api.Sig as Api import qualified Chainweb.Api.Signer as Api +import qualified Chainweb.Api.Verifier as Api import Chainweb.Coins import ChainwebDb.Database import ChainwebDb.Queries @@ -83,6 +84,7 @@ import ChainwebDb.Types.DbHash import ChainwebDb.Types.Signer import ChainwebDb.Types.Transfer import ChainwebDb.Types.Transaction +import ChainwebDb.Types.Verifier import ChainwebDb.Types.Event import ChainwebDb.BoundedScan ------------------------------------------------------------------------------ @@ -353,8 +355,9 @@ toApiTxDetail :: [Event] -> [Api.Signer] -> [Api.Sig] -> + Maybe [Api.Verifier] -> TxDetail -toApiTxDetail tx contHist blk evs signers sigs = TxDetail +toApiTxDetail tx contHist blk evs signers sigs verifiers = TxDetail { _txDetail_ttl = fromIntegral $ _tx_ttl tx , _txDetail_gasLimit = fromIntegral $ _tx_gasLimit tx , _txDetail_gasPrice = _tx_gasPrice tx @@ -386,7 +389,7 @@ toApiTxDetail tx contHist blk evs signers sigs = TxDetail , _txDetail_previousSteps = V.toList (chSteps contHist) <$ chCode contHist , _txDetail_signers = signers , _txDetail_sigs = sigs - , _txDetail_verifiers = unPgJsonb <$> _tx_verifiers tx + , _txDetail_verifiers = verifiers } where unMaybeValue = maybe Null unPgJsonb @@ -436,9 +439,24 @@ queryTxsByKey logger rk c = let sigs = Api.Sig . unSignature . _signer_sig <$> dbSigners sameBlock tx ev = (unBlockId $ _tx_block tx) == (unBlockId $ _ev_block ev) + dbVerifiers <- runSelectReturningList $ select $ orderBy_ (asc_ . _verifier_idx) $ do + verifier <- all_ (_cddb_verifiers database) + guard_ (_verifier_requestkey verifier ==. val_ (DbHash rk)) + return verifier + + verifiers <- forM dbVerifiers $ \v -> do + caps <- forM (unPgJsonb $ _verifier_caps v) $ \capsJson -> case fromJSON capsJson of + A.Success a -> return a + A.Error e -> liftIO $ throwIO $ userError $ "Failed to parse signer capabilities: " <> e + return $ Api.Verifier + { Api._verifier_name = _verifier_name v + , Api._verifier_proof = _verifier_proof v + , Api._verifier_capList = caps + } + return $ (`fmap` r) $ \(tx,contHist, blk) -> let evsInTxBlock = filter (sameBlock tx) evs - in toApiTxDetail tx contHist blk evsInTxBlock signers sigs + in toApiTxDetail tx contHist blk evsInTxBlock signers sigs (verifiers <$ guard (not $ null verifiers)) queryTxsByPactId :: LogFunctionIO Text -> Limit -> Text -> Connection -> IO [TxSummary] queryTxsByPactId logger limit pactid c = diff --git a/haskell-src/exec/Chainweb/Worker.hs b/haskell-src/exec/Chainweb/Worker.hs index 57f4ee13..afee761b 100644 --- a/haskell-src/exec/Chainweb/Worker.hs +++ b/haskell-src/exec/Chainweb/Worker.hs @@ -28,6 +28,7 @@ import ChainwebDb.Types.MinerKey import ChainwebDb.Types.Signer import ChainwebDb.Types.Transaction import ChainwebDb.Types.Transfer +import ChainwebDb.Types.Verifier import Control.Lens (iforM_) import qualified Data.ByteString as B import qualified Data.ByteString.Base16 as B16 @@ -47,8 +48,8 @@ import Database.PostgreSQL.Simple.Transaction (withTransaction,withSav -- | Write a Block and its Transactions to the database. Also writes the Miner -- if it hasn't already been via some other block. -writes :: P.Pool Connection -> Block -> [T.Text] -> [Transaction] -> [Event] -> [Signer] -> [Transfer] -> IO () -writes pool b ks ts es ss tf = P.withResource pool $ \c -> withTransaction c $ do +writes :: P.Pool Connection -> Block -> [T.Text] -> [Transaction] -> [Event] -> [Signer] -> [Transfer] -> [Verifier] -> IO () +writes pool b ks ts es ss tf vs = P.withResource pool $ \c -> withTransaction c $ do runBeamPostgres c $ do -- Write the Block if unique -- runInsert @@ -75,6 +76,9 @@ writes pool b ks ts es ss tf = P.withResource pool $ \c -> withTransaction c $ d runInsert $ insert (_cddb_transfers database) (insertValues tf) $ onConflict (conflictingFields primaryKey) onConflictDoNothing + runInsert + $ insert (_cddb_verifiers database) (insertValues vs) + $ onConflict (conflictingFields primaryKey) onConflictDoNothing -- liftIO $ printf "[OKAY] Chain %d: %d: %s %s\n" -- (_block_chainId b) -- (_block_height b) @@ -89,8 +93,9 @@ batchWrites -> [[Event]] -> [[Signer]] -> [[Transfer]] + -> [[Verifier]] -> IO () -batchWrites pool bs kss tss ess sss tfs = P.withResource pool $ \c -> withTransaction c $ do +batchWrites pool bs kss tss ess sss tfs vss = P.withResource pool $ \c -> withTransaction c $ do runBeamPostgres c $ do -- Write the Blocks if unique @@ -124,6 +129,10 @@ batchWrites pool bs kss tss ess sss tfs = P.withResource pool $ \c -> withTransa $ insert (_cddb_transfers database) (insertValues $ concat tfs) $ onConflict (conflictingFields primaryKey) onConflictDoNothing + runInsert + $ insert (_cddb_verifiers database) (insertValues $ concat vss) + $ onConflict (conflictingFields primaryKey) onConflictDoNothing + asPow :: BlockHeader -> PowHeader asPow bh = PowHeader bh (T.decodeUtf8 . B16.encode . B.reverse . unHash $ powHash bh) @@ -142,8 +151,10 @@ writeBlock env pool count (bh, pwo) = do err = printf "writeBlock failed because we don't know how to work this version %s" version withEventsMinHeight version err $ \evMinHeight -> do let !tf = mkTransferRows (fromIntegral $ _blockHeader_height bh) (_blockHeader_chainId bh) (DbHash $ hashB64U $ _blockHeader_hash bh) (posixSecondsToUTCTime $ _blockHeader_creationTime bh) pwo evMinHeight + let !vs = concat $ map (mkTransactionVerifiers . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pwo) + atomicModifyIORef' count (\n -> (n+1, ())) - writes pool b k t es ss tf + writes pool b k t es ss tf vs writeBlocks :: Env -> P.Pool Connection -> IORef Int -> [(BlockHeader, BlockPayloadWithOutputs)] -> IO () writeBlocks env pool count blocks = do @@ -160,10 +171,11 @@ writeBlocks env pool count blocks = do (makeBlockMap bhs') !sss = M.intersectionWith (\pl _ -> concat $ mkTransactionSigners . fst <$> _blockPayloadWithOutputs_transactionsWithOutputs pl) pls (makeBlockMap bhs') !kss = M.intersectionWith (\p _ -> bpwoMinerKeys p) pls (makeBlockMap bhs') + !vss = M.intersectionWith (\pl _ -> concat $ mkTransactionVerifiers . fst <$> _blockPayloadWithOutputs_transactionsWithOutputs pl) pls (makeBlockMap bhs') err = printf "writeBlocks failed because we don't know how to work this version %s" version withEventsMinHeight version err $ \evMinHeight -> do let !tfs = M.intersectionWith (\pl bh -> mkTransferRows (fromIntegral $ _blockHeader_height bh) (_blockHeader_chainId bh) (DbHash $ hashB64U $ _blockHeader_hash bh) (posixSecondsToUTCTime $ _blockHeader_creationTime bh) pl evMinHeight) pls (makeBlockMap bhs') - batchWrites pool (M.elems bs) (M.elems kss) (M.elems tss) (M.elems ess) (M.elems sss) (M.elems tfs) + batchWrites pool (M.elems bs) (M.elems kss) (M.elems tss) (M.elems ess) (M.elems sss) (M.elems tfs) (M.elems vss) atomicModifyIORef' count (\n -> (n + numWrites, ())) where @@ -189,6 +201,7 @@ writePayload pool chain blockHash blockHeight version creationTime bpwo = do err = printf "writePayload failed because we don't know how to work this version %s" version withEventsMinHeight version err $ \evMinHeight -> do let !tfs = mkTransferRows blockHeight chain blockHash creationTime bpwo evMinHeight + !vss = concat $ map (mkTransactionVerifiers . fst) $ _blockPayloadWithOutputs_transactionsWithOutputs bpwo P.withResource pool $ \c -> withTransaction c $ do runBeamPostgres c $ do @@ -198,6 +211,10 @@ writePayload pool chain blockHash blockHeight version creationTime bpwo = do runInsert $ insert (_cddb_transfers database) (insertValues tfs) $ onConflict (conflictingFields primaryKey) onConflictDoNothing + -- TODO: This might be necessary. Will need to think about this further + runInsert + $ insert (_cddb_verifiers database) (insertValues vss) + $ onConflict (conflictingFields primaryKey) onConflictDoNothing withSavepoint c $ runBeamPostgres c $ forM_ txEvents $ \(reqKey, events) -> runUpdate diff --git a/haskell-src/lib/ChainwebData/Spec.hs b/haskell-src/lib/ChainwebData/Spec.hs index 666a669b..8a0ebc5d 100644 --- a/haskell-src/lib/ChainwebData/Spec.hs +++ b/haskell-src/lib/ChainwebData/Spec.hs @@ -25,7 +25,9 @@ import Servant.OpenApi import ChainwebData.Pagination import Chainweb.Api.ChainId import Chainweb.Api.Sig +import Chainweb.Api.SigCapability import Chainweb.Api.Signer +import Chainweb.Api.Verifier import ChainwebData.TxSummary import Data.OpenApi @@ -115,6 +117,18 @@ instance ToSchema (StringEncoded Scientific) where & example ?~ A.String "-1234.5e6" & pattern ?~ "[-+]?[0-9]*\\.?[0-9]+([eE][-+]?[0-9]+)?" -spec :: OpenApi -spec = toOpenApi (Proxy :: Proxy ChainwebDataApi) +instance ToSchema Verifier where + declareNamedSchema _ = do + textSchema <- declareSchemaRef (Proxy :: Proxy T.Text) + sigCapabilitySchema <- declareSchemaRef (Proxy :: Proxy [SigCapability]) + return $ NamedSchema (Just "Verifier") $ mempty + & type_ ?~ OpenApiObject + & properties + .~ [ ("name", textSchema) + , ("proof", textSchema) + , ("clist", sigCapabilitySchema) + ] + & required .~ ["pubKey", "clist"] +spec :: OpenApi +spec = toOpenApi (Proxy :: Proxy ChainwebDataApi) \ No newline at end of file diff --git a/haskell-src/lib/ChainwebDb/Database.hs b/haskell-src/lib/ChainwebDb/Database.hs index 38ed007f..5143d684 100644 --- a/haskell-src/lib/ChainwebDb/Database.hs +++ b/haskell-src/lib/ChainwebDb/Database.hs @@ -24,6 +24,7 @@ import ChainwebDb.Types.MinerKey import ChainwebDb.Types.Signer import ChainwebDb.Types.Transaction import ChainwebDb.Types.Transfer +import ChainwebDb.Types.Verifier import qualified Data.Pool as P import Data.Text (Text) import qualified Data.Text as T @@ -41,6 +42,7 @@ data ChainwebDataDb f = ChainwebDataDb , _cddb_events :: f (TableEntity EventT) , _cddb_signers :: f (TableEntity SignerT) , _cddb_transfers :: f (TableEntity TransferT) + , _cddb_verifiers :: f (TableEntity VerifierT) } deriving stock (Generic) deriving anyclass (Database be) @@ -137,6 +139,14 @@ database = defaultDbSettings `withDbModification` dbModification , _tr_amount = "amount" , _tr_block = BlockId "block" } + , _cddb_verifiers = modifyEntityName modTableName <> + modifyTableFields tableModification + { _verifier_requestkey = "requestkey" + , _verifier_idx = "idx" + , _verifier_name = "name" + , _verifier_proof = "proof" + , _verifier_caps = "caps" + } } withDb :: Env -> Pg b -> IO b diff --git a/haskell-src/lib/ChainwebDb/Types/Transaction.hs b/haskell-src/lib/ChainwebDb/Types/Transaction.hs index b80adac8..abce1f90 100644 --- a/haskell-src/lib/ChainwebDb/Types/Transaction.hs +++ b/haskell-src/lib/ChainwebDb/Types/Transaction.hs @@ -54,7 +54,6 @@ data TransactionT f = Transaction , _tx_continuation :: C f (Maybe (PgJSONB Value)) , _tx_txid :: C f (Maybe Int64) , _tx_numEvents :: C f (Maybe Int64) - , _tx_verifiers :: C f (Maybe (PgJSONB Value)) } deriving stock (Generic) deriving anyclass (Beamable) diff --git a/haskell-src/lib/ChainwebDb/Types/Verifier.hs b/haskell-src/lib/ChainwebDb/Types/Verifier.hs new file mode 100644 index 00000000..eeb4e84c --- /dev/null +++ b/haskell-src/lib/ChainwebDb/Types/Verifier.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module ChainwebDb.Types.Verifier where + +------------------------------------------------------------------------------ +import Data.Aeson +import Data.Int +import Data.Text (Text) +import Database.Beam +import Database.Beam.Backend.SQL.Row () +import Database.Beam.Backend.SQL.SQL92 () +import Database.Beam.Postgres +------------------------------------------------------------------------------ +import ChainwebDb.Types.DbHash +------------------------------------------------------------------------------ + + +data VerifierT f = Verifier + { _verifier_requestkey :: C f (DbHash TxHash) + , _verifier_idx :: C f Int32 + , _verifier_name :: C f (Maybe Text) + , _verifier_proof :: C f (Maybe Text) + , _verifier_caps :: C f (PgJSONB [Value]) + } + deriving stock (Generic) + deriving anyclass (Beamable) + +type Verifier = VerifierT Identity +type VerifierId = PrimaryKey VerifierT Identity + +instance Table VerifierT where + data PrimaryKey VerifierT f = VerifierT (C f (DbHash TxHash)) (C f Int32) + deriving stock (Generic) + deriving anyclass (Beamable) + primaryKey = VerifierT <$> _verifier_requestkey <*> _verifier_idx From 3ebe11046c0b72193a4741bb7959f6f63dcdc254 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Sat, 13 Apr 2024 01:45:09 -0400 Subject: [PATCH 3/9] write test to verify existence of verifiers This test should be pointing to rocks db that has payloads with verifiers within it. If a rocks db directory is not provided, the test doesn't run at all. --- cabal.project | 15 +++++++ haskell-src/chainweb-data.cabal | 5 +++ .../test/Chainweb/Data/Test/Verifier.hs | 42 +++++++++++++++++++ 3 files changed, 62 insertions(+) create mode 100644 haskell-src/test/Chainweb/Data/Test/Verifier.hs diff --git a/cabal.project b/cabal.project index a228ff1c..2086bb87 100644 --- a/cabal.project +++ b/cabal.project @@ -4,6 +4,9 @@ with-compiler: ghc-9.2.8 package aeson flags: +cffi +package rocksdb-haskell-kadena + ghc-options: -Wwarn -optc-w -optcxx-w + source-repository-package type: git location: https://github.com/kadena-io/pact.git @@ -16,12 +19,24 @@ source-repository-package tag: eb57e84608fe91d171065c26a7877a01da952f75 --sha256: sha256-Y9ZM7PNNkmi9ps3uf6Cva5h3n12qfmYqLca2w4wRkJw= +source-repository-package + type: git + location: https://github.com/kadena-io/chainweb-storage.git + tag: 4b45c1ab9c070c6d16a058bcbab0c06ac0fb6d4e + --sha256: 0m6c7kl6x5a3k02q2i7qzfx91kxz19dzav0piqfxra52bq0x3sm6 + source-repository-package type: git location: https://github.com/kadena-io/pact-json tag: e43073d0b8d89d9b300980913b842f4be339846d --sha256: sha256-ZWbAId0JBaxDsYhwcYUyw04sjYstXyosSCenzOvUxsQ= +source-repository-package + type: git + location: https://github.com/kadena-io/rocksdb-haskell.git + tag: 1a82da5660a4cc2681eb90da6505b6897d1b12e9 + --sha256: 020n6knl8psh5y9766amrsh706ka83fz3vfm77lrzngg5mcz45qs + source-repository-package type: git location: https://github.com/kadena-io/thyme.git diff --git a/haskell-src/chainweb-data.cabal b/haskell-src/chainweb-data.cabal index c47dc396..02b08f9b 100644 --- a/haskell-src/chainweb-data.cabal +++ b/haskell-src/chainweb-data.cabal @@ -175,6 +175,7 @@ test-suite testsuite other-modules: Chainweb.Data.Test.Backfill Chainweb.Data.Test.Parser + Chainweb.Data.Test.Verifier build-depends: , aeson @@ -182,8 +183,12 @@ test-suite testsuite , bytestring , chainweb-api , chainweb-data + , chainweb-storage , containers >=0.6 + , directory , neat-interpolation >=0.5 + , tagged + , rocksdb-haskell-kadena , tasty >=1.2 , tasty-hunit >=0.10 , text diff --git a/haskell-src/test/Chainweb/Data/Test/Verifier.hs b/haskell-src/test/Chainweb/Data/Test/Verifier.hs new file mode 100644 index 00000000..284363cd --- /dev/null +++ b/haskell-src/test/Chainweb/Data/Test/Verifier.hs @@ -0,0 +1,42 @@ +{-# language RecordWildCards #-} +{-# language DerivingStrategies #-} +{-# language GeneralizedNewtypeDeriving #-} +module Chainweb.Data.Test.Verifier +( tests +) where + +import Control.Monad +import Data.Tagged (Tagged(..)) +import Data.Typeable (Typeable(..)) +import System.Directory + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Options + +import Database.RocksDB.Internal (Options'(..),mkOpts,freeOpts) +import Chainweb.Storage.Table.RocksDB + +tests :: TestTree +tests = askOption (testGroup "Verifier lookup test" . findVerifiers) + +newtype RocksDBDir = RocksDBDir (Maybe FilePath) + deriving newtype Show + deriving Typeable + +instance IsOption RocksDBDir where + defaultValue = RocksDBDir Nothing + parseValue = Just . RocksDBDir . Just + optionName = Tagged "rocks-db-dir" + optionHelp = Tagged "Location of rocks db directory" + +findVerifiers :: RocksDBDir -> [TestTree] +findVerifiers (RocksDBDir rocksDBDir) = testFromMaybe rocksDBDir $ \path -> + withResource (mkOpts modernDefaultOptions) freeOpts $ \opts' -> + withResource (open opts' path) closeRocksDb test + where + testFromMaybe m test = maybe [] (pure . test) m + open opts' path = do + Options'{..} <- opts' + openReadOnlyRocksDb path _optsPtr + test _iordb = undefined From f72507731455af85a9ca4f33c2d8002d018a94cf Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Thu, 25 Apr 2024 13:57:36 -0400 Subject: [PATCH 4/9] create verifiers test --- cabal.project | 4 +- haskell-src/chainweb-data.cabal | 8 +- .../test/Chainweb/Data/Test/Verifier.hs | 88 +++++++++++++------ haskell-src/test/Main.hs | 6 ++ .../test/command-text-with-verifier.txt | 2 + haskell-src/test/test-verifier.txt | 2 + 6 files changed, 77 insertions(+), 33 deletions(-) create mode 100644 haskell-src/test/command-text-with-verifier.txt create mode 100644 haskell-src/test/test-verifier.txt diff --git a/cabal.project b/cabal.project index 2086bb87..afc1041d 100644 --- a/cabal.project +++ b/cabal.project @@ -16,8 +16,8 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/chainweb-api.git - tag: eb57e84608fe91d171065c26a7877a01da952f75 - --sha256: sha256-Y9ZM7PNNkmi9ps3uf6Cva5h3n12qfmYqLca2w4wRkJw= + tag: fc84dcef8197bcfb5415c855421bb1921a749c9f + --sha256: sha256-2qpkAlpJ9qtfsD1WHuW5IYXWHoVXBxRYs5Pd9GOOXz8= source-repository-package type: git diff --git a/haskell-src/chainweb-data.cabal b/haskell-src/chainweb-data.cabal index 02b08f9b..7b8b07d2 100644 --- a/haskell-src/chainweb-data.cabal +++ b/haskell-src/chainweb-data.cabal @@ -175,6 +175,7 @@ test-suite testsuite other-modules: Chainweb.Data.Test.Backfill Chainweb.Data.Test.Parser + -- Chainweb.Data.Test.Utils Chainweb.Data.Test.Verifier build-depends: @@ -186,9 +187,12 @@ test-suite testsuite , chainweb-storage , containers >=0.6 , directory + , lens + , lens-aeson , neat-interpolation >=0.5 - , tagged - , rocksdb-haskell-kadena + , optparse-applicative >=0.14 && <0.17 + -- , rocksdb-haskell-kadena + -- , tagged , tasty >=1.2 , tasty-hunit >=0.10 , text diff --git a/haskell-src/test/Chainweb/Data/Test/Verifier.hs b/haskell-src/test/Chainweb/Data/Test/Verifier.hs index 284363cd..df7833b9 100644 --- a/haskell-src/test/Chainweb/Data/Test/Verifier.hs +++ b/haskell-src/test/Chainweb/Data/Test/Verifier.hs @@ -1,42 +1,72 @@ +{-# language LambdaCase #-} +{-# language OverloadedStrings #-} {-# language RecordWildCards #-} -{-# language DerivingStrategies #-} -{-# language GeneralizedNewtypeDeriving #-} +{-# language TypeApplications #-} module Chainweb.Data.Test.Verifier ( tests ) where +import Control.Exception +import Control.Lens import Control.Monad -import Data.Tagged (Tagged(..)) -import Data.Typeable (Typeable(..)) +import qualified Data.Aeson as A +import Data.Aeson.KeyMap (fromList) +import Data.Aeson.Lens +import qualified Data.ByteString.Lazy as BL import System.Directory +import Options.Applicative + +import Chainweb.Api.Verifier +-- import Chainweb.Data.Test.Utils + import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Options - -import Database.RocksDB.Internal (Options'(..),mkOpts,freeOpts) -import Chainweb.Storage.Table.RocksDB tests :: TestTree -tests = askOption (testGroup "Verifier lookup test" . findVerifiers) - -newtype RocksDBDir = RocksDBDir (Maybe FilePath) - deriving newtype Show - deriving Typeable - -instance IsOption RocksDBDir where - defaultValue = RocksDBDir Nothing - parseValue = Just . RocksDBDir . Just - optionName = Tagged "rocks-db-dir" - optionHelp = Tagged "Location of rocks db directory" - -findVerifiers :: RocksDBDir -> [TestTree] -findVerifiers (RocksDBDir rocksDBDir) = testFromMaybe rocksDBDir $ \path -> - withResource (mkOpts modernDefaultOptions) freeOpts $ \opts' -> - withResource (open opts' path) closeRocksDb test +tests = + testGroup "Verifier plugin tests" + [parseVerifier + , parseVerifierFromCommandText ] + + +parseVerifier :: TestTree +parseVerifier = testCase "verifier decoding test" $ do + rawFile <- BL.readFile "haskell-src/test/test-verifier.txt" + either (throwIO . userError) (expectedValue @=?) $ A.eitherDecode @Verifier rawFile where - testFromMaybe m test = maybe [] (pure . test) m - open opts' path = do - Options'{..} <- opts' - openReadOnlyRocksDb path _optsPtr - test _iordb = undefined + expectedValue = + Verifier + {_verifier_name = Just "allow" + , _verifier_proof = A.Object (fromList [("keysetref",A.Object (fromList [("ksn",A.String "\120167\&4hy3@un~\185384tYM|y_"),("ns",A.String "?k%B\96883\153643\38839\68129P\139946=\97190$Wk\95172es8QQVIu\197146ypX")]))]) + , _verifier_capList = [] + } + +parseVerifierFromCommandText :: TestTree +parseVerifierFromCommandText = testCase "Command Text verifier decoding test" $ do + rawFile <- BL.readFile "haskell-src/test/command-text-with-verifier.txt" + either (throwIO . userError) (expectedValue @=?) $ + A.eitherDecode @A.Value rawFile >>= \r -> + r ^? key "cmd" . _String . key "verifiers" . _JSON + & note verifyMsg + where + verifyMsg = "Can't find expected verifiers key command text" + note msg = maybe (Left msg) Right + expectedValue = + [Verifier + {_verifier_name = Just "allow" + , _verifier_proof = A.String "emmanuel" + , _verifier_capList = [] + }] + +-- TODO: Maybe come back to this later +-- findVerifiers :: FilePath -> TestTree +-- findVerifiers path = +-- withResource (mkOpts modernDefaultOptions) freeOpts $ \opts' -> +-- withResource (open opts' path) closeRocksDb test +-- where +-- open opts' path = do +-- Options'{..} <- opts' +-- openReadOnlyRocksDb path _optsPtr +-- test _iordb = testCase "inner" $ assertEqual "testing" 1 1 + diff --git a/haskell-src/test/Main.hs b/haskell-src/test/Main.hs index 557fccf5..b8bf5137 100644 --- a/haskell-src/test/Main.hs +++ b/haskell-src/test/Main.hs @@ -5,12 +5,18 @@ module Main import Chainweb.Data.Test.Parser as Parser import Chainweb.Data.Test.Backfill as Backfill +import Chainweb.Data.Test.Verifier as Verifier +-- import Chainweb.Data.Test.Utils import Test.Tasty +import Test.Tasty.Options +import Data.Proxy +import Debug.Trace main :: IO () main = defaultMain $ testGroup "Chainweb Data Test suite" [ Parser.tests , Backfill.tests + , Verifier.tests ] diff --git a/haskell-src/test/command-text-with-verifier.txt b/haskell-src/test/command-text-with-verifier.txt new file mode 100644 index 00000000..2c1888bd --- /dev/null +++ b/haskell-src/test/command-text-with-verifier.txt @@ -0,0 +1,2 @@ +{"hash":"bq-o2qG2gF50itBxmPltD9OCTV0wSnMTydUoEnH8LC0","sigs":[],"cmd":"{\"verifiers\":[{\"proof\":\"emmanuel\",\"name\":\"allow\",\"clist\":[]}],\"networkId\":null,\"payload\":{\"exec\":{\"data\":null,\"code\":\"(+ 1 1)\"}},\"signers\":[],\"meta\":{\"creationTime\":0,\"ttl\":28800,\"gasLimit\":1000,\"chainId\":\"0\",\"gasPrice\":1.0e-7,\"sender\":\"sender00\"},\"nonce\":\"2024-04-17 07:49:29.788988 UTC\"}"} + diff --git a/haskell-src/test/test-verifier.txt b/haskell-src/test/test-verifier.txt new file mode 100644 index 00000000..21db2856 --- /dev/null +++ b/haskell-src/test/test-verifier.txt @@ -0,0 +1,2 @@ +{"name":"allow","proof":{"keysetref":{"ns":"?k%B𗩳𥠫鞷𐨡P𢊪=𗮦$Wk𗏄es8QQVIu𰈚ypX","ksn":"𝕧4hy3@un~𭐨tYM|y_"}},"clist":[]} + From f699c333f9a7867cee35e0109706758be1a0bd51 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Thu, 25 Apr 2024 15:39:45 -0400 Subject: [PATCH 5/9] correctly get verifiers from block payload --- haskell-src/exec/Chainweb/Lookups.hs | 20 ++++++++----------- haskell-src/exec/Chainweb/Server.hs | 5 ++++- .../test/Chainweb/Data/Test/Verifier.hs | 20 ++++++++++++++++++- 3 files changed, 31 insertions(+), 14 deletions(-) diff --git a/haskell-src/exec/Chainweb/Lookups.hs b/haskell-src/exec/Chainweb/Lookups.hs index 30a671fb..d8e10bf8 100644 --- a/haskell-src/exec/Chainweb/Lookups.hs +++ b/haskell-src/exec/Chainweb/Lookups.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeApplications #-} @@ -61,9 +62,7 @@ import Data.Aeson.Lens import Data.Aeson.Types import Data.ByteString.Lazy (ByteString,toStrict) import Data.Foldable -import Data.Functor.Compose (Compose(..)) import Data.Int -import Data.List (zipWith4) import Data.Maybe import Data.String (fromString) import qualified Data.Text as T @@ -284,20 +283,17 @@ mkTransactionSigners t = zipWith3 mkSigner signers sigs [0..] (Signature $ unSig sig) mkTransactionVerifiers :: CW.Transaction -> [Verifier] -mkTransactionVerifiers t = zipWith4 mkVerifier [0..] names proofs capLists +mkTransactionVerifiers t = maybe [] (zipWith mkVerifier [0..]) verifiers where - verifiers :: Compose Maybe [] CW.Verifier - verifiers = Compose $ t ^? to CW._transaction_cmdStr . key "verifiers" . _JSON - names = toList $ CW._verifier_name <$> verifiers - proofs = toList $ CW._verifier_proof <$> verifiers - capLists = toList $ CW._verifier_capList <$> verifiers + verifiers :: Maybe [CW.Verifier] + verifiers = _pactCommand_verifiers $ CW._transaction_cmd t requestkey = CW._transaction_hash t - mkVerifier idx name proof capList = Verifier + mkVerifier idx verifier = Verifier { _verifier_requestkey = DbHash $ hashB64U requestkey , _verifier_idx = idx - , _verifier_name = name - , _verifier_proof = proof - , _verifier_caps = PgJSONB $ map toJSON capList + , _verifier_name = CW._verifier_name verifier + , _verifier_proof = (CW._verifier_proof verifier) ^? _String + , _verifier_caps = PgJSONB $ map toJSON $ CW._verifier_capList verifier } mkCoinbaseEvents :: Int64 -> ChainId -> DbHash BlockHash -> BlockPayloadWithOutputs -> [Event] diff --git a/haskell-src/exec/Chainweb/Server.hs b/haskell-src/exec/Chainweb/Server.hs index 935cc008..40c5fe1f 100644 --- a/haskell-src/exec/Chainweb/Server.hs +++ b/haskell-src/exec/Chainweb/Server.hs @@ -448,9 +448,12 @@ queryTxsByKey logger rk c = caps <- forM (unPgJsonb $ _verifier_caps v) $ \capsJson -> case fromJSON capsJson of A.Success a -> return a A.Error e -> liftIO $ throwIO $ userError $ "Failed to parse signer capabilities: " <> e + proof <- case _verifier_proof v of + Just s -> return $ A.String s + Nothing -> liftIO $ throwIO $ userError $ "Verifier proof doesn't exist?" return $ Api.Verifier { Api._verifier_name = _verifier_name v - , Api._verifier_proof = _verifier_proof v + , Api._verifier_proof = proof , Api._verifier_capList = caps } diff --git a/haskell-src/test/Chainweb/Data/Test/Verifier.hs b/haskell-src/test/Chainweb/Data/Test/Verifier.hs index df7833b9..041f5ac1 100644 --- a/haskell-src/test/Chainweb/Data/Test/Verifier.hs +++ b/haskell-src/test/Chainweb/Data/Test/Verifier.hs @@ -13,10 +13,13 @@ import qualified Data.Aeson as A import Data.Aeson.KeyMap (fromList) import Data.Aeson.Lens import qualified Data.ByteString.Lazy as BL +import Data.Maybe import System.Directory import Options.Applicative +import Chainweb.Api.PactCommand +import Chainweb.Api.Transaction import Chainweb.Api.Verifier -- import Chainweb.Data.Test.Utils @@ -27,7 +30,8 @@ tests :: TestTree tests = testGroup "Verifier plugin tests" [parseVerifier - , parseVerifierFromCommandText ] + , parseVerifierFromCommandTextCWApi + , parseVerifierFromCommandText] parseVerifier :: TestTree @@ -42,6 +46,20 @@ parseVerifier = testCase "verifier decoding test" $ do , _verifier_capList = [] } +parseVerifierFromCommandTextCWApi :: TestTree +parseVerifierFromCommandTextCWApi = testCase "Command Text verifier decoding test with CW-API" $ do + rawFile <- BL.readFile "haskell-src/test/command-text-with-verifier.txt" + either (throwIO . userError) (expectedValue @=?) $ + -- assume verifiers field is a Just value + fromJust . _pactCommand_verifiers . _transaction_cmd <$> A.eitherDecode @Transaction rawFile + where + expectedValue = + [Verifier + {_verifier_name = Just "allow" + , _verifier_proof = A.String "emmanuel" + , _verifier_capList = [] + }] + parseVerifierFromCommandText :: TestTree parseVerifierFromCommandText = testCase "Command Text verifier decoding test" $ do rawFile <- BL.readFile "haskell-src/test/command-text-with-verifier.txt" From 0261b18e13d74d81f3f5b11771492f5b45dca7e3 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Tue, 30 Apr 2024 10:54:45 -0400 Subject: [PATCH 6/9] get rid of rocksdb & chainweb-storage deps --- cabal.project | 12 ------------ haskell-src/chainweb-data.cabal | 4 ---- 2 files changed, 16 deletions(-) diff --git a/cabal.project b/cabal.project index afc1041d..c49cfa34 100644 --- a/cabal.project +++ b/cabal.project @@ -19,24 +19,12 @@ source-repository-package tag: fc84dcef8197bcfb5415c855421bb1921a749c9f --sha256: sha256-2qpkAlpJ9qtfsD1WHuW5IYXWHoVXBxRYs5Pd9GOOXz8= -source-repository-package - type: git - location: https://github.com/kadena-io/chainweb-storage.git - tag: 4b45c1ab9c070c6d16a058bcbab0c06ac0fb6d4e - --sha256: 0m6c7kl6x5a3k02q2i7qzfx91kxz19dzav0piqfxra52bq0x3sm6 - source-repository-package type: git location: https://github.com/kadena-io/pact-json tag: e43073d0b8d89d9b300980913b842f4be339846d --sha256: sha256-ZWbAId0JBaxDsYhwcYUyw04sjYstXyosSCenzOvUxsQ= -source-repository-package - type: git - location: https://github.com/kadena-io/rocksdb-haskell.git - tag: 1a82da5660a4cc2681eb90da6505b6897d1b12e9 - --sha256: 020n6knl8psh5y9766amrsh706ka83fz3vfm77lrzngg5mcz45qs - source-repository-package type: git location: https://github.com/kadena-io/thyme.git diff --git a/haskell-src/chainweb-data.cabal b/haskell-src/chainweb-data.cabal index 7b8b07d2..fe3cb110 100644 --- a/haskell-src/chainweb-data.cabal +++ b/haskell-src/chainweb-data.cabal @@ -175,7 +175,6 @@ test-suite testsuite other-modules: Chainweb.Data.Test.Backfill Chainweb.Data.Test.Parser - -- Chainweb.Data.Test.Utils Chainweb.Data.Test.Verifier build-depends: @@ -184,15 +183,12 @@ test-suite testsuite , bytestring , chainweb-api , chainweb-data - , chainweb-storage , containers >=0.6 , directory , lens , lens-aeson , neat-interpolation >=0.5 , optparse-applicative >=0.14 && <0.17 - -- , rocksdb-haskell-kadena - -- , tagged , tasty >=1.2 , tasty-hunit >=0.10 , text From fe24af88a78f01d15806ff9aa3461d24884b17bf Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Mon, 6 May 2024 10:58:44 -0400 Subject: [PATCH 7/9] fix verifier test --- .../test/Chainweb/Data/Test/Verifier.hs | 59 ++++++++++++------- 1 file changed, 38 insertions(+), 21 deletions(-) diff --git a/haskell-src/test/Chainweb/Data/Test/Verifier.hs b/haskell-src/test/Chainweb/Data/Test/Verifier.hs index 041f5ac1..777d6344 100644 --- a/haskell-src/test/Chainweb/Data/Test/Verifier.hs +++ b/haskell-src/test/Chainweb/Data/Test/Verifier.hs @@ -6,25 +6,27 @@ module Chainweb.Data.Test.Verifier ( tests ) where -import Control.Exception -import Control.Lens -import Control.Monad +import Control.Exception +import Control.Lens +import Control.Monad import qualified Data.Aeson as A import Data.Aeson.KeyMap (fromList) import Data.Aeson.Lens import qualified Data.ByteString.Lazy as BL import Data.Maybe -import System.Directory +import Data.List +import System.Directory +import Text.Printf -import Options.Applicative +import Options.Applicative -import Chainweb.Api.PactCommand -import Chainweb.Api.Transaction -import Chainweb.Api.Verifier +import Chainweb.Api.PactCommand +import Chainweb.Api.Transaction +import Chainweb.Api.Verifier -- import Chainweb.Data.Test.Utils -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit tests :: TestTree tests = @@ -36,8 +38,12 @@ tests = parseVerifier :: TestTree parseVerifier = testCase "verifier decoding test" $ do - rawFile <- BL.readFile "haskell-src/test/test-verifier.txt" - either (throwIO . userError) (expectedValue @=?) $ A.eitherDecode @Verifier rawFile + mfile <- findFile ["./haskell-src/test","./test"] "test-verifier.txt" + case mfile of + Just file -> do + rawFile <- BL.readFile file + either (throwIO . userError) (expectedValue @=?) $ A.eitherDecode @Verifier rawFile + Nothing -> assertFailure (failureMsg ["./haskell-src/test","./test"] "test-verifier.txt") where expectedValue = Verifier @@ -48,10 +54,14 @@ parseVerifier = testCase "verifier decoding test" $ do parseVerifierFromCommandTextCWApi :: TestTree parseVerifierFromCommandTextCWApi = testCase "Command Text verifier decoding test with CW-API" $ do - rawFile <- BL.readFile "haskell-src/test/command-text-with-verifier.txt" - either (throwIO . userError) (expectedValue @=?) $ - -- assume verifiers field is a Just value - fromJust . _pactCommand_verifiers . _transaction_cmd <$> A.eitherDecode @Transaction rawFile + mfile <- findFile ["./haskell-src/test","./test"] "command-text-with-verifier.txt" + case mfile of + Just file -> do + rawFile <- BL.readFile file + either (throwIO . userError) (expectedValue @=?) $ + -- assume verifiers field is a Just value + fromJust . _pactCommand_verifiers . _transaction_cmd <$> A.eitherDecode @Transaction rawFile + Nothing -> assertFailure (failureMsg ["./haskell-src/test","./test"] "command-text-with-verifier.txt") where expectedValue = [Verifier @@ -62,11 +72,15 @@ parseVerifierFromCommandTextCWApi = testCase "Command Text verifier decoding tes parseVerifierFromCommandText :: TestTree parseVerifierFromCommandText = testCase "Command Text verifier decoding test" $ do - rawFile <- BL.readFile "haskell-src/test/command-text-with-verifier.txt" - either (throwIO . userError) (expectedValue @=?) $ - A.eitherDecode @A.Value rawFile >>= \r -> - r ^? key "cmd" . _String . key "verifiers" . _JSON - & note verifyMsg + mfile <- findFile ["./haskell-src/test","./test"] "command-text-with-verifier.txt" + case mfile of + Just file -> do + rawFile <- BL.readFile file + either (throwIO . userError) (expectedValue @=?) $ + A.eitherDecode @A.Value rawFile >>= \r -> + r ^? key "cmd" . _String . key "verifiers" . _JSON + & note verifyMsg + Nothing -> assertFailure (failureMsg ["./haskell-src/test","./test"] "command-text-with-verifier.txt") where verifyMsg = "Can't find expected verifiers key command text" note msg = maybe (Left msg) Right @@ -77,6 +91,9 @@ parseVerifierFromCommandText = testCase "Command Text verifier decoding test" $ , _verifier_capList = [] }] +failureMsg :: [FilePath] -> FilePath -> String +failureMsg dirs s = printf "This file %s was not found in either of these directories %s" s (intercalate "," dirs) + -- TODO: Maybe come back to this later -- findVerifiers :: FilePath -> TestTree -- findVerifiers path = From 57fc96a4b852e7024a57b978d00e943d1896c222 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Wed, 15 May 2024 19:57:07 -0400 Subject: [PATCH 8/9] add withVerifiersMinHeight --- haskell-src/lib/ChainwebData/Types.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/haskell-src/lib/ChainwebData/Types.hs b/haskell-src/lib/ChainwebData/Types.hs index 56178f00..e156b315 100644 --- a/haskell-src/lib/ChainwebData/Types.hs +++ b/haskell-src/lib/ChainwebData/Types.hs @@ -18,6 +18,7 @@ module ChainwebData.Types , rangeToDescGroupsOf , blockRequestSize , withEventsMinHeight + , withVerifiersMinHeight ) where import BasePrelude @@ -125,3 +126,17 @@ withEventsMinHeight version errorMessage action = withVersion version onVersion "recap-development" -> Just 14 "development" -> Just 0 _ -> Nothing + + +withVerifiersMinHeight :: Num a => MonadIO m => T.Text -> String -> (a -> m b) -> m b +withVerifiersMinHeight version errorMessage action = withVersion version onVersion $ \case + Just height -> action height + Nothing -> liftIO $ die errorMessage + where + -- Associate each version with the fork height for ChainwebPact223 + onVersion = \case + "mainnet01" -> Just 4_577_530 + "testnet04" -> Just 4_100_681 + "recap-development" -> Just 600 + "development" -> Just 0 + _ -> Nothing From ab98ccdf4c83f528d88f07c9aa64e398dfb83862 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Wed, 15 May 2024 20:17:10 -0400 Subject: [PATCH 9/9] make sure invalid verifiers (predicated on blockheight) are not written to db --- haskell-src/exec/Chainweb/Listen.hs | 13 +++-- haskell-src/exec/Chainweb/Lookups.hs | 6 ++- haskell-src/exec/Chainweb/Worker.hs | 71 ++++++++++++++++------------ 3 files changed, 52 insertions(+), 38 deletions(-) diff --git a/haskell-src/exec/Chainweb/Listen.hs b/haskell-src/exec/Chainweb/Listen.hs index 4a81bc60..19584be4 100644 --- a/haskell-src/exec/Chainweb/Listen.hs +++ b/haskell-src/exec/Chainweb/Listen.hs @@ -78,7 +78,7 @@ processNewHeader logTxSummaries env ph@(PowHeader h _) = do addendum = if S.null ts then "" else printf " with %d transactions" (S.length ts) when logTxSummaries $ do logg Debug $ fromString $ msg <> addendum - forM_ tos $ \txWithOutput -> + forM_ tos $ \txWithOutput -> logg Debug $ fromString $ show txWithOutput insertNewHeader (_nodeInfo_chainwebVer $ _env_nodeInfo env) (_env_dbConnPool env) ph pl @@ -89,12 +89,15 @@ insertNewHeader version pool ph pl = do !t = mkBlockTransactions b pl !es = mkBlockEvents (fromIntegral $ _blockHeader_height $ _hwp_header ph) (_blockHeader_chainId $ _hwp_header ph) (DbHash $ hashB64U $ _blockHeader_hash $ _hwp_header ph) pl !ss = concat $ map (mkTransactionSigners . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pl) - !vs = concat $ map (mkTransactionVerifiers . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pl) !k = bpwoMinerKeys pl - err = printf "insertNewHeader failed because we don't know how to work this version %s" version - withEventsMinHeight version err $ \minHeight -> do - let !tf = mkTransferRows (fromIntegral $ _blockHeader_height $ _hwp_header ph) (_blockHeader_chainId $ _hwp_header ph) (DbHash $ hashB64U $ _blockHeader_hash $ _hwp_header ph) (posixSecondsToUTCTime $ _blockHeader_creationTime $ _hwp_header ph) pl minHeight + eventErr = printf "insertNewHeader failed to insert event row because we don't know how to work this version %s" version + verifierErr = printf "insertNewHeader failed to insert verifier row because we don't know how to work this version %s" version + withEventsMinHeight version eventErr $ \eventMinHeight -> + withVerifiersMinHeight version verifierErr $ \verifierMinHeight -> do + let currentHeight = fromIntegral $ _blockHeader_height $ _hwp_header ph + let !tf = mkTransferRows currentHeight (_blockHeader_chainId $ _hwp_header ph) (DbHash $ hashB64U $ _blockHeader_hash $ _hwp_header ph) (posixSecondsToUTCTime $ _blockHeader_creationTime $ _hwp_header ph) pl eventMinHeight + let !vs = concat $ map (mkTransactionVerifiers currentHeight verifierMinHeight . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pl) writes pool b k t es ss tf vs mkRequest :: UrlScheme -> ChainwebVersion -> Request diff --git a/haskell-src/exec/Chainweb/Lookups.hs b/haskell-src/exec/Chainweb/Lookups.hs index d8e10bf8..af11513d 100644 --- a/haskell-src/exec/Chainweb/Lookups.hs +++ b/haskell-src/exec/Chainweb/Lookups.hs @@ -282,8 +282,10 @@ mkTransactionSigners t = zipWith3 mkSigner signers sigs [0..] (PgJSONB $ map toJSON $ CW._signer_capList signer) (Signature $ unSig sig) -mkTransactionVerifiers :: CW.Transaction -> [Verifier] -mkTransactionVerifiers t = maybe [] (zipWith mkVerifier [0..]) verifiers +mkTransactionVerifiers :: Int64 -> Int -> CW.Transaction -> [Verifier] +mkTransactionVerifiers height verifierMinHeight t + | height < fromIntegral verifierMinHeight = [] + | otherwise = maybe [] (zipWith mkVerifier [0..]) verifiers where verifiers :: Maybe [CW.Verifier] verifiers = _pactCommand_verifiers $ CW._transaction_cmd t diff --git a/haskell-src/exec/Chainweb/Worker.hs b/haskell-src/exec/Chainweb/Worker.hs index afee761b..fd84d330 100644 --- a/haskell-src/exec/Chainweb/Worker.hs +++ b/haskell-src/exec/Chainweb/Worker.hs @@ -148,10 +148,13 @@ writeBlock env pool count (bh, pwo) = do !ss = concat $ map (mkTransactionSigners . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pwo) version = _nodeInfo_chainwebVer $ _env_nodeInfo env !k = bpwoMinerKeys pwo - err = printf "writeBlock failed because we don't know how to work this version %s" version - withEventsMinHeight version err $ \evMinHeight -> do - let !tf = mkTransferRows (fromIntegral $ _blockHeader_height bh) (_blockHeader_chainId bh) (DbHash $ hashB64U $ _blockHeader_hash bh) (posixSecondsToUTCTime $ _blockHeader_creationTime bh) pwo evMinHeight - let !vs = concat $ map (mkTransactionVerifiers . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pwo) + eventErr = printf "writeBlock failed to write event and transfer rows because we don't know how to work this version %s" version + verifierErr = printf "writeBlock failed to write verifier row because we don't know how to work this version %s" version + withEventsMinHeight version eventErr $ \evMinHeight -> + withVerifiersMinHeight version verifierErr $ \verifierMinHeight -> do + let currentHeight = fromIntegral $ _blockHeader_height bh + !tf = mkTransferRows currentHeight (_blockHeader_chainId bh) (DbHash $ hashB64U $ _blockHeader_hash bh) (posixSecondsToUTCTime $ _blockHeader_creationTime bh) pwo evMinHeight + let !vs = concat $ map (mkTransactionVerifiers currentHeight verifierMinHeight . fst) (_blockPayloadWithOutputs_transactionsWithOutputs pwo) atomicModifyIORef' count (\n -> (n+1, ())) writes pool b k t es ss tf vs @@ -171,10 +174,14 @@ writeBlocks env pool count blocks = do (makeBlockMap bhs') !sss = M.intersectionWith (\pl _ -> concat $ mkTransactionSigners . fst <$> _blockPayloadWithOutputs_transactionsWithOutputs pl) pls (makeBlockMap bhs') !kss = M.intersectionWith (\p _ -> bpwoMinerKeys p) pls (makeBlockMap bhs') - !vss = M.intersectionWith (\pl _ -> concat $ mkTransactionVerifiers . fst <$> _blockPayloadWithOutputs_transactionsWithOutputs pl) pls (makeBlockMap bhs') - err = printf "writeBlocks failed because we don't know how to work this version %s" version - withEventsMinHeight version err $ \evMinHeight -> do - let !tfs = M.intersectionWith (\pl bh -> mkTransferRows (fromIntegral $ _blockHeader_height bh) (_blockHeader_chainId bh) (DbHash $ hashB64U $ _blockHeader_hash bh) (posixSecondsToUTCTime $ _blockHeader_creationTime bh) pl evMinHeight) pls (makeBlockMap bhs') + eventErr = printf "writeBlocks failed to write event and transfer rows because we don't know how to work this version %s" version + verifierErr = printf "writeBlocks failed to write verifier row because we don't know how to work this version %s" version + withEventsMinHeight version eventErr $ \evMinHeight -> + withVerifiersMinHeight version verifierErr $ \verifierMinHeight -> do + let currentHeight bh = fromIntegral $ _blockHeader_height bh + !tfs = M.intersectionWith (\pl bh -> mkTransferRows (currentHeight bh) (_blockHeader_chainId bh) (DbHash $ hashB64U $ _blockHeader_hash bh) (posixSecondsToUTCTime $ _blockHeader_creationTime bh) pl evMinHeight) pls (makeBlockMap bhs') + !vss = M.intersectionWith (\pl bh -> concat $ mkTransactionVerifiers (currentHeight bh) verifierMinHeight . fst <$> _blockPayloadWithOutputs_transactionsWithOutputs pl) pls (makeBlockMap bhs') + batchWrites pool (M.elems bs) (M.elems kss) (M.elems tss) (M.elems ess) (M.elems sss) (M.elems tfs) (M.elems vss) atomicModifyIORef' count (\n -> (n + numWrites, ())) where @@ -198,26 +205,28 @@ writePayload -> IO () writePayload pool chain blockHash blockHeight version creationTime bpwo = do let (cbEvents, txEvents) = mkBlockEvents' blockHeight chain blockHash bpwo - err = printf "writePayload failed because we don't know how to work this version %s" version - withEventsMinHeight version err $ \evMinHeight -> do - let !tfs = mkTransferRows blockHeight chain blockHash creationTime bpwo evMinHeight - !vss = concat $ map (mkTransactionVerifiers . fst) $ _blockPayloadWithOutputs_transactionsWithOutputs bpwo - P.withResource pool $ \c -> - withTransaction c $ do - runBeamPostgres c $ do - runInsert - $ insert (_cddb_events database) (insertValues $ cbEvents ++ concatMap snd txEvents) - $ onConflict (conflictingFields primaryKey) onConflictDoNothing - runInsert - $ insert (_cddb_transfers database) (insertValues tfs) - $ onConflict (conflictingFields primaryKey) onConflictDoNothing - -- TODO: This might be necessary. Will need to think about this further - runInsert - $ insert (_cddb_verifiers database) (insertValues vss) - $ onConflict (conflictingFields primaryKey) onConflictDoNothing - withSavepoint c $ runBeamPostgres c $ - forM_ txEvents $ \(reqKey, events) -> - runUpdate - $ update (_cddb_transactions database) - (\tx -> _tx_numEvents tx <-. val_ (Just $ fromIntegral $ length events)) - (\tx -> _tx_requestKey tx ==. val_ reqKey) + eventErr = printf "writePayload failed to insert event and transfer rows because we don't know how to work this version %s" version + verifierErr = printf "writePayload failed to insert verifier row because we don't know how to work this version %s" version + withEventsMinHeight version eventErr $ \evMinHeight -> + withVerifiersMinHeight version verifierErr $ \verifierMinHeight -> do + let !tfs = mkTransferRows blockHeight chain blockHash creationTime bpwo evMinHeight + let !vss = concat $ map (mkTransactionVerifiers blockHeight verifierMinHeight . fst) $ _blockPayloadWithOutputs_transactionsWithOutputs bpwo + P.withResource pool $ \c -> + withTransaction c $ do + runBeamPostgres c $ do + runInsert + $ insert (_cddb_events database) (insertValues $ cbEvents ++ concatMap snd txEvents) + $ onConflict (conflictingFields primaryKey) onConflictDoNothing + runInsert + $ insert (_cddb_transfers database) (insertValues tfs) + $ onConflict (conflictingFields primaryKey) onConflictDoNothing + -- TODO: This might be necessary. Will need to think about this further + runInsert + $ insert (_cddb_verifiers database) (insertValues vss) + $ onConflict (conflictingFields primaryKey) onConflictDoNothing + withSavepoint c $ runBeamPostgres c $ + forM_ txEvents $ \(reqKey, events) -> + runUpdate + $ update (_cddb_transactions database) + (\tx -> _tx_numEvents tx <-. val_ (Just $ fromIntegral $ length events)) + (\tx -> _tx_requestKey tx ==. val_ reqKey)