Include verifiers table

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

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

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

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

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 =

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

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)

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

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)

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