Add Verifiers to cw-data

cabal.project

@@ -5,15 +5,16 @@ index-state: 2024-02-01T00:00:00Z
 source-repository-package
     type: git
     location: https://github.com/kadena-io/chainweb-api.git
-    tag: 1b2de025cfdc09698bfb1ec3807cd85405d6a339
-    --sha256: sha256-06jvD1kmkmthcRkyWhVLTbytwabghInxqXQD/Lm7kbA=
+    tag: fc84dcef8197bcfb5415c855421bb1921a749c9f
+    --sha256: sha256-2qpkAlpJ9qtfsD1WHuW5IYXWHoVXBxRYs5Pd9GOOXz8=
 
 package vault
     documentation: false
 
 write-ghc-environment-files: never
 
 constraints: http2 <4.2
+constraints: configuration-tools >= 0.7.0
 
 allow-newer: beam-migrate:pqueue
 allow-newer: beam-migrate:aeson

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
@@ -87,7 +88,7 @@ library
     , servant-client
     , servant-openapi3
     , vector
-    , yet-another-logger
+    , yet-another-logger >= 0.4.2
 
   if flag(ghc-flags)
     build-tool-depends: hsinspect:hsinspect -any
@@ -151,7 +152,7 @@ executable chainweb-data
     , warp
     , warp-tls
     , witherable
-    , yet-another-logger
+    , yet-another-logger >= 0.4.2
 
   other-modules:
     Chainweb.Backfill
@@ -174,6 +175,7 @@ test-suite testsuite
   other-modules:
     Chainweb.Data.Test.Backfill
     Chainweb.Data.Test.Parser
+    Chainweb.Data.Test.Verifier
 
   build-depends:
     , aeson
@@ -182,7 +184,11 @@ test-suite testsuite
     , chainweb-api
     , chainweb-data
     , containers          >=0.6
+    , directory
+    , lens
+    , lens-aeson
     , neat-interpolation  >=0.5
+    , optparse-applicative     >=0.14
     , tasty               >=1.2
     , tasty-hunit         >=0.10
     , text

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
 
@@ -91,10 +91,14 @@ insertNewHeader version pool ph pl = do
       !ss = concat $ map (mkTransactionSigners . 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
+      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
 mkRequest us (ChainwebVersion cv) = defaultRequest

haskell-src/exec/Chainweb/Lookups.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeApplications #-}
@@ -20,6 +21,7 @@ module Chainweb.Lookups
   , mkBlockEventsWithCreationTime
   , mkCoinbaseEvents
   , mkTransactionSigners
+  , mkTransactionVerifiers
   , mkTransferRows
   , bpwoMinerKeys
 
@@ -38,6 +40,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 +52,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
@@ -278,6 +282,22 @@ mkTransactionSigners t = zipWith3 mkSigner signers sigs [0..]
       (PgJSONB $ map toJSON $ CW._signer_capList signer)
       (Signature $ unSig sig)
 
+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
+    requestkey = CW._transaction_hash t
+    mkVerifier idx verifier = Verifier
+      { _verifier_requestkey = DbHash $ hashB64U requestkey
+      , _verifier_idx = idx
+      , _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]
 mkCoinbaseEvents height cid blockhash pl = _blockPayloadWithOutputs_coinbase pl
     & coinbaseTO

haskell-src/exec/Chainweb/Server.hs

@@ -63,6 +63,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
@@ -84,6 +85,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
 ------------------------------------------------------------------------------
@@ -354,8 +356,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
@@ -387,6 +390,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 = verifiers
         }
   where
     unMaybeValue = maybe Null unPgJsonb
@@ -436,9 +440,27 @@ 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
+      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 = proof
+        , 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 =

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)
@@ -139,11 +148,16 @@ 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
+      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
+      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 +174,15 @@ 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')
-        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)
+        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
 
@@ -186,21 +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
-      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
-          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)

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)