WIP build tx

Author: j-mueller

src/aiken-example/haskell/aiken-example.cabal

@@ -65,7 +65,11 @@ library
     , bytestring
     , cardano-api
     , containers
+    , convex-base
+    , mtl
+    , plutus-ledger-api
     , text
+    , transformers
     , wst-poc
 
 test-suite wst-aiken-test

src/aiken-example/haskell/lib/Wst/Aiken/Offchain.hs

@@ -1,17 +1,68 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -- | Off-chain code for the aiken example
 module Wst.Aiken.Offchain
   ( register,
+    Cip143Blueprint (..),
+    lookupScripts,
   )
 where
 
+import Cardano.Api (ScriptInAnyLang)
+import Cardano.Api qualified as C
+import Cardano.Api.Shelley qualified as C
+import Control.Monad.Reader (MonadReader, runReaderT)
+import Convex.BuildTx qualified as BuildTx
+import Convex.Class (MonadBlockchain)
+import Data.Functor.Constant (Constant (..))
+import Data.Functor.Identity (Identity (..))
+import Data.Map qualified as Map
+import PlutusLedgerApi.V3 (CurrencySymbol)
+import Wst.Aiken.Blueprint (Blueprint (..), BlueprintKey)
 import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..))
 import Wst.Offchain.BuildTx.DirectorySet qualified as Directory
+import Wst.Offchain.Env (HasDirectoryEnv)
+import Wst.Offchain.Query qualified as Query
+
+data Cip143Blueprint v
+  = Cip143Blueprint
+  { cbSymbol :: CurrencySymbol,
+    cbTransfer :: v ScriptInAnyLang,
+    cbIssuance :: v ScriptInAnyLang,
+    cbGlobalStateCS :: Maybe CurrencySymbol
+  }
+
+-- | Lookup the scripts that are referenced in the CIP 143 blueprint
+lookupScripts :: Blueprint -> Cip143Blueprint (Constant BlueprintKey) -> Either String (Cip143Blueprint Identity)
+lookupScripts Blueprint {validators} b@Cip143Blueprint {cbTransfer, cbIssuance} = do
+  tr <- maybe (Left $ "Failed to find key " <> show (getConstant cbTransfer)) Right (Map.lookup (getConstant cbTransfer) validators)
+  i <- maybe (Left $ "Failed to find key " <> show (getConstant cbIssuance)) Right (Map.lookup (getConstant cbIssuance) validators)
+  pure $ b {cbIssuance = Identity i, cbTransfer = Identity tr}
 
--- | Register the policy
-register :: (Applicative m) => m ()
-register = do
-  let args =
-        InsertNodeArgs
-          { inaNewKey = undefined
-          }
+scriptHash :: ScriptInAnyLang -> C.ScriptHash
+scriptHash (C.ScriptInAnyLang _ s) = C.hashScript s
+
+mkArgs :: Cip143Blueprint Identity -> InsertNodeArgs
+mkArgs Cip143Blueprint {cbSymbol, cbTransfer, cbIssuance, cbGlobalStateCS} =
+  InsertNodeArgs
+    { inaNewKey = cbSymbol,
+      inaTransferLogic = C.StakeCredentialByScript $ scriptHash $ runIdentity cbTransfer,
+      inaIssuerLogic = C.StakeCredentialByScript $ scriptHash $ runIdentity cbIssuance,
+      inaGlobalStateCS = cbGlobalStateCS
+    }
+
+-- | Register the policies
+register :: forall era env m. (Monad m, C.IsBabbageBasedEra era, MonadReader env m, HasDirectoryEnv env, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBlockchain era m) => Cip143Blueprint Identity -> m ()
+register blueprint = do
+  let args = mkArgs blueprint
+  paramsNode <- Query.globalParamsNode @era
+  tx <- BuildTx.runBuildTxT @era (Directory.insertDirectoryNode @era _ _ args)
   pure ()
+
+-- other endpoints
+-- mint
+-- burn
+-- transfer
+-- force-transfer

src/regulated-stablecoin/lib/Wst/Offchain/BuildTx/DirectorySet.hs

@@ -83,14 +83,13 @@ initDirectorySet = Utils.inBabbage @era $ do
 
   prependTxOut output
 
-
 {-| Data for a new node to be inserted into the directory
 -}
 data InsertNodeArgs =
   InsertNodeArgs
-    { inaNewKey :: CurrencySymbol -- ^ currency symbol of the CIP-0143 token
+    { inaNewKey        :: CurrencySymbol -- ^ currency symbol of the CIP-0143 token
     , inaTransferLogic :: C.StakeCredential -- ^ Stake validator for transfers
-    , inaIssuerLogic :: C.StakeCredential -- ^ Stake validator for minting and burning
+    , inaIssuerLogic   :: C.StakeCredential -- ^ Stake validator for minting and burning
     , inaGlobalStateCS :: Maybe CurrencySymbol -- ^ Currency symbol of an NFT that identifies a UTxO with global parameters specific to the new token
     }