From 41a8388cb6935193ca59fbb1e05453b677e43753 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jann=20M=C3=BCller?= Date: Mon, 30 Dec 2024 15:15:45 +0100 Subject: [PATCH] Clean up (#29) * Clean up * Update names of nix derivations --- .github/workflows/ci-nix.yaml | 4 ++-- .github/workflows/ci-oci.yaml | 2 +- nix/containers.nix | 2 +- src/lib/SmartTokens/LinkedList/Common.hs | 5 ++--- .../SmartTokens/LinkedList/MintDirectory.hs | 19 +------------------ src/lib/SmartTokens/Types/PTokenDirectory.hs | 18 ++---------------- src/lib/Wst/Cli.hs | 4 ++-- src/lib/Wst/Cli/Command.hs | 5 ++--- src/lib/Wst/Offchain.hs | 3 --- src/lib/Wst/Offchain/BuildTx/Blacklist.hs | 2 -- src/lib/Wst/Offchain/BuildTx/DirectorySet.hs | 9 +++------ .../Wst/Offchain/BuildTx/ProgrammableLogic.hs | 10 +++++----- src/lib/Wst/Offchain/BuildTx/TransferLogic.hs | 8 ++++---- src/lib/Wst/Offchain/Endpoints/Deployment.hs | 2 -- src/lib/Wst/Offchain/Env.hs | 4 ++-- src/lib/Wst/Onchain.hs | 5 ----- src/wst-poc.cabal | 8 -------- 17 files changed, 27 insertions(+), 83 deletions(-) delete mode 100644 src/lib/Wst/Offchain.hs delete mode 100644 src/lib/Wst/Offchain/BuildTx/Blacklist.hs delete mode 100644 src/lib/Wst/Onchain.hs diff --git a/.github/workflows/ci-nix.yaml b/.github/workflows/ci-nix.yaml index a78f7b7..f77a27d 100644 --- a/.github/workflows/ci-nix.yaml +++ b/.github/workflows/ci-nix.yaml @@ -6,7 +6,7 @@ on: push: concurrency: - group: ${{ github.ref }} + group: "ci-nix-${{ github.ref }}" cancel-in-progress: true jobs: @@ -48,6 +48,6 @@ jobs: # key: cabal-${{ hashFiles('cabal.project') }} # We currently do not have a default target - - run: nix build --accept-flake-config .#wst-poc + - run: nix build --accept-flake-config .#wst-poc-cli - run: nix flake --accept-flake-config check diff --git a/.github/workflows/ci-oci.yaml b/.github/workflows/ci-oci.yaml index 1d759f6..7e1169a 100644 --- a/.github/workflows/ci-oci.yaml +++ b/.github/workflows/ci-oci.yaml @@ -8,7 +8,7 @@ on: push: concurrency: - group: ${{ github.ref }} + group: "ci-oci-${{ github.ref }}" cancel-in-progress: true jobs: diff --git a/nix/containers.nix b/nix/containers.nix index 8790466..ab948bb 100644 --- a/nix/containers.nix +++ b/nix/containers.nix @@ -7,7 +7,7 @@ # $ nix build .#containers.x86_64-linux.wst # wst = lib.iogx.mkContainerFromCabalExe { - exe = inputs.self.packages.wst-poc; + exe = inputs.self.packages.wst-poc-cli; name = "wst-poc"; description = "WST Proof of Concept"; packages = [ ]; diff --git a/src/lib/SmartTokens/LinkedList/Common.hs b/src/lib/SmartTokens/LinkedList/Common.hs index 4223f71..2c065d1 100644 --- a/src/lib/SmartTokens/LinkedList/Common.hs +++ b/src/lib/SmartTokens/LinkedList/Common.hs @@ -35,9 +35,8 @@ import Plutarch.Prelude (ClosedTerm, Generic, PAsData, PBool, PBuiltinList, PMaybe (PJust), PPair (..), PPartialOrd ((#<)), PType, PUnit, S, Term, TermCont, pall, pany, pcon, pconstant, pdata, pelimList, pfield, pfilter, pfromData, pguardC, - phoistAcyclic, plam, plength, plengthBS, plet, - pletFields, pmap, pmatch, pto, tcont, type (:-->), - (#$), (#&&), (#)) + phoistAcyclic, plam, plengthBS, plet, pletFields, pmap, + pmatch, pto, tcont, type (:-->), (#$), (#&&), (#)) import Plutarch.Unsafe (punsafeCoerce) import SmartTokens.Types.PTokenDirectory (PDirectorySetNode, pisEmptyNode, pisInsertedNode, pisInsertedOnNode) diff --git a/src/lib/SmartTokens/LinkedList/MintDirectory.hs b/src/lib/SmartTokens/LinkedList/MintDirectory.hs index 294033f..eb52f5e 100644 --- a/src/lib/SmartTokens/LinkedList/MintDirectory.hs +++ b/src/lib/SmartTokens/LinkedList/MintDirectory.hs @@ -21,10 +21,9 @@ module SmartTokens.LinkedList.MintDirectory ( DirectoryNodeAction (..) ) where -import Data.Maybe (fromJust) import Generics.SOP qualified as SOP import Plutarch.Core.Utils (pand'List, passert, phasUTxO) -import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields) +import Plutarch.DataRepr (DerivePConstantViaData (..)) import Plutarch.LedgerApi.V3 (PScriptContext, PTxOutRef) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.Monadic qualified as P @@ -35,10 +34,8 @@ import Plutarch.Prelude (ClosedTerm, DerivePlutusType (..), Generic, PAsData, pfield, pfromData, pif, plam, plet, pletFields, pmatch, pto, type (:-->), (#)) import Plutarch.Unsafe (punsafeCoerce) -import PlutusCore.Data qualified as PLC import PlutusLedgerApi.V3 (CurrencySymbol) import PlutusTx qualified -import PlutusTx.Builtins.Internal qualified as BI import SmartTokens.LinkedList.Common (makeCommon, pInit, pInsert) -------------------------------- @@ -53,20 +50,6 @@ data DirectoryNodeAction PlutusTx.makeIsDataIndexed ''DirectoryNodeAction [('InitDirectory, 0), ('InsertDirectoryNode, 1)] --- instance PlutusTx.ToData DirectoryNodeAction where --- toBuiltinData = \case --- InitDirectory -> BI.dataToBuiltinData $ PLC.Constr 0 [] --- InsertDirectoryNode sym -> BI.dataToBuiltinData $ PLC.Constr 1 [PlutusTx.toData sym] - --- instance PlutusTx.FromData DirectoryNodeAction where --- fromBuiltinData (BI.builtinDataToData -> d) = case d of --- PLC.Constr 0 [] -> Just InitDirectory --- PLC.Constr 1 [PlutusTx.fromData -> Just currencySymbol] -> Just (InsertDirectoryNode currencySymbol) --- _ -> Nothing - --- instance PlutusTx.UnsafeFromData DirectoryNodeAction where --- unsafeFromBuiltinData = fromJust . PlutusTx.fromBuiltinData - deriving via (DerivePConstantViaData DirectoryNodeAction PDirectoryNodeAction) instance diff --git a/src/lib/SmartTokens/Types/PTokenDirectory.hs b/src/lib/SmartTokens/Types/PTokenDirectory.hs index 300ca92..4eb18e6 100644 --- a/src/lib/SmartTokens/Types/PTokenDirectory.hs +++ b/src/lib/SmartTokens/Types/PTokenDirectory.hs @@ -27,10 +27,10 @@ module SmartTokens.Types.PTokenDirectory ( import Generics.SOP qualified as SOP import Plutarch (Config (NoTracing)) -import Plutarch.Builtin (pasByteStr, pasConstr, pasList, pforgetData, plistData) +import Plutarch.Builtin (pasList, pforgetData, plistData) import Plutarch.Core.PlutusDataList (DerivePConstantViaDataList (..), PlutusTypeDataList, ProductIsData (..)) -import Plutarch.Core.Utils (pcond, pheadSingleton, pmkBuiltinList) +import Plutarch.Core.Utils (pheadSingleton, pmkBuiltinList) import Plutarch.DataRepr (PDataFields) import Plutarch.DataRepr.Internal (DerivePConstantViaData (..)) import Plutarch.DataRepr.Internal.Field (HRec (..), Labeled (Labeled)) @@ -277,17 +277,3 @@ pisInsertedNode = phoistAcyclic $ -- in pforgetData insertedKey #== pforgetData outputNodeDatumF.key -- #&& pforgetData coveringNext #== pforgetData ptailNextData - -pdeserializeCredential :: Term s (PAsData PCredential) -> Term s (PAsData PCredential) -pdeserializeCredential term = - plet (pasConstr # pforgetData term) $ \constrPair -> - plet (pfstBuiltin # constrPair) $ \constrIdx -> - pif (plengthBS # (pasByteStr # (pheadSingleton # (psndBuiltin # constrPair))) #== 28) - ( - pcond - [ ( constrIdx #== 0 , term) - , ( constrIdx #== 1 , term) - ] - perror - ) - perror diff --git a/src/lib/Wst/Cli.hs b/src/lib/Wst/Cli.hs index 5535ac3..b532a3f 100644 --- a/src/lib/Wst/Cli.hs +++ b/src/lib/Wst/Cli.hs @@ -26,9 +26,9 @@ runCommand com = do env <- Env.addRuntimeEnv <$> Env.loadRuntimeEnv <*> pure Env.empty result <- case com of Deploy config -> runWstApp env (deploy config) - Manage txIn com -> do + Manage txIn com_ -> do let env' = Env.addDirectoryEnvFor txIn env - runWstApp env' $ case com of + runWstApp env' $ case com_ of Status -> do -- TODO: status check (call the query endpoints and print out a summary of the results) logInfo "Manage" diff --git a/src/lib/Wst/Cli/Command.hs b/src/lib/Wst/Cli/Command.hs index e1a0ed7..a1fc695 100644 --- a/src/lib/Wst/Cli/Command.hs +++ b/src/lib/Wst/Cli/Command.hs @@ -12,9 +12,8 @@ import Convex.Wallet.Operator (OperatorConfigSigning, parseOperatorConfigSigning) import Data.String (IsString (..)) import Options.Applicative (CommandFields, Mod, Parser, ReadM, argument, - command, eitherReader, fullDesc, help, info, long, - many, metavar, optional, progDesc, short, str, - strOption, subparser, (<|>)) + command, eitherReader, fullDesc, help, info, + metavar, progDesc, subparser) import Text.Read (readMaybe) parseCommand :: Parser Command diff --git a/src/lib/Wst/Offchain.hs b/src/lib/Wst/Offchain.hs deleted file mode 100644 index d58cf2f..0000000 --- a/src/lib/Wst/Offchain.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Wst.Offchain() where - --- Add tx building, tx submission, querying functions diff --git a/src/lib/Wst/Offchain/BuildTx/Blacklist.hs b/src/lib/Wst/Offchain/BuildTx/Blacklist.hs deleted file mode 100644 index 6524701..0000000 --- a/src/lib/Wst/Offchain/BuildTx/Blacklist.hs +++ /dev/null @@ -1,2 +0,0 @@ - -module Wst.Offchain.BuildTx.Blacklist () where diff --git a/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs b/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs index 9911865..036ca51 100644 --- a/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs +++ b/src/lib/Wst/Offchain/BuildTx/DirectorySet.hs @@ -14,11 +14,9 @@ module Wst.Offchain.BuildTx.DirectorySet ( import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C -import Control.Lens (over) import Control.Monad.Reader (MonadReader, asks) -import Convex.BuildTx (MonadBuildTx, addBtx, addReference, mintPlutus, - prependTxOut, spendPlutusInlineDatum) -import Convex.CardanoApi.Lenses qualified as L +import Convex.BuildTx (MonadBuildTx, addReference, mintPlutus, prependTxOut, + spendPlutusInlineDatum) import Convex.Class (MonadBlockchain, queryNetworkId) import Convex.PlutusLedger.V1 (transStakeCredential, unTransAssetName) import Convex.Scripts (toHashableScriptData) @@ -94,10 +92,9 @@ data InsertNodeArgs = , inaIssuerLogic :: C.StakeCredential } -insertDirectoryNode :: forall era env m ctx. (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 () +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 () insertDirectoryNode UTxODat{uIn=paramsRef} UTxODat{uIn, uOut=firstTxOut, uDatum=firstTxData} InsertNodeArgs{inaNewKey, inaTransferLogic, inaIssuerLogic} = Utils.inBabbage @era $ do netId <- queryNetworkId - initialTxIn <- asks (Env.dsTxIn . Env.directoryEnv) paramsPolicyId <- asks (Env.protocolParamsPolicyId . Env.directoryEnv) directorySpendingScript <- asks (Env.dsDirectorySpendingScript . Env.directoryEnv) directoryMintingScript <- asks (Env.dsDirectoryMintingScript . Env.directoryEnv) diff --git a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs index fc32068..12bac15 100644 --- a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs @@ -193,11 +193,11 @@ seizeProgrammableToken UTxODat{uIn = paramsTxIn} UTxODat{uIn = seizingTxIn, uOut (seizedAddr, remainingValue) = case seizingTxOut of (C.TxOut a v _ _) -> - let (seized, other) = + let (_seized, other) = partition ( \case (C.AdaAssetId, _q) -> False - (C.AssetId a _, _q) -> a == seizingTokenPolicyId + (C.AssetId a_ _, _q) -> a_ == seizingTokenPolicyId ) $ toList $ C.txOutValueToValue v in (a, fromList other) @@ -241,10 +241,10 @@ seizeProgrammableToken UTxODat{uIn = paramsTxIn} UTxODat{uIn = seizingTxIn, uOut $ C.ScriptWitness C.ScriptWitnessForStakeAddr . programmableGlobalWitness -- TODO: check that the issuerTxOut is at a programmable logic payment credential -checkIssuerAddressIsProgLogicCred :: forall era ctx m. ( MonadBuildTx era m) => C.PaymentCredential -> C.TxOut ctx era -> m () -checkIssuerAddressIsProgLogicCred _progLogicCred (C.TxOut (C.AddressInEra _ (C.ShelleyAddress _ _pcred _stakeRef)) _ _ C.ReferenceScriptNone) = +_checkIssuerAddressIsProgLogicCred :: forall era ctx m. ( MonadBuildTx era m) => C.PaymentCredential -> C.TxOut ctx era -> m () +_checkIssuerAddressIsProgLogicCred _progLogicCred (C.TxOut (C.AddressInEra _ (C.ShelleyAddress _ _pcred _stakeRef)) _ _ C.ReferenceScriptNone) = pure () -checkIssuerAddressIsProgLogicCred _ _ = error "Issuer address is not a programmable logic credential" +_checkIssuerAddressIsProgLogicCred _ _ = error "Issuer address is not a programmable logic credential" isNodeWithProgrammableSymbol :: forall era. CurrencySymbol -> UTxODat era DirectorySetNode -> Bool isNodeWithProgrammableSymbol programmableTokenSymbol (uDatum -> dat) = key dat == programmableTokenSymbol diff --git a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs index 853bc08..3e6d0ab 100644 --- a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs +++ b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs @@ -181,7 +181,7 @@ transferSmartTokens paramsTxIn userCred blacklistNodes directoryList spendingUse C.AdaAssetId -> error "Ada is not programmable" transferProgrammableToken paramsTxIn txins (transPolicyId programmablePolicyId) directoryList -- Invoking the programmableBase and global scripts - addTransferWitness blacklistNodes userCred -- Proof of non-membership of the blacklist + addTransferWitness blacklistNodes -- Proof of non-membership of the blacklist -- Send outputs to destinationCred destStakeCred <- either (error . ("Could not unTrans credential: " <>) . show) pure $ unTransStakeCredential $ transCredential destinationCred @@ -287,8 +287,8 @@ checkNotBlacklisted nodes cred = case findProof nodes cred of {-| Add a proof that the user is allowed to transfer programmable tokens. Uses the user from 'HasOperatorEnv env'. Fails if the user is blacklisted. -} -addTransferWitness :: forall env era m. (MonadError (AppError era) m, MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => [UTxODat era BlacklistNode] -> C.PaymentCredential -> m () -addTransferWitness blacklistNodes clientCred = Utils.inBabbage @era $ do +addTransferWitness :: forall env era m. (MonadError (AppError era) m, MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => [UTxODat era BlacklistNode] -> m () +addTransferWitness blacklistNodes = Utils.inBabbage @era $ do opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv) -- In this case 'operator' is the user nid <- queryNetworkId transferScript <- asks (Env.tleTransferScript . Env.transferLogicEnv) @@ -298,7 +298,7 @@ addTransferWitness blacklistNodes clientCred = Utils.inBabbage @era $ do -- Finds the index of the blacklist node in the reference scripts findWitnessReferenceIndex txBody cred = - let UTxODat {uIn, uDatum = blnNodeDatum} = tryFindProof blacklistNodes cred + let UTxODat {uIn} = tryFindProof blacklistNodes cred in fromIntegral @Int @Integer $ findIndexReference uIn txBody -- Maps the credential to the index of the blacklist node in the reference scripts diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs index 55a587f..ba9d76a 100644 --- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs +++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs @@ -17,7 +17,6 @@ import Cardano.Api.Shelley qualified as C import Control.Monad (when) import Control.Monad.Except (MonadError) import Control.Monad.Reader (MonadReader, asks) -import Convex.BuildTx (payToAddress) import Convex.BuildTx qualified as BuildTx import Convex.Class (MonadBlockchain, MonadUtxoQuery) import Convex.CoinSelection qualified @@ -30,7 +29,6 @@ import Wst.Offchain.BuildTx.DirectorySet qualified as BuildTx import Wst.Offchain.BuildTx.ProgrammableLogic qualified as BuildTx import Wst.Offchain.BuildTx.ProtocolParams qualified as BuildTx import Wst.Offchain.BuildTx.TransferLogic qualified as BuildTx -import Wst.Offchain.BuildTx.TransferLogic qualified as TL import Wst.Offchain.Env qualified as Env import Wst.Offchain.Query (UTxODat (..)) import Wst.Offchain.Query qualified as Query diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs index 7aee006..da59664 100644 --- a/src/lib/Wst/Offchain/Env.hs +++ b/src/lib/Wst/Offchain/Env.hs @@ -377,8 +377,8 @@ addRuntimeEnv env e = e{ceRuntime = Identity env } withRuntime :: MonadReader (CombinedEnv o d t r era) m => RuntimeEnv -> ReaderT (CombinedEnv o d t Identity era) m a -> m a -withRuntime runtime action = - asks (addRuntimeEnv runtime) +withRuntime runtime_ action = + asks (addRuntimeEnv runtime_) >>= runReaderT action {-| Add an 'OperatorEnv' to the environment diff --git a/src/lib/Wst/Onchain.hs b/src/lib/Wst/Onchain.hs deleted file mode 100644 index e5fd3d5..0000000 --- a/src/lib/Wst/Onchain.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-| Offchain code. --} -module Wst.Onchain() where - --- add plutarch scripts diff --git a/src/wst-poc.cabal b/src/wst-poc.cabal index 3a7057c..ac1b2bd 100644 --- a/src/wst-poc.cabal +++ b/src/wst-poc.cabal @@ -73,8 +73,6 @@ library Wst.Cli Wst.Cli.Command Wst.Client - Wst.Offchain - Wst.Offchain.BuildTx.Blacklist Wst.Offchain.BuildTx.DirectorySet Wst.Offchain.BuildTx.LinkedList Wst.Offchain.BuildTx.ProgrammableLogic @@ -84,7 +82,6 @@ library Wst.Offchain.Env Wst.Offchain.Query Wst.Offchain.Scripts - Wst.Onchain Wst.Server Wst.Server.Endpoints Wst.Server.Types @@ -97,16 +94,11 @@ library , Blammo , blockfrost-api , blockfrost-client-core - , bytestring , cardano-api - , cardano-ledger-api - , cardano-ledger-shelley , containers , convex-base , convex-blockfrost , convex-coin-selection - , convex-mockchain - , convex-node-client , convex-optics , convex-wallet , generics-sop