From c0e3f28c2ec1b9cb80423471b2820127112cf697 Mon Sep 17 00:00:00 2001
From: Amir Rad <ahmr10@gmail.com>
Date: Wed, 25 Dec 2024 01:04:54 +0000
Subject: [PATCH] Sezing endpoint/unit test & fixes to transfer

---
 .../Contracts/ExampleTransferLogic.hs         |  15 +--
 .../Contracts/ProgrammableLogicBase.hs        |  16 +--
 src/lib/SmartTokens/Types/PTokenDirectory.hs  |  27 +----
 .../Wst/Offchain/BuildTx/ProgrammableLogic.hs |  91 +++++++---------
 src/lib/Wst/Offchain/BuildTx/TransferLogic.hs | 103 +++++++++++-------
 src/lib/Wst/Offchain/Endpoints/Deployment.hs  |  18 +--
 src/lib/Wst/Offchain/Env.hs                   |  67 ++++++++----
 src/lib/Wst/Offchain/Scripts.hs               |  14 +--
 src/test/Wst/Test/Env.hs                      |  13 ++-
 src/test/Wst/Test/UnitTest.hs                 |  84 ++++++++++++--
 10 files changed, 265 insertions(+), 183 deletions(-)

diff --git a/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs b/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs
index afd0d15..aa8551d 100644
--- a/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs
+++ b/src/lib/SmartTokens/Contracts/ExampleTransferLogic.hs
@@ -33,9 +33,9 @@ import SmartTokens.Types.PTokenDirectory ( PBlacklistNode, pletFieldsBlacklistNo
 import qualified PlutusTx
 import Plutarch.DataRepr (DerivePConstantViaData (..))
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
-import qualified Generics.SOP as SOP
-import Plutarch.Core.PlutusDataList (ProductIsData)
 
+-- >>> _printTerm $ unsafeEvalTerm NoTracing (pconstant $ NonmembershipProof 1)
+-- "program 1.0.0 (Constr 0 [I 1])"
 data BlacklistProof
   = NonmembershipProof Integer
   deriving stock (Show, Eq, Generic)
@@ -43,12 +43,13 @@ data BlacklistProof
 PlutusTx.makeIsDataIndexed ''BlacklistProof
   [('NonmembershipProof, 0)]
 
-
 deriving via
   (DerivePConstantViaData BlacklistProof PBlacklistProof)
   instance
     (PConstantDecl BlacklistProof)
 
+-- >>> _printTerm $ unsafeEvalTerm NoTracing (mkRecordConstr PNonmembershipProof ( #nodeIdx .= pdata (pconstant 1)))
+-- "program 1.0.0 (Constr 0 [I 1])"
 data PBlacklistProof (s :: S)
   = PNonmembershipProof
       ( Term
@@ -59,7 +60,7 @@ data PBlacklistProof (s :: S)
           )
       )
   deriving stock (Generic)
-  deriving anyclass (PlutusType, PIsData, PEq)
+  deriving anyclass (PlutusType, PIsData, PEq, PShow)
 
 instance DerivePlutusType PBlacklistProof where
   type DPTStrat _ = PlutusTypeData
@@ -111,7 +112,7 @@ mkPermissionedTransfer = plam $ \permissionedCred ctx ->
       first node and lexographically less than the key of the second node (and thus if it was in the blacklist those two nodes 
       would not be adjacent).
     - Confirms the legitimacy of both directory entries by checking the presence of the directory node currency symbol.
-  - For 'PNonmembershipProofTail':
+  - For 'PNonmembershipProofTail': FIXME: outdated
     - Ensures that the witness key is greater than the tail node key in the blacklist.
     - Confirms the legitimacy of the directory entry by checking the presence of the directory node currency symbol.
 
@@ -138,7 +139,7 @@ pvalidateWitnesses = phoistAcyclic $ plam $ \blacklistNodeCS proofs refInputs wi
                       -- the currency symbol is not in the blacklist
                       nodeKey #< witnessKey
                       , witnessKey #< nodeNext #|| nodeNext #== pconstant ""
-                      -- both directory entries are legitimate, this is proven by the 
+                      -- directory entries are legitimate, this is proven by the 
                       -- presence of the directory node currency symbol.
                       , phasDataCS # blacklistNodeCS # pfromData prevNodeUTxOF.value
                       ]
@@ -186,5 +187,5 @@ mkFreezeAndSeizeTransfer = plam $ \blacklistNodeCS ctx -> P.do
             ) # pto (pfromData infoF.wdrl)
   pvalidateConditions
     [ pisRewarding ctxF.scriptInfo
-    -- , pvalidateWitnesses # blacklistNodeCS # red # infoF.referenceInputs # txWitnesses
+    , pvalidateWitnesses # blacklistNodeCS # red # infoF.referenceInputs # txWitnesses
     ]
diff --git a/src/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs b/src/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs
index 8ccd087..e4d827c 100644
--- a/src/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs
+++ b/src/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs
@@ -42,14 +42,12 @@ import Plutarch.Prelude (ClosedTerm, DerivePlutusType (..), Generic, PAsData,
                          S, Term, pcon, pconstant, pdata, pelem, perror, pfield,
                          pfix, pfromData, pfstBuiltin, phoistAcyclic, pif, plam,
                          plet, pletFields, pmap, pmatch, pnot, psndBuiltin, pto,
-                         ptraceInfo, type (:-->), (#$), (#), (#||), ptraceInfoError, ptraceDebugError)
+                         ptraceInfo, type (:-->), (#$), (#), (#||), PShow)
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1.Value (Value)
 import PlutusTx qualified
 import SmartTokens.Types.ProtocolParams (PProgrammableLogicGlobalParams)
 import SmartTokens.Types.PTokenDirectory (PDirectorySetNode)
-import Plutarch.Show (pshow)
-import Plutarch.Prelude (PShow, plength)
 
 -- | Strip Ada from a ledger value
 -- Importantly this function assumes that the Value is provided by the ledger (i.e. via the ScriptContext)
@@ -369,7 +367,7 @@ mkProgrammableLogicGlobal = plam $ \protocolParamsCS ctx -> P.do
   progLogicCred <- plet protocolParamsF.progLogicCred
 
   ptraceInfo "Extracting invoked scripts"
-  let invokedScripts =
+  invokedScripts <- plet $ 
         pmap @PBuiltinList
           # plam (\wdrlPair ->
                     let cred = pfstBuiltin # wdrlPair
@@ -379,7 +377,6 @@ mkProgrammableLogicGlobal = plam $ \protocolParamsCS ctx -> P.do
 
   pmatch red $ \case
     PTransferAct ((pfield @"proofs" #) -> proofs) -> P.do
-      ptraceInfo "PTransferAct valueFromCred"
       totalProgTokenValue <-
         plet $ pvalueFromCred
                 # progLogicCred
@@ -394,7 +391,6 @@ mkProgrammableLogicGlobal = plam $ \protocolParamsCS ctx -> P.do
                 # invokedScripts
                 # totalProgTokenValue
 
-      -- ptraceInfo "PTransferAct validateConditions"
       pvalidateConditions
           [ pisRewarding ctxF.scriptInfo
           , pcheckTransferLogic
@@ -417,13 +413,13 @@ mkProgrammableLogicGlobal = plam $ \protocolParamsCS ctx -> P.do
           directoryNodeUTxO = pelemAtFast @PBuiltinList # referenceInputs # pfromData seizeActF.directoryNodeIdx
       seizeDirectoryNode <- pletFields @'["value", "datum"] (pfield @"resolved" # directoryNodeUTxO)
       POutputDatum ((pfield @"outputDatum" #) -> seizeDat') <- pmatch seizeDirectoryNode.datum
-      directoryNodeDatumF <- pletFields @'["key", "next", "transferLogicScript", "issuerLogicScript"] (punsafeCoerce @_ @_ @PDirectorySetNode (pto seizeDat'))
+      directoryNodeDatumF <- pletFields @'["key", "next", "transferLogicScript", "issuerLogicScript"] (punsafeCoerce @_ @_ @(PAsData PDirectorySetNode) (pto seizeDat'))
 
       seizeInputF <- pletFields @'["address", "value", "datum"] seizeInput
       seizeInputAddress <- plet seizeInputF.address
 
       seizeInputValue <- plet $ pfromData seizeInputF.value
-      seizeOutputValue <- plet $ pfilterCSFromValue # seizeInputValue # directoryNodeDatumF.key
+      expectedSeizeOutputValue <- plet $ pfilterCSFromValue # seizeInputValue # directoryNodeDatumF.key
 
       let expectedSeizeOutput =
             pdata $
@@ -432,7 +428,7 @@ mkProgrammableLogicGlobal = plam $ \protocolParamsCS ctx -> P.do
                 ( #address
                     .= seizeInputF.address
                     .& #value
-                    .= pdata seizeOutputValue
+                    .= pdata expectedSeizeOutputValue
                     .& #datum
                     .= seizeInputF.datum
                     .& #referenceScript
@@ -452,7 +448,7 @@ mkProgrammableLogicGlobal = plam $ \protocolParamsCS ctx -> P.do
           -- back to the mkProgrammableLogicBase script without modifying it (thus preventing any others from spending
           -- that UTxO in that block). Or using it to repeatedly spend a programmable token UTxO that does have the programmable token back back to
           -- the mkProgrammableLogicBase script without removing the programmable token associated with the `issuerLogicCredential`.
-          , pnot # (pdata seizeInputValue #== pdata seizeOutputValue)
+          , pnot # (pdata seizeInputValue #== pdata expectedSeizeOutputValue)
           ]
 
 
diff --git a/src/lib/SmartTokens/Types/PTokenDirectory.hs b/src/lib/SmartTokens/Types/PTokenDirectory.hs
index 2ac5d51..a8b118a 100644
--- a/src/lib/SmartTokens/Types/PTokenDirectory.hs
+++ b/src/lib/SmartTokens/Types/PTokenDirectory.hs
@@ -25,47 +25,22 @@ module SmartTokens.Types.PTokenDirectory (
   BlacklistNode(..),
 ) where
 
-import Data.Text qualified as T
 import Generics.SOP qualified as SOP
-import GHC.Stack (HasCallStack)
 import Plutarch (Config (NoTracing))
 import Plutarch.Builtin (pasByteStr, pasConstr, pasList, pforgetData, plistData)
 import Plutarch.Core.PlutusDataList (DerivePConstantViaDataList (..),
                                      PlutusTypeDataList, ProductIsData (..))
 import Plutarch.Core.Utils (pcond, pheadSingleton, pmkBuiltinList)
 import Plutarch.DataRepr (PDataFields)
-import Plutarch.DataRepr.Internal (DerivePConstantViaData (..), PDataRecord,
-                                   PLabeledType ((:=)), PlutusTypeData)
+import Plutarch.DataRepr.Internal (DerivePConstantViaData (..))
 import Plutarch.DataRepr.Internal.Field (HRec (..), Labeled (Labeled))
 import Plutarch.Evaluate (unsafeEvalTerm)
-import Plutarch.Internal qualified as PI
-import Plutarch.Internal.Other (printScript)
 import Plutarch.LedgerApi.V3 (PCredential, PCurrencySymbol)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted))
 import Plutarch.Prelude
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V3 (BuiltinByteString, Credential, CurrencySymbol)
 import PlutusTx (Data (B, Constr), FromData, ToData, UnsafeFromData)
-import SmartTokens.CodeLens (_printTerm)
-import PlutusLedgerApi.Data.V3 (Credential(PubKeyCredential))
-import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
-import qualified Data.Tuple as BI
-import PlutusTx.IsData.Class (ToData(toBuiltinData))
-import qualified PlutusTx.Builtins as BI
-import PlutusLedgerApi.V1 (FromData(fromBuiltinData), PubKeyHash (..))
-import PlutusTx.Builtins.HasOpaque (stringToBuiltinByteString)
-
-{- 
->>> _printTerm $ unsafeEvalTerm NoTracing (pconstant blacklistInitialNode)
-"program\n  1.0.0\n  (List [B #, B #ffffffffffffffffffffffffffffffffffffffffffffffffffffffff])"
--}
-blacklistInitialNode :: BlacklistNode
-blacklistInitialNode = 
-  BlacklistNode 
-    -- FIXME: fix this hacky bstr
-    { blnNext= case PubKeyCredential  "ffffffffffffffffffffffffffffffffffffffffffffffffffffffff" of
-                  PubKeyCredential (PubKeyHash bstr) -> bstr
-    , blnKey= ""}
 
 data BlacklistNode =
   BlacklistNode {
diff --git a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs
index 1589ddf..fc32068 100644
--- a/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs
+++ b/src/lib/Wst/Offchain/BuildTx/ProgrammableLogic.hs
@@ -18,20 +18,20 @@ where
 
 import Cardano.Api qualified as C
 import Cardano.Api.Shelley qualified as C
-import Control.Lens (over, (^.))
+import Control.Lens ((^.))
 import Control.Monad.Reader (MonadReader, asks)
-import Convex.BuildTx (MonadBuildTx, addBtx, addReference,
-                       addWithdrawalWithTxBody, buildScriptWitness,
-                       findIndexReference, findIndexSpending, mintPlutus,
-                       prependTxOut, spendPlutusInlineDatum)
+import Convex.BuildTx (MonadBuildTx, addReference, addWithdrawalWithTxBody,
+                       buildScriptWitness, findIndexReference,
+                       findIndexSpending, mintPlutus, prependTxOut,
+                       spendPlutusInlineDatum)
 import Convex.CardanoApi.Lenses as L
 import Convex.Class (MonadBlockchain (queryNetworkId))
 import Convex.PlutusLedger.V1 (transPolicyId, unTransCredential,
                                unTransPolicyId)
-import Convex.Scripts (toHashableScriptData)
 import Convex.Utils qualified as Utils
 import Data.Foldable (find, maximumBy, traverse_)
 import Data.Function (on)
+import Data.List (partition)
 import Data.Maybe (fromJust)
 import GHC.Exts (IsList (..))
 import PlutusLedgerApi.V3 (CurrencySymbol (..))
@@ -42,11 +42,10 @@ import SmartTokens.Types.ProtocolParams
 import SmartTokens.Types.PTokenDirectory (DirectorySetNode (..))
 import Wst.Offchain.BuildTx.DirectorySet (InsertNodeArgs (..),
                                           insertDirectoryNode)
-import Wst.Offchain.Env (DirectoryEnv (..), TransferLogicEnv (..))
+import Wst.Offchain.Env (TransferLogicEnv (..))
 import Wst.Offchain.Env qualified as Env
 import Wst.Offchain.Query (UTxODat (..))
-import Wst.Offchain.Scripts (alwaysSucceedsScript, programmableLogicBaseScript,
-                             programmableLogicGlobalScript,
+import Wst.Offchain.Scripts (alwaysSucceedsScript,
                              programmableLogicMintingScript)
 
 data IssueNewTokenArgs = IssueNewTokenArgs
@@ -86,10 +85,7 @@ issueProgrammableToken paramsTxOut (an, q) IssueNewTokenArgs{intaMintingLogic, i
 
   progLogicScriptCredential <- either (const $ error "could not parse protocol params") pure $ unTransCredential progLogicCred
   directoryNodeSymbol <- either (const $ error "could not parse protocol params") pure $ unTransPolicyId directoryNodeCS
-  --
-  -- DirectoryEnv{dsProgrammableLogicBaseScript} <- asks Env.directoryEnv
 
-  -- TODO: maybe move programmableLogicMintingScript to DirectoryEnv
   let mintingScript = programmableLogicMintingScript progLogicScriptCredential (C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion intaMintingLogic) directoryNodeSymbol
       issuedPolicyId = C.scriptPolicyId $ C.PlutusScript C.PlutusScriptV3 mintingScript
       issuedSymbol = transPolicyId issuedPolicyId
@@ -98,18 +94,6 @@ issueProgrammableToken paramsTxOut (an, q) IssueNewTokenArgs{intaMintingLogic, i
         maximumBy (compare `on` (key . uDatum)) $
           filter ((<= issuedSymbol) . key . uDatum) directoryList
 
-      -- receivingAddress =
-      --   C.makeShelleyAddressInEra
-      --     C.shelleyBasedEra
-      --     netId
-      --     (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.plutusScriptVersion dsProgrammableLogicBaseScript)
-      --     C.NoStakeAddress -- FIXME: use owner credential
-
-      -- receivingVal = C.TxOutValueShelleyBased C.shelleyBasedEra $ C.toLedgerValue @era C.maryBasedEra
-      --   $ fromList [(C.AssetId issuedPolicyId an, q)]
-
-      -- dat = C.TxOutDatumInline C.babbageBasedEra $ toHashableScriptData () -- TODO: What should the datum be?
-
   if key dirNodeData == issuedSymbol
     then
       mintPlutus mintingScript MintPToken an q
@@ -124,9 +108,6 @@ issueProgrammableToken paramsTxOut (an, q) IssueNewTokenArgs{intaMintingLogic, i
       mintPlutus mintingScript RegisterPToken an q
       insertDirectoryNode paramsTxOut udat nodeArgs
 
-      -- add programmable logic output
-      -- prependTxOut $ C.TxOut receivingAddress receivingVal dat C.ReferenceScriptNone
-
   pure issuedPolicyId
 
 {- User facing transfer of programmable tokens from one address to another.
@@ -193,37 +174,37 @@ transferProgrammableToken paramsTxIn tokenTxIns programmableTokenSymbol director
    NOTE: Seems the issuer is only able to seize 1 UTxO at a time.
    In the future we should allow multiple UTxOs in 1 Tx.
 -}
-seizeProgrammableToken :: forall a env era m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era a -> UTxODat era a -> C.PolicyId -> [UTxODat era DirectorySetNode] -> m ()
-seizeProgrammableToken UTxODat{uIn = seizingTxIn, uOut = seizingTxOut} UTxODat{uIn = issuerTxIn, uOut = issuerTxOut} seizingTokenPolicyId directoryList = Utils.inBabbage @era $ do
+seizeProgrammableToken :: forall a env era m. (MonadReader env m, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era ProgrammableLogicGlobalParams -> UTxODat era a -> C.PolicyId -> [UTxODat era DirectorySetNode] -> m ()
+seizeProgrammableToken UTxODat{uIn = paramsTxIn} UTxODat{uIn = seizingTxIn, uOut = seizingTxOut} seizingTokenPolicyId directoryList = Utils.inBabbage @era $ do
   nid <- queryNetworkId
-  paramsPolId <- asks (Env.protocolParamsPolicyId . Env.directoryEnv)
-  paramsTxIn <- asks (Env.dsTxIn . Env.directoryEnv)
+  globalStakeScript <- asks (Env.dsProgrammableLogicGlobalScript . Env.directoryEnv)
+  baseSpendingScript <- asks (Env.dsProgrammableLogicBaseScript . Env.directoryEnv)
 
-  let globalStakeScript = programmableLogicGlobalScript paramsPolId
-      globalStakeCred = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 globalStakeScript
-      baseSpendingScript = programmableLogicBaseScript globalStakeCred
+  let globalStakeCred = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 globalStakeScript
 
   -- Finds the directory node entry that references the programmable token symbol
   dirNodeRef <-
     maybe (error "Cannot seize non-programmable token. Entry does not exist in directoryList") (pure . uIn) $
       find (isNodeWithProgrammableSymbol (transPolicyId seizingTokenPolicyId)) directoryList
 
-  checkIssuerAddressIsProgLogicCred (C.PaymentCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 baseSpendingScript) issuerTxOut
+  -- destStakeCred <- either (error . ("Could not unTrans credential: " <>) . show) pure $ unTransStakeCredential $ transCredential seizeDestinationCred
+  let
+      -- issuerDestinationAddress = C.makeShelleyAddressInEra C.shelleyBasedEra nid progLogicBaseCred (C.StakeAddressByValue destStakeCred)
 
-  let seizedValue = case seizingTxOut of
-        (C.TxOut _ v _ _) ->
-          C.filterValue
-            ( \case
-                C.AdaAssetId -> True
-                C.AssetId a _ -> a == seizingTokenPolicyId
-            )
-            $ C.txOutValueToValue v
+      (seizedAddr, remainingValue) = case seizingTxOut of
+        (C.TxOut a v _ _) ->
+          let (seized, other) =
+                  partition
+                    ( \case
+                        (C.AdaAssetId, _q) -> False
+                        (C.AssetId a _, _q) -> a == seizingTokenPolicyId
+                    )
+                    $ toList $ C.txOutValueToValue v
+          in (a, fromList other)
 
-      (issuerOutAddr, issuerOutVal) = case issuerTxOut of
-        (C.TxOut a (C.txOutValueToValue -> v) _ _) ->
-          (a, C.TxOutValueShelleyBased C.shelleyBasedEra $ C.toLedgerValue @era C.maryBasedEra (v <> seizedValue))
+      remainingTxOutValue = C.TxOutValueShelleyBased C.shelleyBasedEra $ C.toLedgerValue @era C.maryBasedEra remainingValue
 
-      seizedIssuerOutput = C.TxOut issuerOutAddr issuerOutVal C.TxOutDatumNone C.ReferenceScriptNone
+      seizedOutput = C.TxOut seizedAddr remainingTxOutValue C.TxOutDatumNone C.ReferenceScriptNone
 
       -- Finds the index of the directory node reference in the transaction ref
       -- inputs
@@ -231,27 +212,29 @@ seizeProgrammableToken UTxODat{uIn = seizingTxIn, uOut = seizingTxOut} UTxODat{u
         fromIntegral @Int @Integer $ findIndexReference dirNodeRef txBody
 
       -- Finds the index of the issuer input in the transaction body
-      issuerInputIndex txBody =
-        fromIntegral @Int @Integer $ findIndexSpending issuerTxIn txBody
+      seizingInputIndex txBody =
+        fromIntegral @Int @Integer $ findIndexSpending seizingTxIn txBody
 
       -- Finds the index of the issuer seized output in the transaction body
-      issueOutputIndex txBody =
-        fromIntegral @Int @Integer $ fst $ fromJust (find ((== seizedIssuerOutput) . snd) $ zip [0 ..] $ txBody ^. L.txOuts)
+      seizingOutputIndex txBody =
+        fromIntegral @Int @Integer $ fst $ fromJust (find ((== seizedOutput) . snd ) $ zip [0 ..] $ txBody ^. L.txOuts)
 
       -- The seizing redeemer for the global script
       programmableLogicGlobalRedeemer txBody =
         SeizeAct
-          { plgrSeizeInputIdx = issuerInputIndex txBody,
-            plgrSeizeOutputIdx = issueOutputIndex txBody,
+          { plgrSeizeInputIdx = seizingInputIndex txBody,
+            plgrSeizeOutputIdx = seizingOutputIndex txBody,
             plgrDirectoryNodeIdx = directoryNodeReferenceIndex txBody
           }
 
       programmableGlobalWitness txBody = buildScriptWitness globalStakeScript C.NoScriptDatumForStake (programmableLogicGlobalRedeemer txBody)
 
+  prependTxOut seizedOutput
   addReference paramsTxIn -- Protocol Params TxIn
   addReference dirNodeRef -- Directory Node TxIn
   spendPlutusInlineDatum seizingTxIn baseSpendingScript () -- Redeemer is ignored in programmableLogicBase
-  addBtx (over L.txOuts (seizedIssuerOutput :)) -- Add the seized output to the transaction
+  -- QUESTION: why do we have to spend an issuer output?
+  -- spendPlutusInlineDatum issuerTxIn baseSpendingScript () -- Redeemer is ignored in programmableLogicBase
   addWithdrawalWithTxBody -- Add the global script witness to the transaction
     (C.makeStakeAddress nid globalStakeCred)
     (C.Quantity 0)
diff --git a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs
index e019aab..0715d82 100644
--- a/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs
+++ b/src/lib/Wst/Offchain/BuildTx/TransferLogic.hs
@@ -14,20 +14,24 @@ where
 
 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, addReference, addRequiredSignature,
-                       addScriptWithdrawal, addWithdrawalWithTxBody,
-                       buildScriptWitness, findIndexReference, mintPlutus,
-                       payToAddress, prependTxOut, spendPlutusInlineDatum)
+import Convex.BuildTx (MonadBuildTx (addTxBuilder), TxBuilder (TxBuilder),
+                       addReference, addRequiredSignature, addScriptWithdrawal,
+                       addWithdrawalWithTxBody, buildScriptWitness,
+                       findIndexReference, mintPlutus, payToAddress,
+                       prependTxOut, spendPlutusInlineDatum)
+import Convex.CardanoApi.Lenses qualified as L
 import Convex.Class (MonadBlockchain (queryNetworkId))
 import Convex.PlutusLedger.V1 (transCredential, transPolicyId,
-                               unTransStakeCredential)
+                               transStakeCredential, unTransStakeCredential)
 import Convex.Scripts qualified as C
 import Convex.Utils qualified as Utils
 import Convex.Utxos (UtxoSet (UtxoSet))
 import Convex.Wallet (selectMixedInputsCovering)
 import Data.Foldable (maximumBy)
 import Data.Function (on)
+import Data.List (nub, sort)
 import Data.Monoid (Last (..))
 import GHC.Exts (IsList (..))
 import PlutusLedgerApi.Data.V3 (Credential (..), PubKeyHash (PubKeyHash),
@@ -58,14 +62,11 @@ intaFromEnv = do
 {-
 >>> _printTerm $ unsafeEvalTerm NoTracing (pconstant blacklistInitialNode)
 "program\n  1.0.0\n  (List [B #, B #ffffffffffffffffffffffffffffffffffffffffffffffffffffffff])"
-
 -}
 blacklistInitialNode :: BlacklistNode
 blacklistInitialNode =
   BlacklistNode
-    -- FIXME: fix this hacky bstr
-    { blnNext= case PubKeyCredential  "ffffffffffffffffffffffffffffffffffffffffffffffffffffffff" of
-                  PubKeyCredential (PubKeyHash bstr) -> bstr
+    { blnNext= ""
     , blnKey= ""}
 
 initBlacklist :: forall era env 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) => m ()
@@ -189,10 +190,12 @@ transferSmartTokens paramsTxIn userCred blacklistNodes directoryList spendingUse
       returnOutput = C.TxOut returnAddr returnVal C.TxOutDatumNone C.ReferenceScriptNone
   prependTxOut returnOutput -- Add the seized output to the transaction
 
-seizeSmartTokens :: forall env era a m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era a -> UTxODat era a -> [UTxODat era DirectorySetNode] -> C.PaymentCredential -> m ()
-seizeSmartTokens seizingTxo issuerTxo directoryList destinationCred = Utils.inBabbage @era $ do
-  -- Add issuer and programmableLogic witnesses
-  let Last maybeProgAsset = case uOut seizingTxo of
+seizeSmartTokens :: forall env era a m. (MonadReader env m, Env.HasOperatorEnv era env, Env.HasTransferLogicEnv env, Env.HasDirectoryEnv env, C.IsBabbageBasedEra era, MonadBlockchain era m, C.HasScriptLanguageInEra C.PlutusScriptV3 era, MonadBuildTx era m) => UTxODat era ProgrammableLogicGlobalParams -> UTxODat era a -> C.PaymentCredential -> [UTxODat era DirectorySetNode] -> m ()
+seizeSmartTokens paramsTxIn seizingTxo destinationCred directoryList = Utils.inBabbage @era $ do
+  nid <- queryNetworkId
+
+  let -- NOTE: Assumes only a single programmable token per UTxO is allowed
+      Last maybeProgAsset = case uOut seizingTxo of
         (C.TxOut _a v _d _r) ->
           foldMap
             ( \case
@@ -202,17 +205,19 @@ seizeSmartTokens seizingTxo issuerTxo directoryList destinationCred = Utils.inBa
             (toList $ C.txOutValueToValue v)
 
   (progTokenPolId, an, q) <- maybe (error "No programmable token found in seizing transaction") pure maybeProgAsset
-
-  seizeProgrammableToken seizingTxo issuerTxo progTokenPolId directoryList
+  seizeProgrammableToken paramsTxIn seizingTxo progTokenPolId directoryList
   addSeizeWitness
 
-  -- Send seized funds to destinationCred
-  let -- NOTE: Assumes only a single programmable token per UTxO is allowed
+  progLogicBaseCred <- asks (Env.programmableLogicBaseCredential . Env.directoryEnv)
+  destStakeCred <- either (error . ("Could not unTrans credential: " <>) . show) pure $ unTransStakeCredential $ transCredential destinationCred
+  let
+      destinationAddress = C.makeShelleyAddressInEra C.shelleyBasedEra nid progLogicBaseCred (C.StakeAddressByValue destStakeCred)
+
+      -- NOTE: Assumes only a single programmable token per UTxO is allowed
       seizedVal = fromList [(C.AssetId progTokenPolId an, q)]
-      issuerAddr = case uOut issuerTxo of
-        (C.TxOut a _v _d _r) -> a
 
-  payToAddress issuerAddr seizedVal
+  -- Send seized funds to destinationCred
+  payToAddress destinationAddress seizedVal
 
 addIssueWitness :: forall era env 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) => m ()
 addIssueWitness = Utils.inBabbage @era $ do
@@ -227,34 +232,58 @@ addTransferWitness blacklistNodes clientCred = 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)
+
   let
       transferStakeCred = C.StakeCredentialByScript $ C.hashScript $ C.PlutusScript C.PlutusScriptV3 transferScript
 
-      UTxODat {uIn = blnNodeRef, uDatum = blnNodeDatum} =
-        maximumBy (compare `on` (blnKey . uDatum)) $
-          filter ((<= unwrapCredential (transCredential clientCred)) . blnKey . uDatum) blacklistNodes
+      -- TODO: This can be moved out as a helper function
+      findProof cred =
+          maximumBy (compare `on` (blnKey . uDatum)) $
+            filter ((<= unwrapCredential cred) . blnKey . uDatum) blacklistNodes
+
+      -- Finds the index of the blacklist node in the reference scripts
+      findWitnessReferenceIndex txBody cred =
+        let  UTxODat {uIn, uDatum = blnNodeDatum} = findProof cred
+        in if blnKey blnNodeDatum == unwrapCredential cred
+                 -- fromIntegral @Int @Integer $ findIndexReference uIn txBody
+            then error "Credential is blacklisted" -- TODO: handle this and other error cases properly
+            else fromIntegral @Int @Integer $ findIndexReference uIn txBody
+
+      -- Extracts the credentials that can be used for a transfer from the transaction body
+      transferWitnesses txBody =
+        let wdrls = case txBody ^. L.txWithdrawals of
+                      -- Maybe `sort` here is redundant if txWithdrawals are already sorted
+                      C.TxWithdrawals _ wdrls' -> sort $ map (\(stkAddr,_,_) -> transStakeCredential $ C.stakeAddressCredential stkAddr) wdrls'
+                      _ -> []
 
-      -- Finds the index of the blacklist node reference in the transaction ref
-      -- inputs
-      blacklistNodeReferenceIndex txBody =
-        fromIntegral @Int @Integer $ findIndexReference blnNodeRef txBody
+            signatories = case txBody ^. L.txExtraKeyWits of
+                            C.TxExtraKeyWitnesses _ pkhs -> map (transCredential . C.PaymentCredentialByKey) pkhs
+                            _ -> []
 
-      -- The redeemer for the transfer script based on whether a blacklist node
-      -- exists with the client credential
-      transferRedeemer txBody =
-        if blnKey blnNodeDatum == unwrapCredential (transCredential clientCred)
-          then error "Credential is blacklisted" -- TODO: handle this and other error cases properly
-          else NonmembershipProof $ blacklistNodeReferenceIndex txBody
+        in wdrls <> signatories
+
+      -- Maps the credential to the index of the blacklist node in the reference scripts
+      witnessReferences txBody = map (uIn . findProof) $ transferWitnesses txBody
+
+      -- Maps the credential to the index of the blacklist node in the reference scripts and wraps in redeemer
+      transferRedeemer txBody = map (NonmembershipProof . findWitnessReferenceIndex txBody) $ transferWitnesses txBody
+
+      -- Builds the script witness for the transfer
+      transferStakeWitness txBody = buildScriptWitness transferScript C.NoScriptDatumForStake (transferRedeemer txBody)
 
-      -- TODO: extend this to handle multiple proofs (i.e. transfers) per tx, onchain allows it
-      transferWitness txBody = buildScriptWitness transferScript C.NoScriptDatumForStake [transferRedeemer txBody]
 
   addRequiredSignature opPkh
-  addReference blnNodeRef -- Add the blacklist node reference to the transaction
+  -- addReference blnNodeRef -- Add the blacklist node reference to the transaction
+  addReferencesWithTxBody witnessReferences
   addWithdrawalWithTxBody -- Add the global script witness to the transaction
     (C.makeStakeAddress nid transferStakeCred)
     (C.Quantity 0)
-    $ C.ScriptWitness C.ScriptWitnessForStakeAddr . transferWitness
+    $ C.ScriptWitness C.ScriptWitnessForStakeAddr . transferStakeWitness
+
+addReferencesWithTxBody :: (MonadBuildTx era m, C.IsBabbageBasedEra era) => (C.TxBodyContent C.BuildTx era -> [C.TxIn]) -> m ()
+addReferencesWithTxBody f =
+  addTxBuilder (TxBuilder $ \body -> over (L.txInsReference . L._TxInsReferenceIso) (nub . (f body <>)))
+
 
 addSeizeWitness :: forall env 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) => m ()
 addSeizeWitness = Utils.inBabbage @era $ do
diff --git a/src/lib/Wst/Offchain/Endpoints/Deployment.hs b/src/lib/Wst/Offchain/Endpoints/Deployment.hs
index 641561f..9166f08 100644
--- a/src/lib/Wst/Offchain/Endpoints/Deployment.hs
+++ b/src/lib/Wst/Offchain/Endpoints/Deployment.hs
@@ -17,6 +17,7 @@ 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
@@ -82,7 +83,7 @@ issueProgrammableTokenTx issueTokenArgs assetName quantity = do
   directory <- Query.registryNodes @era
   paramsNode <- Query.globalParamsNode @era
   (tx, _) <- Env.balanceTxEnv_ $ do
-    _ <- BuildTx.issueProgrammableToken paramsNode (assetName, quantity) issueTokenArgs directory
+    polId <- BuildTx.issueProgrammableToken paramsNode (assetName, quantity) issueTokenArgs directory
 
     let hsh = C.hashScript (C.PlutusScript C.plutusScriptVersion $ BuildTx.intaMintingLogic issueTokenArgs)
     BuildTx.addScriptWithdrawal hsh 0 $ BuildTx.buildScriptWitness (BuildTx.intaMintingLogic issueTokenArgs) C.NoScriptDatumForStake ()
@@ -91,7 +92,7 @@ issueProgrammableTokenTx issueTokenArgs assetName quantity = do
 deployBlacklistTx :: (MonadReader env m, Env.HasOperatorEnv era env, MonadBlockchain era m, MonadError (AppError era) m, C.IsBabbageBasedEra era, C.HasScriptLanguageInEra C.PlutusScriptV3 era) => m (C.Tx era)
 deployBlacklistTx = do
   opEnv <- asks Env.operatorEnv
-  (tx, _) <- Env.withEnv $ Env.withOperator opEnv
+  (tx, _) <- Env.withEnv $ Env.withOperator opEnv $ Env.withTransferFromOperator
               $ Env.balanceTxEnv_ BuildTx.initBlacklist
   pure (Convex.CoinSelection.signBalancedTxBody [] tx)
 
@@ -174,6 +175,7 @@ seizeCredentialAssetsTx :: forall era env m.
   ( MonadReader env m
   , Env.HasOperatorEnv era env
   , Env.HasTransferLogicEnv env
+  , Env.HasDirectoryEnv env
   , MonadBlockchain era m
   , MonadError (AppError era) m
   , C.IsBabbageBasedEra era
@@ -183,8 +185,10 @@ seizeCredentialAssetsTx :: forall era env m.
   => C.PaymentCredential -- ^ Source/User credential
   -> m (C.Tx era)
 seizeCredentialAssetsTx sanctionedCred = do
-  pure undefined
-  -- blacklist <- Query.blacklistNodes @era
-  -- (tx, _) <- Env.balanceTxEnv_ $ do
-  --   BuildTx.insertBlacklistNode sanctionedCred blacklist
-  -- pure (Convex.CoinSelection.signBalancedTxBody [] tx)
+  opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
+  directory <- Query.registryNodes @era
+  seizeTxo <- head <$> Query.userProgrammableOutputs sanctionedCred
+  paramsTxIn <- Query.globalParamsNode @era
+  (tx, _) <- Env.balanceTxEnv_ $ do
+    BuildTx.seizeSmartTokens paramsTxIn seizeTxo (C.PaymentCredentialByKey opPkh) directory
+  pure (Convex.CoinSelection.signBalancedTxBody [] tx)
diff --git a/src/lib/Wst/Offchain/Env.hs b/src/lib/Wst/Offchain/Env.hs
index b3d497d..48ffcb6 100644
--- a/src/lib/Wst/Offchain/Env.hs
+++ b/src/lib/Wst/Offchain/Env.hs
@@ -32,6 +32,11 @@ module Wst.Offchain.Env(
   -- * Transfer logic environment
   TransferLogicEnv(..),
   HasTransferLogicEnv(..),
+  mkTransferLogicEnv,
+  addTransferEnv,
+  withTransfer,
+  withTransferFor,
+  withTransferFromOperator,
 
   -- * Runtime data
   RuntimeEnv(..),
@@ -84,8 +89,7 @@ import System.Environment qualified
 import Wst.AppError (AppError (..))
 import Wst.Offchain.Scripts (blacklistMintingScript, blacklistSpendingScript,
                              directoryNodeMintingScript,
-                             directoryNodeSpendingScript,
-                             freezeAndSezieTransferScript,
+                             directoryNodeSpendingScript, freezeTransferScript,
                              permissionedTransferScript,
                              programmableLogicBaseScript,
                              programmableLogicGlobalScript,
@@ -238,7 +242,7 @@ mkTransferLogicEnv cred =
     { tleBlacklistMintingScript = blacklistMinting
     , tleBlacklistSpendingScript = blacklistSpendingScript cred
     , tleMintingScript =  permissionedTransferScript cred
-    , tleTransferScript = freezeAndSezieTransferScript blacklistPolicy
+    , tleTransferScript = freezeTransferScript blacklistPolicy
     , tleIssuerScript = permissionedTransferScript cred
     }
 
@@ -270,10 +274,11 @@ class HasRuntimeEnv e where
 instance HasRuntimeEnv RuntimeEnv where
   runtimeEnv = id
 
-data CombinedEnv operatorF directoryF runtimeF era =
+data CombinedEnv operatorF directoryF transferF runtimeF era =
   CombinedEnv
     { ceOperator  :: operatorF (OperatorEnv era)
     , ceDirectory :: directoryF DirectoryEnv
+    , ceTransfer  :: transferF TransferLogicEnv
     , ceRuntime :: runtimeF RuntimeEnv
     }
 
@@ -283,73 +288,95 @@ makeLensesFor
 
 {-| 'CombinedEnv' with no values
 -}
-empty :: forall era. CombinedEnv Proxy Proxy Proxy era
+empty :: forall era. CombinedEnv Proxy Proxy Proxy Proxy era
 empty =
   CombinedEnv
     { ceOperator = Proxy
     , ceDirectory = Proxy
+    , ceTransfer = Proxy
     , ceRuntime = Proxy
     }
 
-instance HasOperatorEnv era (CombinedEnv Identity d r era) where
+instance HasOperatorEnv era (CombinedEnv Identity d t r era) where
   operatorEnv = runIdentity . ceOperator
 
-instance HasDirectoryEnv (CombinedEnv o Identity r era) where
+instance HasDirectoryEnv (CombinedEnv o Identity t r era) where
   directoryEnv = runIdentity . ceDirectory
 
-instance HasTransferLogicEnv (CombinedEnv Identity d r era) where
-  transferLogicEnv = mkTransferLogicEnv . fst . bteOperator . operatorEnv
+instance HasTransferLogicEnv (CombinedEnv o d Identity r era) where
+  transferLogicEnv = runIdentity . ceTransfer
 
-instance HasRuntimeEnv (CombinedEnv o d Identity era) where
+instance HasRuntimeEnv (CombinedEnv o d t Identity era) where
   runtimeEnv = runIdentity . ceRuntime
 
 _Identity :: L.Iso' (Identity a) a
 _Identity = L.iso runIdentity Identity
 
-instance HasLogger (CombinedEnv o d Identity era) where
+instance HasLogger (CombinedEnv o d t Identity era) where
   loggerL = runtime . _Identity . loggerL
 
 {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment
 -}
-addDirectoryEnvFor :: C.TxIn -> CombinedEnv o d r era -> CombinedEnv o Identity r era
+addDirectoryEnvFor :: C.TxIn -> CombinedEnv o d t r era -> CombinedEnv o Identity t r era
 addDirectoryEnvFor txi = addDirectoryEnv (mkDirectoryEnv txi)
 
 {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment
 -}
-addDirectoryEnv :: DirectoryEnv -> CombinedEnv o d r era -> CombinedEnv o Identity r era
+addDirectoryEnv :: DirectoryEnv -> CombinedEnv o d t r era -> CombinedEnv o Identity t r era
 addDirectoryEnv de env =
   env{ceDirectory = Identity de }
 
-withDirectory :: MonadReader (CombinedEnv o d r era) m => DirectoryEnv -> ReaderT (CombinedEnv o Identity r era) m a -> m a
+withDirectory :: MonadReader (CombinedEnv o d t r era) m => DirectoryEnv -> ReaderT (CombinedEnv o Identity t r era) m a -> m a
 withDirectory dir action = do
   asks (addDirectoryEnv dir)
     >>= runReaderT action
 
-withDirectoryFor :: MonadReader (CombinedEnv o d r era) m => C.TxIn -> ReaderT (CombinedEnv o Identity r era) m a -> m a
+withDirectoryFor :: MonadReader (CombinedEnv o d t r era) m => C.TxIn -> ReaderT (CombinedEnv o Identity t r era) m a -> m a
 withDirectoryFor txi = withDirectory (mkDirectoryEnv txi)
 
+{-| Add a 'TransferLogicEnv' for the 'C.Hash C.PaymentKey' corresponding to the
+   admin hash
+ -}
+addTransferEnv :: TransferLogicEnv -> CombinedEnv o d t r era -> CombinedEnv o d Identity r era
+addTransferEnv de env =
+  env{ceTransfer = Identity de }
+
+withTransfer :: MonadReader (CombinedEnv o d t r era) m => TransferLogicEnv -> ReaderT (CombinedEnv o d Identity r era) m a -> m a
+withTransfer dir action = do
+  asks (addTransferEnv dir)
+    >>= runReaderT action
+
+withTransferFor :: MonadReader (CombinedEnv o d t r era) m => C.Hash C.PaymentKey -> ReaderT (CombinedEnv o d Identity r era) m a -> m a
+withTransferFor = withTransfer . mkTransferLogicEnv
+
+withTransferFromOperator :: MonadReader (CombinedEnv Identity d t r era) m => ReaderT (CombinedEnv Identity d Identity r era) m a -> m a
+withTransferFromOperator action = do
+  env <- ask
+  let opPkh = fst . bteOperator . operatorEnv $ env
+  runReaderT action (addTransferEnv (mkTransferLogicEnv opPkh) env)
+
 {-| Add a 'DirectoryEnv' for the 'C.TxIn' in to the environment and run the
 action with the modified environment
 -}
-withEnv :: forall era m a. ReaderT (CombinedEnv Proxy Proxy Proxy era) m a -> m a
+withEnv :: forall era m a. ReaderT (CombinedEnv Proxy Proxy Proxy Proxy era) m a -> m a
 withEnv = flip runReaderT empty
 
 {-| Add a 'RuntimeEnv' to the environment
 -}
-addRuntimeEnv :: RuntimeEnv -> CombinedEnv o d r era -> CombinedEnv o d Identity era
+addRuntimeEnv :: RuntimeEnv -> CombinedEnv o d t r era -> CombinedEnv o d t Identity era
 addRuntimeEnv env e =
   e{ceRuntime = Identity env }
 
-withRuntime :: MonadReader (CombinedEnv o d r era) m => RuntimeEnv -> ReaderT (CombinedEnv o d Identity era) m a -> m a
+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)
     >>= runReaderT action
 
 {-| Add an 'OperatorEnv' to the environment
 -}
-addOperatorEnv :: OperatorEnv era -> CombinedEnv o d r era2 -> CombinedEnv Identity d r era
+addOperatorEnv :: OperatorEnv era -> CombinedEnv o d t r era2 -> CombinedEnv Identity d t r era
 addOperatorEnv op e =
   e{ceOperator = Identity op }
 
-withOperator :: MonadReader (CombinedEnv o d r era1) m => OperatorEnv era -> ReaderT (CombinedEnv Identity d r era) m a -> m a
+withOperator :: MonadReader (CombinedEnv o d t r era1) m => OperatorEnv era -> ReaderT (CombinedEnv Identity d t r era) m a -> m a
 withOperator op action = asks (addOperatorEnv op) >>= runReaderT action
diff --git a/src/lib/Wst/Offchain/Scripts.hs b/src/lib/Wst/Offchain/Scripts.hs
index 598c508..a5e71a1 100644
--- a/src/lib/Wst/Offchain/Scripts.hs
+++ b/src/lib/Wst/Offchain/Scripts.hs
@@ -13,7 +13,7 @@ module Wst.Offchain.Scripts (
 
   -- Transfer logic
   permissionedTransferScript,
-  freezeAndSezieTransferScript,
+  freezeTransferScript,
   blacklistMintingScript,
   blacklistSpendingScript,
 
@@ -74,7 +74,7 @@ protocolParamsSpendingScript =
 -- symbol uniqueness across instances
 directoryNodeMintingScript :: C.TxIn -> C.PlutusScript C.PlutusScriptV3
 directoryNodeMintingScript txIn =
-  let script = tryCompile tracingConfig $ mkDirectoryNodeMP # pdata (pconstant $ transTxOutRef txIn)
+  let script = tryCompile prodConfig $ mkDirectoryNodeMP # pdata (pconstant $ transTxOutRef txIn)
   in C.PlutusScriptSerialised $ serialiseScript script
 
 -- | The spending script for the directory node tokens, parameterized by the
@@ -87,7 +87,7 @@ directoryNodeSpendingScript paramsPolId =
 -- TODO: can we change the signature to just take the param policy id?
 programmableLogicMintingScript :: C.PaymentCredential -> C.StakeCredential -> C.PolicyId -> C.PlutusScript C.PlutusScriptV3
 programmableLogicMintingScript progLogicBaseSpndingCred mintingCred nodePolId =
-  let script = tryCompile tracingConfig
+  let script = tryCompile prodConfig
                $ mkProgrammableLogicMinting
                   # pdata (pconstant $ transCredential progLogicBaseSpndingCred)
                   # pdata (pconstant $ transPolicyId nodePolId)
@@ -101,7 +101,7 @@ programmableLogicBaseScript globalCred =
 
 programmableLogicGlobalScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3 -- Parameterized by the CS holding protocol params datum
 programmableLogicGlobalScript paramsPolId =
-  let script = tryCompile tracingConfig $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId)
+  let script = tryCompile prodConfig $ mkProgrammableLogicGlobal # pdata (pconstant $ transPolicyId paramsPolId)
   in C.PlutusScriptSerialised $ serialiseScript script
 
 permissionedTransferScript :: C.Hash C.PaymentKey -> C.PlutusScript C.PlutusScriptV3
@@ -109,10 +109,8 @@ permissionedTransferScript cred =
   let script = tryCompile prodConfig $ mkPermissionedTransfer # pdata (pconstant $ transPubKeyHash cred)
   in C.PlutusScriptSerialised $ serialiseScript script
 
-freezeAndSezieTransferScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3
-freezeAndSezieTransferScript blacklistPolicyId =
-  -- TODO: maybe mkFreezeAndSeizeTransfer should be called mkFreezeTransfer as
-  -- seizing is handled separately
+freezeTransferScript :: C.PolicyId -> C.PlutusScript C.PlutusScriptV3
+freezeTransferScript blacklistPolicyId =
   let script = tryCompile prodConfig $ mkFreezeAndSeizeTransfer # pdata (pconstant $ transPolicyId blacklistPolicyId)
   in C.PlutusScriptSerialised $ serialiseScript script
 
diff --git a/src/test/Wst/Test/Env.hs b/src/test/Wst/Test/Env.hs
index 9b3c7ee..edc2141 100644
--- a/src/test/Wst/Test/Env.hs
+++ b/src/test/Wst/Test/Env.hs
@@ -4,6 +4,7 @@ module Wst.Test.Env(
   admin,
   asAdmin,
   asWallet,
+  user,
 ) where
 
 import Cardano.Api.Shelley qualified as C
@@ -34,24 +35,24 @@ user w =
 
 {-| Run an action using the "admin" key. Deploying the system, minting stablecoins, etc.
 -}
-asAdmin :: forall era o d r m a.
+asAdmin :: forall era o d t r m a.
   ( MonadUtxoQuery m
   , C.IsBabbageBasedEra era
-  , MonadReader (Env.CombinedEnv o d r era) m
+  , MonadReader (Env.CombinedEnv o d t r era) m
   )
-  => ReaderT (Env.CombinedEnv Identity d r era) m a -> m a
+  => ReaderT (Env.CombinedEnv Identity d t r era) m a -> m a
 asAdmin action = do
   env <- Env.loadOperatorEnv
           (C.verificationKeyHash . Operator.verificationKey . oPaymentKey $ admin)
           (maybe C.NoStakeAddress (C.StakeAddressByValue . C.StakeCredentialByKey . C.verificationKeyHash) $ Operator.oStakeKey admin)
   Env.withOperator env action
 
-asWallet :: forall era o d r m a.
+asWallet :: forall era o d t r m a.
   ( MonadUtxoQuery m
   , C.IsBabbageBasedEra era
-  , MonadReader (Env.CombinedEnv o d r era) m
+  , MonadReader (Env.CombinedEnv o d t r era) m
   )
-  => Wallet.Wallet -> ReaderT (Env.CombinedEnv Identity d r era) m a -> m a
+  => Wallet.Wallet -> ReaderT (Env.CombinedEnv Identity d t r era) m a -> m a
 asWallet w action = do
   env <- Env.loadOperatorEnv
           (C.verificationKeyHash . Operator.verificationKey . oPaymentKey $ user w)
diff --git a/src/test/Wst/Test/UnitTest.hs b/src/test/Wst/Test/UnitTest.hs
index c636b82..39f075b 100644
--- a/src/test/Wst/Test/UnitTest.hs
+++ b/src/test/Wst/Test/UnitTest.hs
@@ -29,17 +29,23 @@ import Wst.Offchain.Endpoints.Deployment qualified as Endpoints
 import Wst.Offchain.Env qualified as Env
 import Wst.Offchain.Query qualified as Query
 import Wst.Offchain.Scripts qualified as Scripts
-import Wst.Test.Env (admin, asAdmin, asWallet)
+import Wst.Test.Env (admin, asAdmin, asWallet, user)
 
 tests :: TestTree
 tests = testGroup "unit tests"
   [ testCase "deploy directory and global params" (mockchainSucceeds deployDirectorySet)
   , testCase "insert directory node" (mockchainSucceeds insertDirectoryNode)
   , testGroup "issue programmable tokens"
+      -- FIXME: Fails because the minted value is not sent to the operator
+      -- address. If we want to keep this test we need to modify the Endpoint.issueProgrammableTokenTx 
+      -- tx builder to pay the minted value to progLogicBaseScript with operator stake credential
       [ testCase "always succeeds validator" (mockchainSucceeds issueAlwaysSucceedsValidator)
       , testCase "smart token issuance" (mockchainSucceeds issueSmartTokensScenario)
       , testCase "smart token transfer" (mockchainSucceeds transferSmartTokens)
       , testCase "blacklist credential" (mockchainSucceeds (void blacklistCredential))
+      -- FIXME: Currently just throws, should implement better error handling
+      , testCase "blacklisted transfer" (mockchainSucceeds blacklistTransfer)
+      , testCase "seize user output" (mockchainSucceeds seizeUserOutput)
       ]
   ]
 
@@ -79,7 +85,6 @@ issueAlwaysSucceedsValidator = failOnError $ Env.withEnv $ do
       >>= void . expectN 2 "registry outputs"
     Query.programmableLogicOutputs @C.ConwayEra
       >>= void . expectN 1 "programmable logic outputs"
-  pure ()
 
 issueSmartTokensScenario :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m C.AssetId
 issueSmartTokensScenario = deployDirectorySet >>= issueTransferLogicProgrammableToken
@@ -89,12 +94,12 @@ issueSmartTokensScenario = deployDirectorySet >>= issueTransferLogicProgrammable
 issueTransferLogicProgrammableToken :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => C.TxIn -> m C.AssetId
 issueTransferLogicProgrammableToken txI = failOnError $ Env.withEnv $ do
 
-  asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ do
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do
     opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
     -- register programmable global stake script
     void $ registerTransferScripts opPkh
 
-  asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ do
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do
     opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
 
     (balTx, aid) <- Endpoints.issueSmartTokensTx "dummy asset" 100 (C.PaymentCredentialByKey opPkh)
@@ -113,7 +118,7 @@ transferSmartTokens = failOnError $ Env.withEnv $ do
   userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv)
   txI <- deployDirectorySet
 
-  asAdmin @C.ConwayEra $ do
+  asAdmin @C.ConwayEra $ Env.withTransferFromOperator $ do
     Endpoints.deployBlacklistTx
       >>= void . sendTx . signTxOperator admin
     Query.blacklistNodes @C.ConwayEra
@@ -121,7 +126,7 @@ transferSmartTokens = failOnError $ Env.withEnv $ do
 
   aid <- issueTransferLogicProgrammableToken txI
 
-  asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ do
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txI $ Env.withTransferFromOperator $ do
     opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
 
     Endpoints.transferSmartTokensTx (C.PaymentCredentialByKey opPkh) aid 80 (C.PaymentCredentialByKey userPkh)
@@ -141,13 +146,13 @@ blacklistCredential = failOnError $ Env.withEnv $ do
 
   txIn <- deployDirectorySet
 
-  asAdmin @C.ConwayEra $ do
+  asAdmin @C.ConwayEra $ Env.withTransferFromOperator $ do
     Endpoints.deployBlacklistTx
       >>= void . sendTx . signTxOperator admin
     Query.blacklistNodes @C.ConwayEra
       >>= void . expectSingleton "blacklist output"
 
-  asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ do
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do
     Endpoints.blacklistCredentialTx paymentCred
       >>= void . sendTx . signTxOperator admin
 
@@ -156,6 +161,64 @@ blacklistCredential = failOnError $ Env.withEnv $ do
 
   pure paymentCred
 
+blacklistTransfer :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m ()
+blacklistTransfer = failOnError $ Env.withEnv $ do
+  userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv)
+  let userPaymentCred = C.PaymentCredentialByKey userPkh
+
+  txIn <- deployDirectorySet
+  aid <- issueTransferLogicProgrammableToken txIn
+
+  asAdmin @C.ConwayEra $ Env.withTransferFromOperator $ do
+    Endpoints.deployBlacklistTx
+      >>= void . sendTx . signTxOperator admin
+
+  opPkh <- asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do
+    opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
+    Endpoints.transferSmartTokensTx (C.PaymentCredentialByKey opPkh) aid 50 (C.PaymentCredentialByKey userPkh)
+      >>= void . sendTx . signTxOperator admin
+    pure opPkh
+
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do
+    Endpoints.blacklistCredentialTx userPaymentCred
+      >>= void . sendTx . signTxOperator admin
+
+  asWallet Wallet.w2 $ Env.withDirectoryFor txIn $ Env.withTransferFor opPkh $ do
+    Endpoints.transferSmartTokensTx (C.PaymentCredentialByKey userPkh) aid 30 (C.PaymentCredentialByKey opPkh)
+      >>= void . sendTx . signTxOperator (user Wallet.w2)
+
+seizeUserOutput :: (MonadUtxoQuery m, MonadFail m, MonadMockchain C.ConwayEra m) => m ()
+seizeUserOutput = failOnError $ Env.withEnv $ do
+  userPkh <- asWallet Wallet.w2 $ asks (fst . Env.bteOperator . Env.operatorEnv)
+  let userPaymentCred = C.PaymentCredentialByKey userPkh
+
+  txIn <- deployDirectorySet
+  aid <- issueTransferLogicProgrammableToken txIn
+
+  asAdmin @C.ConwayEra $ Env.withTransferFromOperator $ do
+    Endpoints.deployBlacklistTx
+      >>= void . sendTx . signTxOperator admin
+
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do
+    opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
+    Endpoints.transferSmartTokensTx (C.PaymentCredentialByKey opPkh) aid 50 (C.PaymentCredentialByKey userPkh)
+      >>= void . sendTx . signTxOperator admin
+    Query.programmableLogicOutputs @C.ConwayEra
+      >>= void . expectN 2 "programmable logic outputs"
+    Query.userProgrammableOutputs (C.PaymentCredentialByKey userPkh)
+      >>= void . expectN 1 "user programmable outputs"
+
+  asAdmin @C.ConwayEra $ Env.withDirectoryFor txIn $ Env.withTransferFromOperator $ do
+    opPkh <- asks (fst . Env.bteOperator . Env.operatorEnv)
+    Endpoints.seizeCredentialAssetsTx userPaymentCred
+      >>= void . sendTx . signTxOperator admin
+    Query.programmableLogicOutputs @C.ConwayEra
+      >>= void . expectN 3 "programmable logic outputs"
+    Query.userProgrammableOutputs (C.PaymentCredentialByKey userPkh)
+      >>= void . expectN 1 "user programmable outputs"
+    Query.userProgrammableOutputs (C.PaymentCredentialByKey opPkh)
+      >>= void . expectN 2 "user programmable outputs"
+
 
 dummyNodeArgs :: InsertNodeArgs
 dummyNodeArgs =
@@ -222,3 +285,8 @@ expectN :: MonadFail m => Int -> String -> [a] -> m ()
 expectN n msg lst
   | length lst == n = pure ()
   | otherwise       = fail $ "Expected " ++ show n ++ " " ++ msg ++ " but found " ++ show (length lst)
+
+_expectLeft :: (MonadFail m, Show b) => String -> Either a b -> m ()
+_expectLeft msg = \case
+  Left _ -> pure ()
+  (Right r) -> fail $ "Expected " ++ msg ++ " but found Right " ++ show r