WIP registration

Author: j-mueller

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

@@ -54,7 +54,10 @@ common lang
 
 library
   import:          lang
-  exposed-modules: Wst.Aiken.Blueprint
+  exposed-modules:
+    Wst.Aiken.Blueprint
+    Wst.Aiken.Offchain
+
   hs-source-dirs:  lib
   build-depends:
     , aeson
@@ -63,6 +66,7 @@ library
     , cardano-api
     , containers
     , text
+    , wst-poc
 
 test-suite wst-aiken-test
   import:         lang

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

@@ -95,7 +95,7 @@ deserialise Preamble{plutusVersion = BlueprintScriptVersion v} validators =
 deserialiseScript :: AnyPlutusScriptVersion -> BlueprintValidator -> Either String (BlueprintKey, ScriptInAnyLang)
 deserialiseScript (C.AnyPlutusScriptVersion v) BlueprintValidator{title, compiledCode} =
     let lng = C.PlutusScriptLanguage v
-     in fmap ((title,) . C.ScriptInAnyLang lng . C.PlutusScript v) (deserialisePlutus v compiledCode)
+     in fmap ((title,) . C.ScriptInAnyLang lng) (deserialisePlutus v compiledCode)
 
-deserialisePlutus :: forall lang. (C.HasTypeProxy lang) => C.PlutusScriptVersion lang -> Text -> Either String (C.PlutusScript lang)
-deserialisePlutus _ text = first show $ C.deserialiseFromCBOR (C.proxyToAsType $ Proxy @(C.PlutusScript lang)) (TE.encodeUtf8 text)
+deserialisePlutus :: forall lang. (C.IsScriptLanguage lang) => C.PlutusScriptVersion lang -> Text -> Either String (C.Script lang)
+deserialisePlutus _ text = first show $ C.deserialiseFromCBOR (C.proxyToAsType $ Proxy @(C.Script lang)) (TE.encodeUtf8 text)

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

@@ -0,0 +1,17 @@
+-- | Off-chain code for the aiken example
+module Wst.Aiken.Offchain
+  ( register,
+  )
+where
+
+import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..))
+import Wst.Offchain.BuildTx.DirectorySet qualified as Directory
+
+-- | Register the policy
+register :: (Applicative m) => m ()
+register = do
+  let args =
+        InsertNodeArgs
+          { inaNewKey = undefined
+          }
+  pure ()

src/aiken-example/haskell/test/Wst/Aiken/Test.hs

@@ -7,10 +7,9 @@ module Wst.Aiken.Test(
 import Cardano.Api qualified as C
 import Data.Functor (void)
 import Data.Map qualified as Map
-import Data.Maybe (isJust)
 import Paths_aiken_example qualified as Pkg
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase)
+import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
 import Wst.Aiken.Blueprint (Blueprint (..))
 import Wst.Aiken.Blueprint qualified as Blueprint
 
@@ -31,7 +30,7 @@ deserialiseScript = do
     >>= \case
       (C.ScriptInAnyLang (C.PlutusScriptLanguage C.PlutusScriptV3) script) -> do
         let hsh = C.hashScript script
-        assertEqual "Script hash" "cc068514c844ed3f6c6d0f131b20cda83dbd50f340242b5740d0f81f" hsh
+        assertEqual "Script hash" "9c4802ae9a38d64cf970d68f34f55c6504c749c64fe0968fea77dac8" hsh
       _ -> fail "Unexpected script language"
 
 loadExample :: IO Blueprint

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

@@ -84,14 +84,14 @@ initDirectorySet = Utils.inBabbage @era $ do
   prependTxOut output
 
 
-{-| Data for a  new node to be inserted into the directory
+{-| Data for a new node to be inserted into the directory
 -}
 data InsertNodeArgs =
   InsertNodeArgs
-    { inaNewKey :: CurrencySymbol
-    , inaTransferLogic :: C.StakeCredential
-    , inaIssuerLogic :: C.StakeCredential
-    , inaGlobalStateCS :: Maybe CurrencySymbol
+    { 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
+    , inaGlobalStateCS :: Maybe CurrencySymbol -- ^ Currency symbol of an NFT that identifies a UTxO with global parameters specific to the new token
     }
 
 insertDirectoryNode :: forall era env m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBuildTx era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBlockchain era m) => UTxODat era ProgrammableLogicGlobalParams -> UTxODat era DirectorySetNode -> InsertNodeArgs -> m ()