Implemented Publisher.createMintFsTx method

Author: bladyjoker

coop-extras/json-fact-statement-store/app/FactStatementStoreGrpc.hs

@@ -1,16 +1,19 @@
 {-# LANGUAGE BlockArguments #-}
+{-# OPTIONS_GHC -Wno-missing-import-lists #-}
 
 module FactStatementStoreGrpc (factStatementStoreService, FactStatementStoreGrpcOpts (FactStatementStoreGrpcOpts)) where
 
 import BeamConfig (FactStatementT (_factStatementId, _json), FsStore (fsTbl), fsStoreSettings)
 import Cardano.Proto.Aux ()
-import Control.Lens (makeLenses, (&), (.~), (^.), (^..))
+import Control.Lens (makeLenses, (&), (.~), (^.))
 import Data.Aeson (json)
 import Data.Aeson.Parser (decodeStrictWith)
 import Data.Functor.Identity (Identity)
 import Data.List (nub)
 import Data.ProtoLens (Message (defMessage))
 import Data.String (IsString (fromString))
+import Data.Text (Text)
+import Data.Text qualified as Text
 import Data.Traversable (for)
 import Database.Beam (SqlValable (val_), runSelectReturningOne)
 import Database.Beam.Query (SqlEq ((==.)), all_, filter_, select)
@@ -31,10 +34,9 @@ import Network.Wai.Handler.Warp qualified as Warp
 import Network.Wai.Handler.WarpTLS (tlsSettings)
 import PlutusJson (jsonToPlutusData)
 import PlutusTx (fromData)
-import Proto.Coop_Fields (value)
-import Proto.FactStatementStoreService (FactStatementStore, GetFactStatementRequest, GetFactStatementResponse, GetFactStatementResponse'FsIdAndPlutus)
-import Proto.FactStatementStoreService_Fields (fsId, fsIds, fsIdsWithPlutus, msg, plutusData)
-import Proto.FactStatementStoreService_Fields qualified as Proto
+import Proto.FactStatementStoreService (FactStatementStore, GetFactStatementRequest, GetFactStatementResponse, Success'FsIdAndPlutus)
+import Proto.FactStatementStoreService_Fields (error, fsId, fsIds, fsIdsWithPlutus, msg, otherErr, plutusData, success)
+import Prelude hiding (error, succ)
 
 data FactStatementStoreGrpcOpts = FactStatementStoreGrpcOpts
   { _db :: FilePath
@@ -72,62 +74,41 @@ runServer routes (h, p) (certFile, keyFile) = do
     , Encoding.gzip
     ]
 
-type Fs = FactStatementT Identity
+type FsT = FactStatementT Identity
 
 handleReq :: FilePath -> Server.UnaryHandler IO GetFactStatementRequest GetFactStatementResponse
 handleReq dbPath _ req = do
   putStrLn $ "Establishing the database connection to: " <> dbPath
   fsDb <- open dbPath
   let fsTbl' = fsTbl fsStoreSettings
-      ids = nub $ req ^. fsIds ^.. traverse . value
+      ids = nub $ req ^. fsIds
 
-  mayIdsWithPs <-
-    sequence
-      <$> for
-        ids
-        ( \i -> do
-            (mayFsWithId :: Maybe Fs) <- runBeamSqliteDebug Prelude.putStrLn fsDb $ runSelectReturningOne (select $ filter_ (\fs -> _factStatementId fs ==. val_ i) (all_ fsTbl'))
-            maybe
-              (putStrLn ("Not found requested fact statement with id " <> show i) >> return Nothing)
-              (return . Just)
-              mayFsWithId
-        )
+  idsWithRes :: [Either Text Success'FsIdAndPlutus] <-
+    for
+      ids
+      ( \i -> do
+          (mayFsT :: Maybe FsT) <- runBeamSqliteDebug Prelude.putStrLn fsDb $ runSelectReturningOne (select $ filter_ (\fs -> _factStatementId fs ==. val_ i) (all_ fsTbl'))
+          maybe
+            (return (Left $ Text.pack "Not found requested Fact Statement with ID " <> (Text.pack . show $ i)))
+            ( \fs -> do
+                let maySucc :: Maybe Success'FsIdAndPlutus = do
+                      decoded <- decodeStrictWith json return (_json @Identity $ fs)
+                      let plData = jsonToPlutusData decoded
+                      prData <- fromData plData
+                      return $
+                        defMessage
+                          & fsId .~ _factStatementId @Identity fs
+                          & plutusData .~ prData
 
-  idsWithPs <-
-    maybe
-      (putStrLn "There were errors processing the requests" >> return [])
-      return
-      mayIdsWithPs
+                maybe (return (Left $ Text.pack "Failed formatting to PlutusData for Fact Statement with ID: " <> (Text.pack . show $ i))) (return . Right) maySucc
+            )
+            mayFsT
+      )
 
-  mayIdsWithPs' <-
-    sequence
-      <$> for
-        idsWithPs
-        ( \idWithP -> do
-            let fsIdAndP :: Maybe GetFactStatementResponse'FsIdAndPlutus = do
-                  decoded <- decodeStrictWith json return (_json @Identity $ idWithP)
-                  let plData = jsonToPlutusData decoded
-                  prData <- fromData plData
-                  return $
-                    defMessage
-                      & fsId .~ _factStatementId @Identity idWithP
-                      & plutusData .~ prData
-            maybe
-              ( do
-                  putStrLn $ "Failed formatting a fact statement with id" <> show (_factStatementId @Identity idWithP)
-                  return Nothing
-              )
-              (return . Just)
-              fsIdAndP
-        )
-  maybe
-    ( return $
-        defMessage
-          & Proto.error . msg .~ "Failed processing request"
-    )
-    ( \idsWithPs' ->
-        return $
-          defMessage
-            & Proto.success . fsIdsWithPlutus .~ idsWithPs'
-    )
-    mayIdsWithPs'
+  -- If any contains an error report that
+  let allSuccOrErr = sequence idsWithRes
+  return $
+    either
+      (\err -> defMessage & error . otherErr . msg .~ err)
+      (\succ -> defMessage & success . fsIdsWithPlutus .~ succ)
+      allSuccOrErr

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

@@ -32,7 +32,7 @@ import Data.Text (Text, unpack)
 import Data.Text qualified as Text
 import GHC.Exts (fromString)
 import Ledger (PaymentPubKeyHash (PaymentPubKeyHash), TxId)
-import Proto.Plutus_Fields (cborBase16)
+import Proto.Cardano_Fields (cborBase16)
 import Proto.TxBuilderService_Fields (gcFsTx, info, mintFsTx, msg, otherErr, submitter, success)
 import Proto.TxBuilderService_Fields qualified as Proto.TxBuilderService
 import System.Directory (doesFileExist, makeAbsolute)

coop-pab/aux.sh

@@ -61,7 +61,7 @@ function coop-run-tx-builder-grpc {
 
 function coop-garbage-collect {
     make-exports
-    cabal run coop-pab-cli -- garbage-collect --cert-rdmr-wallet $CERT-RDMR
+    cabal run coop-pab-cli -- garbage-collect --cert-rdmr-wallet $CERT_RDMR_WALLET
 }
 
 function coop-get-state {

coop-proto/Makefile

@@ -4,4 +4,4 @@ grpcui:
 protogen:
 	protoc -I . --plugin=protoc-gen-haskell=`which proto-lens-protoc` \
 		--haskell_out proto_out \
-		fact-statement-store-service.proto coop.proto plutus.proto tx-builder-service.proto
+		fact-statement-store-service.proto cardano.proto tx-builder-service.proto publisher-service.proto

coop-proto/cardano-proto-extras/src/Cardano/Proto/Aux.hs

@@ -16,9 +16,9 @@ import Ledger qualified
 import Plutus.V1.Ledger.Api (BuiltinData (BuiltinData), ToData (toBuiltinData), fromBuiltin, toBuiltin)
 import PlutusTx (FromData (fromBuiltinData), builtinDataToData, dataToBuiltinData)
 import PlutusTx qualified
-import Proto.Plutus qualified as Proto
-import Proto.Plutus_Fields (base16, elements, extended, fields, finiteLedgerTime, idx, index, key, kvs, maybe'plutusData, pdbytes, pdconstr, pdint, pdlist, pdmap, transactionHash, value)
-import Proto.Plutus_Fields qualified as PPlutus
+import Proto.Cardano qualified as Proto
+import Proto.Cardano_Fields (base16, elements, extended, fields, finiteLedgerTime, idx, index, key, kvs, maybe'plutusData, pdbytes, pdconstr, pdint, pdlist, pdmap, transactionHash, value)
+import Proto.Cardano_Fields qualified as PCardano
 
 class (MonadFail m) => ProtoCardano m proto cardano where
   toCardano :: proto -> m cardano
@@ -51,14 +51,14 @@ instance MonadFail m => ProtoCardano m Proto.ExtendedLedgerTime (Ledger.Extended
 
 instance (MonadFail m) => ProtoCardano m Proto.TxOutRef Ledger.TxOutRef where
   toCardano ptxOutRef = do
-    txId <- toCardano (ptxOutRef ^. PPlutus.txId)
+    txId <- toCardano (ptxOutRef ^. PCardano.txId)
     return $ Ledger.TxOutRef txId (toInteger $ ptxOutRef ^. idx)
 
   fromCardano (Ledger.TxOutRef txId ix) = do
     txId' <- fromCardano txId
     return $
       defMessage
-        & PPlutus.txId .~ txId'
+        & PCardano.txId .~ txId'
         & idx .~ fromInteger ix
 
 instance (MonadFail m) => ProtoCardano m Proto.TxId Ledger.TxId where

coop-proto/plutus.proto renamed to coop-proto/cardano.proto

@@ -1,6 +1,6 @@
 syntax = "proto3";
 
-package plutus;
+package cardano;
 
 message Transaction {
   // CBOR+Base16 (hex) encoded transaction

coop-proto/coop.proto

@@ -1,30 +1,42 @@
 syntax = "proto3";
 
-import "plutus.proto";
-import "coop.proto";
+import "cardano.proto";
 
-package coop;
+package coop.fact_statement_store;
 
 service FactStatementStore {
   // Fetch a PlutusData encoded Fact Statement with a given ID
   rpc getFactStatement(GetFactStatementRequest) returns (GetFactStatementResponse) {}
 }
 
 message GetFactStatementRequest {
-  repeated coop.FactStatementId fs_ids = 1;
+  repeated bytes fs_ids = 1;
 }
 
-message GetFactStatementResponse {
+message Success {
   message FsIdAndPlutus {
     bytes fs_id = 1;
-    plutus.PlutusData plutus_data = 2;
-  }
-  message Success {
-    repeated FsIdAndPlutus fs_ids_with_plutus = 1;
+    cardano.PlutusData plutus_data = 2;
   }
-  message Error {
+  repeated FsIdAndPlutus fs_ids_with_plutus = 1;
+}
+
+// Error associated with above response messages
+// TODO: Should catch and properly report classes of errors users would expect to trigger.
+// For example:
+//   - Fact statement ID not found
+message Error {
+  message OtherError {
+    // Some other error message
     string msg = 1;
   }
+  oneof someError {
+    // Some other error
+    OtherError other_err = 1;
+  }
+}
+
+message GetFactStatementResponse {
   oneof factStatementsOrErr {
     // Error encountered when servicing the request
     Error error = 1;

coop-proto/fact-statement-store-service.proto

@@ -1,101 +1,69 @@
 syntax = "proto3";
 
-import "google/protobuf/empty.proto";
+import "cardano.proto";
+import "tx-builder-service.proto";
+import "fact-statement-store-service.proto";
 
-package coop;
+package coop.publisher;
 
 service Publisher {
-  // Create a Fact Statement minting transaction (FSMintTx)
-  rpc createFsMintTransaction(CreateFsMintTransactionRequest) returns (CreateFsMintTransactionResponse) {}
-  // Create a Fact Statement burning transaction (FSBurnTx)
-  rpc createFsBurnTransaction(CreateFsBurnTransactionRequest) returns (CreateFsBurnTransactionResponse) {}
+  // Create a Fact Statement minting transaction (mint-fact-statement-tx)
+  rpc createMintFsTx(CreateMintFsTxRequest) returns (CreateMintFsTxResponse) {}
+  // Create a Fact Statement garbage collection transaction (gc-fact-statement-tx)
+  rpc createGcFsTx(CreateGcFsTxRequest) returns (CreateGcFsTxResponse) {}
 }
 
-service Collector {
-  // Fetch a Fact Statement with a given ID
-  rpc getFactStatement(GetFactStatementRequest) returns (GetFactStatementResponse) {}
-}
+message CreateMintFsTxRequest {
+  message FactStatementInfo {
+    // Fact Statement identifier known by the Oracle's Fact Store
+    bytes fs_id = 1;
+    // Extended ledger time after which the created Fact Statement UTxO at @FsV can be spent by the Submitter
+    cardano.ExtendedLedgerTime gcAfter = 2;
+  }
 
-message GetFactStatementRequest {
-  repeated FactStatementId fs_ids = 1;
+  // A list of Fact Statement information containing the ID and time-to-live
+  repeated FactStatementInfo fs_infos = 1;
+  // The PubKeyHash of the user that will submit the transaction
+  cardano.PubKeyHash submitter  = 2;
 }
 
-message GetFactStatementResponse {
-  message FSById {
-    map<FactStatementId, FactStatement> value = 1;
-  }
-  oneof factStatementsOrErr {
-    // Fetched Fact Statements
-    FSById fs_by_id = 1;
+message CreateMintFsTxResponse {
+  oneof transactionOrErr {
     // Error encountered when servicing the request
-    Error error = 2;
+    Error error = 1;
+    // Fact Statement Minting transaction (mint-fact-statement-tx) that must be signed by the Submitter and submitted
+    cardano.Transaction mint_fs_tx = 2;
+  }
+  message Info {
+    coop.tx_builder.MintFsInfo tx_builder_info = 1;
   }
+  Info info = 3;
 }
 
-message CreateFsMintTransactionRequest {
-  message FsParams {
-    // Fact statement identifier
-    FactStatementId fs_id = 1;
-    // Extended ledger time after which the created FSUTxO can be spent by the submitter
-    ExtendedLedgerTime gcAfter = 2;
-  }
+message CreateGcFsTxRequest {
+  // Fact Statement IDs to garbage collect
+  repeated bytes fs_ids = 1;
+  // The PubKeyHash of the user that submitted the FSMintTx and will also submit the FSBurnTx
+  cardano.PubKeyHash submitter  = 2;
+}
 
-  // A list of fact statements to mint along with their ttl
-  repeated FsParams fs_params = 1;
-  // The PubKeyHash of the user that will submit the transaction
-  PubKeyHash submitter  = 2;
-  // Submitter owned UTxO to use as a collateral UTxO in the returned FSMintTx
-  UTxORef collateral = 3;
-  // Submitter owned UTxO that contains the $FEE tokens requested by the publisher
-  UTxORef fee = 4;
+message CreateGcFsTxResponse {
+  oneof transactionOrErr {
+    // Fact Statement garbage collection transaction (gc-fact-statement-tx) to sign and submit
+    cardano.Transaction gc_fs_tx = 1;
+    // Error encountered when servicing the request
+    Error error = 2;
+  }
 }
 
 message Error {
-  message NotFoundError {
-    // Fact Statement ID that wasn't found
-    FactStatementId fs_id = 1;
-  }
-  message TimeoutError {
-    // Timeout error message
-    string msg = 1;
-  }
   message OtherError {
     // Some other error message
     string msg = 1;
   }
   oneof someError {
-    // Fact Statement ID wasn't found
-    NotFoundError not_found_err = 1;
-    // Timeout error
-    TimeoutError timeout_err = 2;
-    // Some other error
+    coop.fact_statement_store.Error fs_store_err = 1;
+    coop.tx_builder.Error tx_builder_err = 2;
     OtherError other_err = 3;
   }
 }
-
-message CreateFsMintTransactionResponse {
-  oneof transactionOrErr {
-    // Fact Statement Minting transaction (abbr. FSMintTx) to sign and submit
-    Transaction fs_mint_tx = 1;
-    // Error encountered when servicing the request
-    Error error = 2;
-  }
-}
-
-message CreateFsBurnTransactionRequest {
-  // User provided FSUTxOs to spend
-  repeated UTxORef fs = 1;
-  // The PubKeyHash of the user that submitted the FSMintTx and will also submit the FSBurnTx
-  PubKeyHash submitter  = 2;
-  // Submitter owned UTxO to use as a collateral UTxO in the returned FSBurnTx
-  UTxORef collateral = 3;
-}
-
-message CreateFsBurnTransactionResponse {
-  oneof transactionOrErr {
-    // Fact Statement Burning transaction (abbr. FSBurnTx) to sign and submit
-    Transaction fs_burn_tx = 1;
-    // Error encountered when servicing the request
-    Error error = 2;
-  }
-}