Cleaned up TxBuilder service

Author: bladyjoker

coop-pab/app/Coop/Cli/TxBuilderGrpc.hs

@@ -33,7 +33,7 @@ import Data.Text qualified as Text
 import GHC.Exts (fromString)
 import Ledger (PaymentPubKeyHash (PaymentPubKeyHash), TxId)
 import Proto.Plutus_Fields (cborBase16)
-import Proto.TxBuilderService_Fields (alreadyPublished, gcFsTx, info, mintFsSuccess, mintFsTx, msg, otherErr, submitter, success)
+import Proto.TxBuilderService_Fields (gcFsTx, info, mintFsTx, msg, otherErr, submitter, success)
 import Proto.TxBuilderService_Fields qualified as Proto.TxBuilderService
 import System.Directory (doesFileExist, makeAbsolute)
 import System.FilePath ((</>))
@@ -79,11 +79,12 @@ txBuilderService opts = do
             (runMintFsTxOnReq req)
         either
           (\err -> return $ defMessage & Proto.TxBuilderService.error . otherErr . msg .~ err)
-          ( \(mayTxId, alreadyPublished') -> do
+          ( \(mayTxId, info') -> do
               maybe
                 ( return $
                     defMessage
-                      & mintFsSuccess . alreadyPublished .~ alreadyPublished'
+                      & Proto.TxBuilderService.error . otherErr . msg .~ "Failed creating mint-fact-statement-tx"
+                      & info .~ info'
                 )
                 ( \txId -> do
                     mayRawTx <- readSignedTx pabConf txId
@@ -92,12 +93,13 @@ txBuilderService opts = do
                           return $
                             defMessage
                               & Proto.TxBuilderService.error . otherErr . msg .~ ("Failed creating mint-fact-statement-tx: " <> err)
+                              & info .~ info'
                       )
                       ( \rawTx ->
                           return $
                             defMessage
-                              & mintFsSuccess . alreadyPublished .~ alreadyPublished'
-                              & mintFsSuccess . mintFsTx . cborBase16 .~ rawTx
+                              & success . mintFsTx . cborBase16 .~ rawTx
+                              & info .~ info'
                       )
                       mayRawTx
                 )

coop-pab/coop-pab.cabal

@@ -113,7 +113,6 @@ library
     , plutus-tx
     , process
     , proto-lens
-    , safe
     , stm
     , text
     , uuid

coop-pab/src/Coop/Pab.hs

@@ -31,6 +31,7 @@ import Data.Map qualified as Map
 import Data.Maybe (catMaybes)
 import Data.ProtoLens (Message (defMessage))
 import Data.Text (Text)
+import Data.Text qualified as Text
 import Data.Traversable (for)
 import Data.Void (Void)
 import Ledger (Language (PlutusV2), POSIXTime (POSIXTime), PaymentPubKeyHash (PaymentPubKeyHash, unPaymentPubKeyHash), TxId, TxOutRef, Versioned (Versioned), after, applyArguments, ciTxOutValue, interval)
@@ -53,17 +54,16 @@ import Plutus.V2.Ledger.Api (
   MintingPolicy (MintingPolicy),
   POSIXTimeRange,
   TokenName (TokenName),
-  UpperBound (UpperBound),
+  UpperBound,
   Validator (Validator),
   Value,
   toBuiltin,
   toData,
  )
 import PlutusTx (toBuiltinData)
 import PlutusTx.Prelude (Group (inv), fromBuiltin)
-import Proto.TxBuilderService (CreateGcFsTxReq, CreateMintFsTxReq, GcFsInfo, MintFsSuccess'FsIdAndTxOutRef)
-import Proto.TxBuilderService_Fields (factStatementId, factStatementUtxo, factStatements, fs, fsId, fsIds, gcAfter, notFoundFsIds, obsoleteFsIds, submitter, validFsIds)
-import Safe.Foldable (maximumMay)
+import Proto.TxBuilderService (CreateGcFsTxReq, CreateMintFsTxReq, GcFsInfo, MintFsInfo)
+import Proto.TxBuilderService_Fields (alreadyPublished, factStatements, fs, fsId, fsIds, fsUtxo, gcAfter, notFoundFsIds, obsoleteFsIds, publishedFsIds, submitter, validFsIds)
 import Test.Plutip.Internal.BotPlutusInterface.Setup ()
 import Test.Plutip.Internal.LocalCluster ()
 import Text.Printf (printf)
@@ -451,16 +451,16 @@ findOnchainState coopDeployment authenticators =
 toCardanoC :: ProtoCardano (Either Text) proto cardano => proto -> Contract w s Text cardano
 toCardanoC proto = let x = toCardano @(Either Text) proto in either throwError return x
 
-mkPublishingSpec :: CoopDeployment -> [PaymentPubKeyHash] -> CreateMintFsTxReq -> Contract w s Text (Maybe PublishingSpec, [MintFsSuccess'FsIdAndTxOutRef])
+mkPublishingSpec :: CoopDeployment -> [PaymentPubKeyHash] -> CreateMintFsTxReq -> Contract w s Text (Maybe PublishingSpec, MintFsInfo)
 mkPublishingSpec coopDeployment authenticators req = do
   when (null $ req ^. factStatements) (throwError "Must have at least one Fact Statement to process")
 
   CoopOnchainState authBatches published <- findOnchainState coopDeployment authenticators
   submitterPPkh <- PaymentPubKeyHash <$> toCardanoC (req ^. submitter)
   let alreadyPublished' =
         [ defMessage
-          & factStatementId .~ fsInfo ^. fsId
-          & factStatementUtxo .~ fsOref'
+          & fsId .~ fsInfo ^. fsId
+          & fsUtxo .~ fsOref'
         | fsInfo <- req ^. factStatements
         , fsOref <- maybe [] return $ Map.lookup (LedgerBytes . toBuiltin $ fsInfo ^. fsId) published
         , fsOref' <- fromCardano fsOref
@@ -470,24 +470,26 @@ mkPublishingSpec coopDeployment authenticators req = do
         | fsInfo <- req ^. factStatements
         , not $ Map.member (LedgerBytes . toBuiltin $ fsInfo ^. fsId) published
         ]
+      fsIdsToPublish = (^. fsId) <$> fsInfosToPublish
+      info :: MintFsInfo =
+        defMessage
+          & alreadyPublished .~ alreadyPublished'
+          & publishedFsIds .~ fsIdsToPublish
 
   if null fsInfosToPublish
     then
       ( do
           logInfo @String "Nothing new to publish"
-          return (Nothing, alreadyPublished')
+          return (Nothing, info)
       )
     else do
       let stillValidAuthPairs' = stillValidAuthPairs authBatches
           authInfos = take (length fsInfosToPublish) stillValidAuthPairs'
+          howManyValidAuthOuts = length stillValidAuthPairs'
 
-      when (length fsInfosToPublish > length stillValidAuthPairs') $ throwError "Must have enough valid authentication pairs (cert+auth) to authenticate Fact Statements"
-
-      txValidUntil <-
-        maybe
-          (throwError "Must have sufficient $AUTH inputs")
-          return
-          (maximumMay $ (\(_, _, _, UpperBound ext _) -> ext) <$> authInfos)
+      when (length fsInfosToPublish > howManyValidAuthOuts) $
+        throwError $
+          "Must have enough valid Authenticator UTxOs holding valid $AUTH tokens, wanted" <> (Text.pack . show . length $ fsInfosToPublish) <> " , got " <> (Text.pack . show $ howManyValidAuthOuts)
 
       fsDatums <-
         for
@@ -507,9 +509,7 @@ mkPublishingSpec coopDeployment authenticators req = do
               )
               authInfos
               fsDatums
-      if length fsInfosWithAuth /= length fsInfosToPublish
-        then throwError "Must have enough $AUTH outputs to authenticate each Fact Statement"
-        else return (Just $ PublishingSpec submitterPPkh fsInfosWithAuth txValidUntil, alreadyPublished')
+      return (Just $ PublishingSpec submitterPPkh fsInfosWithAuth, info)
   where
     stillValidAuthPairs :: Map LedgerBytes CoopAuthBatch -> [(CoopAuthBatch, (TxOutRef, ChainIndexTxOut), PaymentPubKeyHash, UpperBound POSIXTime)]
     stillValidAuthPairs authBatches = do
@@ -519,11 +519,11 @@ mkPublishingSpec coopDeployment authenticators req = do
       authOut <- Map.toList authOuts
       return (batch, authOut, authWallet, ivTo . cert'validity . auth'certDatum $ batch)
 
-runMintFsTx :: CoopDeployment -> [PaymentPubKeyHash] -> (Value, PaymentPubKeyHash) -> (Bool, Integer) -> CreateMintFsTxReq -> Contract w s Text (Maybe TxId, [MintFsSuccess'FsIdAndTxOutRef])
+runMintFsTx :: CoopDeployment -> [PaymentPubKeyHash] -> (Value, PaymentPubKeyHash) -> (Bool, Integer) -> CreateMintFsTxReq -> Contract w s Text (Maybe TxId, MintFsInfo)
 runMintFsTx coopDeployment authenticators feeSpec (submit, minutes) req = do
-  (mayPublishingSpec, alreadyPublished') <- mkPublishingSpec coopDeployment authenticators req
+  (mayPublishingSpec, info) <- mkPublishingSpec coopDeployment authenticators req
   maybe
-    (return (Nothing, alreadyPublished'))
+    (return (Nothing, info))
     ( \publishingSpec -> do
         (now, _) <- currentNodeClientTimeRange
         let mintFsTrx =
@@ -537,14 +537,13 @@ runMintFsTx coopDeployment authenticators feeSpec (submit, minutes) req = do
           if submit
             then submitTrx @Void mintFsTrx
             else submitTrx' @Void mintFsTrx
-        return (Just txId, alreadyPublished')
+        return (Just txId, info)
     )
     mayPublishingSpec
 
 data PublishingSpec = PublishingSpec
   { ps'submitter :: PaymentPubKeyHash
   , ps'factStatementSpecs :: [FactStatementSpec]
-  , _ps'validUntil :: Extended POSIXTime
   }
 
 data FactStatementSpec = FactStatementSpec

coop-proto/tx-builder-service.proto

@@ -32,22 +32,18 @@ message CreateMintFsTxResp {
 message MintFsSuccess {
   // Fact Statement Minting transaction (abbr. mint-fact-statement-tx) signed by Authenticators
   plutus.Transaction mint_fs_tx = 1;
-  // A list of already published Fact Statements (Map FactStatementId TxOutRef)
-  message FsIdAndTxOutRef {
-    bytes fact_statement_id = 1;
-    plutus.TxOutRef fact_statement_utxo = 2;
-  }
-  repeated FsIdAndTxOutRef already_published = 2;
 }
 
 // Information message associated with CreateMintFsTxResp
-message MintFsSuccess {
-  // A list of already published Fact Statements (Map FactStatementId TxOutRef)
+message MintFsInfo {
   message FsIdAndTxOutRef {
-    bytes fact_statement_id = 1;
-    plutus.TxOutRef fact_statement_utxo = 2;
+    bytes fs_id = 1;
+    plutus.TxOutRef fs_utxo = 2;
   }
+  // A list of already published Fact Statements (Map FactStatementId TxOutRef)
   repeated FsIdAndTxOutRef already_published = 1;
+  // Fact Statements ID that will be published with the mint-fact-statement-tx
+  repeated bytes published_fs_ids = 2;
 }
 
 message FactStatementInfo {