Clean up

.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
 

.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:

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 = [ ];

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)

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

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

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"

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

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)

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

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

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

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

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