diff --git a/cabal.project b/cabal.project index c8dec6d..db56295 100644 --- a/cabal.project +++ b/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 + diff --git a/flake.lock b/flake.lock index 624a00b..85240c4 100644 --- a/flake.lock +++ b/flake.lock @@ -3,15 +3,15 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1733408643, - "narHash": "sha256-IH5nYTjx+CYAK4zQAkOs475X+AOhP/GPgwXm5LQHsEE=", - "owner": "input-output-hk", + "lastModified": 1734128100, + "narHash": "sha256-LTML3sdQbUL+FeXoafPPUOScBmIdWkofNwa1Fjuz7PU=", + "owner": "IntersectMBO", "repo": "cardano-haskell-packages", - "rev": "e062328804c933d296e5956c989b326ea3c69eeb", + "rev": "8df3e3656dcaac2c6328ac199ad90500a6a359bf", "type": "github" }, "original": { - "owner": "input-output-hk", + "owner": "IntersectMBO", "ref": "repo", "repo": "cardano-haskell-packages", "type": "github" @@ -100,23 +100,6 @@ "type": "github" } }, - "blst_3": { - "flake": false, - "locked": { - "lastModified": 1691598027, - "narHash": "sha256-oqljy+ZXJAXEB/fJtmB8rlAr4UXM+Z2OkDa20gpILNA=", - "owner": "supranational", - "repo": "blst", - "rev": "3dd0f804b1819e5d03fb22ca2e6fac105932043a", - "type": "github" - }, - "original": { - "owner": "supranational", - "ref": "v0.3.11", - "repo": "blst", - "type": "github" - } - }, "cabal-32": { "flake": false, "locked": { @@ -654,11 +637,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1733877006, - "narHash": "sha256-rNpSFS/ziUQBPgo6iAbKgU00yRpeCngv215TW0D+kCo=", + "lastModified": 1734309106, + "narHash": "sha256-JcB9YbRWasj3d1wpz8vfyI8ai3Nvu69+IPPhUb9ejoA=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "583f569545854160b6bc5606374bf5006a9f6929", + "rev": "d3ac85d228d4b58d8083d8c8af2ba12d3199c886", "type": "github" }, "original": { @@ -740,11 +723,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1733878317, - "narHash": "sha256-Bbr5dUxCH+s1BXfZ5BNxmOOnLZqZUdjeZVWN0KEak/Q=", + "lastModified": 1734310321, + "narHash": "sha256-V6n3f2JiauvU+M483gRcEirsPsr2mmhUfDiMHIlWo5g=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "fa511ea6fd05774bbf97f187fd560658067ff7f7", + "rev": "4bd079e21afcff79917e953d2f1b11d3bfec8603", "type": "github" }, "original": { @@ -1326,37 +1309,13 @@ "inputs": { "blst": "blst_2", "nixpkgs": [ + "plutarch", "haskell-nix", "nixpkgs" ], "secp256k1": "secp256k1_2", "sodium": "sodium_2" }, - "locked": { - "lastModified": 1732287300, - "narHash": "sha256-lURsE6HdJX0alscWhbzCWyLRK8GpAgKuXeIgX31Kfqg=", - "owner": "input-output-hk", - "repo": "iohk-nix", - "rev": "262cb2aec2ddd914124bab90b06fe24a1a74d02c", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "repo": "iohk-nix", - "type": "github" - } - }, - "iohk-nix_3": { - "inputs": { - "blst": "blst_3", - "nixpkgs": [ - "plutarch", - "haskell-nix", - "nixpkgs" - ], - "secp256k1": "secp256k1_3", - "sodium": "sodium_3" - }, "locked": { "lastModified": 1730297014, "narHash": "sha256-n3f1iAmltKnorHWx7FrdbGIF/FmEG8SsZshS16vnpz0=", @@ -2060,7 +2019,7 @@ "flake-parts": "flake-parts_2", "haskell-nix": "haskell-nix_2", "hercules-ci-effects": "hercules-ci-effects", - "iohk-nix": "iohk-nix_3", + "iohk-nix": "iohk-nix_2", "nixpkgs": "nixpkgs_7", "pre-commit-hooks": "pre-commit-hooks" }, @@ -2127,7 +2086,6 @@ "hackage": "hackage", "haskell-nix": "haskell-nix", "iogx": "iogx", - "iohk-nix": "iohk-nix_2", "nixpkgs": [ "haskell-nix", "nixpkgs" @@ -2169,23 +2127,6 @@ "type": "github" } }, - "secp256k1_3": { - "flake": false, - "locked": { - "lastModified": 1683999695, - "narHash": "sha256-9nJJVENMXjXEJZzw8DHzin1DkFkF8h9m/c6PuM7Uk4s=", - "owner": "bitcoin-core", - "repo": "secp256k1", - "rev": "acf5c55ae6a94e5ca847e07def40427547876101", - "type": "github" - }, - "original": { - "owner": "bitcoin-core", - "ref": "v0.3.2", - "repo": "secp256k1", - "type": "github" - } - }, "sodium": { "flake": false, "locked": { @@ -2220,23 +2161,6 @@ "type": "github" } }, - "sodium_3": { - "flake": false, - "locked": { - "lastModified": 1675156279, - "narHash": "sha256-0uRcN5gvMwO7MCXVYnoqG/OmeBFi8qRVnDWJLnBb9+Y=", - "owner": "input-output-hk", - "repo": "libsodium", - "rev": "dbb48cce5429cb6585c9034f002568964f1ce567", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "repo": "libsodium", - "rev": "dbb48cce5429cb6585c9034f002568964f1ce567", - "type": "github" - } - }, "sphinxcontrib-haddock": { "flake": false, "locked": { @@ -2256,11 +2180,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1733789551, - "narHash": "sha256-0tSxhYw3RqNEHYFYIwJZ99mFDpGr8Dekf+p2ZCEygYY=", + "lastModified": 1734307971, + "narHash": "sha256-K/cG068tTrjNSEXtRy41Tgl8FzGuh4GHE6Ab3Efw074=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "db7b3e7ae59867ce0ba21df45f57ea38f57710ab", + "rev": "0f1c2177c3be7c738d025677bc0c687ba9a2cb38", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 595ad58..05a3eff 100644 --- a/flake.nix +++ b/flake.nix @@ -11,8 +11,9 @@ }; 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"; @@ -20,7 +21,7 @@ }; CHaP = { - url = "github:input-output-hk/cardano-haskell-packages?ref=repo"; + url = "github:IntersectMBO/cardano-haskell-packages?ref=repo"; flake = false; }; diff --git a/nix/project.nix b/nix/project.nix index 3d9194a..93c1086 100644 --- a/nix/project.nix +++ b/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; }; diff --git a/src/lib/Wst/Offchain/Blacklist.hs b/src/lib/Wst/Offchain/Blacklist.hs new file mode 100644 index 0000000..6de3e92 --- /dev/null +++ b/src/lib/Wst/Offchain/Blacklist.hs @@ -0,0 +1,2 @@ + +module Wst.Offchain.Blacklist () where diff --git a/src/lib/Wst/Offchain/Common.hs b/src/lib/Wst/Offchain/Common.hs new file mode 100644 index 0000000..e69de29 diff --git a/src/lib/Wst/Offchain/DirectorySet.hs b/src/lib/Wst/Offchain/DirectorySet.hs new file mode 100644 index 0000000..bdd1fad --- /dev/null +++ b/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 :)) diff --git a/src/lib/Wst/Offchain/LinkedList.hs b/src/lib/Wst/Offchain/LinkedList.hs new file mode 100644 index 0000000..ffc65f1 --- /dev/null +++ b/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 () diff --git a/src/lib/Wst/Offchain/ProtocolParams.hs b/src/lib/Wst/Offchain/ProtocolParams.hs new file mode 100644 index 0000000..7b3025d --- /dev/null +++ b/src/lib/Wst/Offchain/ProtocolParams.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wst.Offchain.ProtocolParams ( + mintProtocolParams +) 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) + + +protocolParamsMintingScript :: C.PlutusScript C.PlutusScriptV3 +protocolParamsMintingScript = undefined + +protocolParamsToken :: C.AssetName +protocolParamsToken = unTransAssetName $ P.TokenName "ProtocolParamsNFT" + +alwaysFailScript :: C.PlutusScript C.PlutusScriptV3 +alwaysFailScript = undefined + +paramScriptPolicy :: C.PolicyId +paramScriptPolicy = C.scriptPolicyId $ C.PlutusScript C.PlutusScriptV3 alwaysFailScript + +mintProtocolParams :: (MonadBuildTx C.ConwayEra m, P.ToData a) => C.NetworkId -> a -> C.TxIn -> m () +mintProtocolParams netId d txIn = do + let + val = C.TxOutValueShelleyBased C.ShelleyBasedEraConway $ C.toLedgerValue C.MaryEraOnwardsBabbage + $ fromList [(C.AssetId paramScriptPolicy protocolParamsToken, 1)] + + addr = + C.makeShelleyAddressInEra + C.ShelleyBasedEraConway + netId + (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 alwaysFailScript) + C.NoStakeAddress + + -- Should contain directoryNodeCS and progLogicCred fields + dat = C.TxOutDatumInline C.BabbageEraOnwardsConway $ toHashableScriptData d + + output :: C.TxOut C.CtxTx C.ConwayEra + output = C.TxOut addr val dat C.ReferenceScriptNone + + spendPublicKeyOutput txIn + mintPlutus protocolParamsMintingScript () protocolParamsToken 1 + addBtx (over L.txOuts (output :)) diff --git a/src/lib/Wst/Server/Types.hs b/src/lib/Wst/Server/Types.hs index 69d5c2c..7a3d179 100644 --- a/src/lib/Wst/Server/Types.hs +++ b/src/lib/Wst/Server/Types.hs @@ -26,8 +26,25 @@ import Data.Aeson.Types (ToJSON) type API = "healthcheck" :> Description "Is the server alive?" :> Get '[JSON] NoContent :<|> "init-merkle-tree" :> Description "Initialize a new Merkle tree." :> ReqBody '[JSON] String :> Post '[JSON] String + -- creates empty directory + -- initialize the programmable token params, dir node minting policy + -- init head of linked list + :<|> "update-merkle-tree" :> Description "Update the Merkle tree." :> ReqBody '[JSON] String :> Post '[JSON] String -- This might need to be broken down further + -- dir 1 + -- the programmable script to execute + -- add program (registers staking scripts as well) + -- modify program + -- remove program (maybe not needed) + + -- dir 2 (specific to the program) + -- add blacklist + -- remove blacklist + + -- should be user-transfer (invoking spending program) :<|> "transfer-to-user" :> Description "Transfer tokens to a user." :> ReqBody '[JSON] String :> Post '[JSON] String + + -- should be issuer-transfe (invoking issuer program) :<|> "transfer-to-issuer" :> Description "Transfer tokens to an issuer." :> ReqBody '[JSON] String :> Post '[JSON] String :<|> "address" :> Description "Query the balance of an address." :> Capture "address" String :> Get '[JSON] String :<|> "all-sanctioned-addresses" :> Description "Query all sanctioned addresses." :> Get '[JSON] String diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 1a0b86f..4d4a69e 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -41,6 +41,10 @@ library Wst.Cli Wst.Client Wst.Offchain + Wst.Offchain.Blacklist + Wst.Offchain.DirectorySet + Wst.Offchain.LinkedList + Wst.Offchain.ProtocolParams Wst.Onchain Wst.Server Wst.Server.Endpoints @@ -49,7 +53,18 @@ library hs-source-dirs: lib build-depends: , aeson - , base >=4.14 && <4.20 + , base >=4.14 && <4.20 + , cardano-api + , cardano-ledger-api + , convex-base + , convex-coin-selection + , convex-mockchain + , convex-node-client + , convex-optics + , convex-wallet + , lens + , plutus-ledger-api + , plutus-tx , servant , servant-client , servant-client-core