Offchain protocol params and directory

cabal.project

@@ -31,3 +31,17 @@ source-repository-package
       .
       plutarch-ledger-api
       plutarch-extra
+
+source-repository-package
+  type: git
+  location: https://github.com/j-mueller/sc-tools
+  tag: 162a9e4c1c243f789857381f06907232efc4a28c
+  subdir:
+    src/devnet
+    src/coin-selection
+    src/mockchain
+    src/optics
+    src/wallet
+    src/base
+    src/node-client
+

flake.nix

@@ -11,16 +11,17 @@
     };
 
     nixpkgs.follows = "haskell-nix/nixpkgs";
-    iohk-nix.url = "github:input-output-hk/iohk-nix";
-    iohk-nix.inputs.nixpkgs.follows = "haskell-nix/nixpkgs";
+
+    # iohk-nix.url = "github:input-output-hk/iohk-nix";
+    # iohk-nix.inputs.nixpkgs.follows = "haskell-nix/nixpkgs";
 
     hackage = {
       url = "github:input-output-hk/hackage.nix";
       flake = false;
     };
 
     CHaP = {
-      url = "github:input-output-hk/cardano-haskell-packages?ref=repo";
+      url = "github:IntersectMBO/cardano-haskell-packages?ref=repo";
       flake = false;
     };
 

nix/project.nix

@@ -2,6 +2,7 @@
 
 let
   sha256map = {
+    "https://github.com/j-mueller/sc-tools"."162a9e4c1c243f789857381f06907232efc4a28c" = "sha256-W/ohKnyqDNTA1riCJYmQgNAZjzaI8fSkt4nadH3RRro=";
     "https://github.com/colll78/plutarch-plutus"."b2379767c7f1c70acf28206bf922f128adc02f28" = "sha256-mhuW2CHxnc6FDWuMcjW/51PKuPOdYc4yxz+W5RmlQew=";
   };
 
@@ -10,9 +11,9 @@ let
   cabalProject = pkgs.haskell-nix.cabalProject' {
     inherit modules sha256map;
     src = ../.;
-    name = "stablecoin-plutarch";
+    name = "wst-poc";
     compiler-nix-name = "ghc966";
-    index-state = "2024-10-16T00:00:00Z";
+    # index-state = "2024-10-16T00:00:00Z";
     inputMap = {
       "https://chap.intersectmbo.org/" = inputs.CHaP;
     };

src/lib/Wst/Offchain/Blacklist.hs

@@ -0,0 +1,2 @@
+
+module Wst.Offchain.Blacklist () where

src/lib/Wst/Offchain/DirectorySet.hs

@@ -0,0 +1,114 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DeriveAnyClass #-}
+
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Wst.Offchain.DirectorySet (
+  initDirectorySet,
+  insertDirectoryNode
+) where
+
+import Cardano.Api qualified as C
+import PlutusLedgerApi.V3 qualified as P
+import PlutusLedgerApi.V3 ( CurrencySymbol(..), Credential(..) )
+import Convex.BuildTx (MonadBuildTx, mintPlutus, spendPublicKeyOutput, addBtx)
+import Convex.PlutusLedger (unTransAssetName, transPolicyId)
+import qualified Cardano.Api.Shelley as C
+import Convex.CardanoApi.Lenses qualified as L
+import GHC.Exts (IsList(..))
+import Convex.Scripts (toHashableScriptData, fromHashableScriptData)
+import Control.Lens (over)
+import GHC.Generics (Generic)
+import qualified PlutusTx
+
+
+directoryNodeMintingScript :: C.TxIn -> C.PlutusScript C.PlutusScriptV3
+directoryNodeMintingScript txIn = undefined
+
+directoryMintingPolicy :: C.TxIn -> C.PolicyId
+directoryMintingPolicy = C.scriptPolicyId . C.PlutusScript C.PlutusScriptV3 . directoryNodeMintingScript
+
+
+directoryNodeToken :: C.AssetName
+directoryNodeToken = unTransAssetName $ P.TokenName "DirectoryNodeNFT"
+
+directoryNodeSpendingScript :: C.Hash C.PaymentKey -> C.SimpleScript
+directoryNodeSpendingScript = C.RequireSignature
+
+data DirectorySetNode = DirectorySetNode
+  { key :: CurrencySymbol
+  , next :: CurrencySymbol
+  , transferLogicScript  :: Credential
+  , issuerLogicScript :: Credential
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData)
+
+initDirectorySet :: (MonadBuildTx C.ConwayEra m) => C.NetworkId -> C.Hash C.PaymentKey -> C.TxIn -> m ()
+initDirectorySet netId operatorHash txIn = do
+
+  spendPublicKeyOutput txIn
+  mintPlutus (directoryNodeMintingScript txIn) () directoryNodeToken 1
+
+  let
+      val = C.TxOutValueShelleyBased C.ShelleyBasedEraConway $ C.toLedgerValue C.MaryEraOnwardsBabbage
+            $ fromList [(C.AssetId (directoryMintingPolicy txIn) directoryNodeToken, 1)]
+
+      addr =
+        C.makeShelleyAddressInEra
+          C.ShelleyBasedEraConway
+          netId
+          (C.PaymentCredentialByScript $ C.hashScript $ C.SimpleScript $ directoryNodeSpendingScript operatorHash)
+          C.NoStakeAddress
+
+      d = DirectorySetNode (CurrencySymbol "") (CurrencySymbol "") (PubKeyCredential "") (PubKeyCredential "")
+      dat = C.TxOutDatumInline C.BabbageEraOnwardsConway $ toHashableScriptData d
+
+      output :: C.TxOut C.CtxTx C.ConwayEra
+      output = C.TxOut addr val dat C.ReferenceScriptNone
+
+  addBtx (over L.txOuts (output :))
+
+insertDirectoryNode :: (MonadBuildTx C.ConwayEra m) => C.NetworkId -> C.Hash C.PaymentKey -> (C.TxIn, C.InAnyCardanoEra (C.TxOut ctx)) -> (CurrencySymbol, Credential, Credential) -> m ()
+insertDirectoryNode netId operatorHash (afterTxIn, afterTxOut) (newKey, transferLogic, issuerLogic) = do
+
+  let
+      (afterTxVal :: C.TxOutValue C.ConwayEra, afterTxData :: DirectorySetNode) = case afterTxOut of
+        C.InAnyCardanoEra _ (C.TxOut _ v (C.TxOutDatumInline C.BabbageEraOnwardsConway dat) _) -> case fromHashableScriptData @DirectorySetNode dat of
+          Just d -> (v, d)
+          Nothing -> error "insertDirectoryNode: invalid datum"
+        _ -> error "insertDirectoryNode: invalid output"
+
+  spendPublicKeyOutput afterTxIn
+  mintPlutus (directoryNodeMintingScript afterTxIn) () directoryNodeToken 1
+
+  let
+      newVal = C.TxOutValueShelleyBased C.ShelleyBasedEraConway $ C.toLedgerValue C.MaryEraOnwardsBabbage
+          $ fromList [(C.AssetId (directoryMintingPolicy afterTxIn) directoryNodeToken, 1)]
+
+      addr =
+        C.makeShelleyAddressInEra
+          C.ShelleyBasedEraConway
+          netId
+          (C.PaymentCredentialByScript $ C.hashScript $ C.SimpleScript $ directoryNodeSpendingScript operatorHash)
+          C.NoStakeAddress
+
+      x = DirectorySetNode
+            { key = newKey
+            , next = next afterTxData
+            , transferLogicScript = transferLogic
+            , issuerLogicScript = issuerLogic
+            }
+      newDat = C.TxOutDatumInline C.BabbageEraOnwardsConway $ toHashableScriptData x
+
+      newOutput :: C.TxOut C.CtxTx C.ConwayEra
+      newOutput = C.TxOut addr newVal newDat C.ReferenceScriptNone
+
+      modifiedDat = afterTxData { next = transPolicyId $ directoryMintingPolicy afterTxIn }
+      modifiedOutput = C.TxOut addr afterTxVal (C.TxOutDatumInline C.BabbageEraOnwardsConway $ toHashableScriptData modifiedDat) C.ReferenceScriptNone
+
+  addBtx (over L.txOuts (newOutput :))
+  addBtx (over L.txOuts (modifiedOutput :))

src/lib/Wst/Offchain/LinkedList.hs

@@ -0,0 +1,25 @@
+
+
+module Wst.Offchain.LinkedList (
+  initLinkedList
+) where
+
+import Cardano.Api qualified as C
+import PlutusLedgerApi.V3 qualified as P
+import Convex.BuildTx (MonadBuildTx, mintPlutus, spendPublicKeyOutput, addBtx)
+import Convex.PlutusLedger (unTransAssetName)
+import qualified Cardano.Api.Shelley as C
+import Convex.CardanoApi.Lenses qualified as L
+import GHC.Exts (IsList(..))
+import Convex.Scripts (toHashableScriptData)
+import Control.Lens (over)
+import PlutusLedgerApi.Data.V3 (BuiltinByteString, CurrencySymbol)
+
+
+initLinkedList :: (MonadBuildTx C.ConwayEra m, P.ToData k) => C.NetworkId -> k -> m ()
+initLinkedList netId key = do
+  pure ()
+
+insertLinkedList :: (MonadBuildTx C.ConwayEra m, P.ToData k) => C.NetworkId -> k -> m ()
+insertLinkedList netId k = do
+  pure ()