Moved samples to PCB

* Cleaner imports

agora-specs/Sample/Treasury.hs

@@ -17,147 +17,111 @@ module Sample.Treasury (
   trCtxGATNameNotAddress,
 ) where
 
-import Plutarch.Api.V1 (validatorHash)
+import Plutarch.Context (
+  MintingBuilder,
+  UTXO,
+  buildMinting,
+  credential,
+  input,
+  mint,
+  output,
+  script,
+  signedWith,
+  txId,
+  withTxId,
+  withValue,
+ )
 import PlutusLedgerApi.V1 (
-  BuiltinByteString,
   Credential (PubKeyCredential),
   PubKeyHash (PubKeyHash),
  )
 import PlutusLedgerApi.V1.Address (Address (..))
 import PlutusLedgerApi.V1.Contexts (
   ScriptContext (..),
-  ScriptPurpose (Minting),
   TxInInfo (..),
-  TxInfo (..),
   TxOut (..),
   TxOutRef (..),
  )
-import PlutusLedgerApi.V1.Credential (Credential (ScriptCredential))
-import PlutusLedgerApi.V1.Interval qualified as Interval
-import PlutusLedgerApi.V1.Scripts (
-  ValidatorHash (ValidatorHash),
- )
-import PlutusLedgerApi.V1.Value qualified as Value
+import PlutusLedgerApi.V1.Scripts (ValidatorHash (ValidatorHash))
+import PlutusLedgerApi.V1.Value qualified as Value (singleton)
 import Sample.Shared (
   gatCs,
   gatTn,
   minAda,
-  mockTrEffect,
+  mockTrEffectHash,
   signer,
-  treasuryOut,
+  trCredential,
   wrongEffHash,
  )
-import Test.Util (datumPair)
+
+baseCtxBuilder :: MintingBuilder
+baseCtxBuilder =
+  let treasury :: UTXO -> UTXO
+      treasury =
+        credential trCredential
+          . withValue minAda
+          . withTxId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+   in mconcat
+        [ txId "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
+        , signedWith signer
+        , mint (Value.singleton gatCs gatTn (-1))
+        , input treasury
+        , output treasury
+        ]
 
 {- | A `ScriptContext` that should be compatible with treasury
      transactions.
 -}
 validCtx :: ScriptContext
 validCtx =
-  ScriptContext
-    { scriptContextPurpose = Minting gatCs
-    , scriptContextTxInfo =
-        TxInfo
-          { txInfoInputs =
-              [ treasuryIn
-              , effectIn
-              ]
-          , txInfoOutputs =
-              [ treasuryOut
-              ]
-          , -- Ensure sufficient ADA for transaction costs.
-            txInfoFee = Value.singleton "" "" 2 -- 2 ADA.
-          , -- Burn the GAT.
-            txInfoMint = Value.singleton gatCs gatTn (-1)
-          , txInfoDCert = []
-          , txInfoWdrl = []
-          , txInfoValidRange = Interval.always
-          , txInfoSignatories = [signer]
-          , txInfoData =
-              [ datumPair treasuryIn
-              , datumPair treasuryOut
-              , datumPair effectIn
-              ]
-          , txInfoId =
-              "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
-          }
-    }
-  where
-    treasuryIn =
-      TxInInfo
-        { txInInfoOutRef = treasuryRef
-        , txInInfoResolved = treasuryOut
-        }
-    effectIn =
-      TxInInfo
-        { txInInfoOutRef = effectRef
-        , txInInfoResolved =
-            TxOut
-              { txOutAddress =
-                  Address (ScriptCredential $ validatorHash mockTrEffect) Nothing
-              , txOutValue =
-                  mconcat
-                    [ Value.singleton gatCs gatTn 1
-                    , minAda
-                    ]
-              , txOutDatumHash = Nothing
-              }
-        }
+  let builder :: MintingBuilder
+      builder =
+        mconcat
+          [ baseCtxBuilder
+          , input $
+              script mockTrEffectHash
+                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+          ]
+   in either error id $ buildMinting builder
 
--- | Reference to treasury output.
 treasuryRef :: TxOutRef
 treasuryRef =
   TxOutRef
     "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049"
     1
 
--- | Reference to dummy effect output.
-effectRef :: TxOutRef
-effectRef =
-  TxOutRef
-    "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
-    0
-
--- | Input representing a user wallet with a valid GAT.
+{- | Input representing a user wallet with a valid GAT.
+ TODO: Resturcture this part of test.
+-}
 walletIn :: TxInInfo
 walletIn =
-  TxInInfo
-    { txInInfoOutRef =
-        TxOutRef
-          "cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
-          0
-    , txInInfoResolved =
-        TxOut
-          { txOutDatumHash = Nothing
-          , txOutValue = Value.singleton gatCs gatTn 1
-          , txOutAddress =
-              Address
-                (PubKeyCredential $ PubKeyHash addressBs)
-                Nothing
-          }
-    }
-
-addressBs :: BuiltinByteString
-(ValidatorHash addressBs) = validatorHash mockTrEffect
+  let (ValidatorHash addressBs) = mockTrEffectHash
+   in TxInInfo
+        { txInInfoOutRef =
+            TxOutRef
+              "cf4a8b33dd8e4493187e3339ecc3802d0cc000c947fb5559b7614153947d4e83"
+              0
+        , txInInfoResolved =
+            TxOut
+              { txOutDatumHash = Nothing
+              , txOutValue = Value.singleton gatCs gatTn 1
+              , txOutAddress =
+                  Address
+                    (PubKeyCredential $ PubKeyHash addressBs)
+                    Nothing
+              }
+        }
 
 trCtxGATNameNotAddress :: ScriptContext
 trCtxGATNameNotAddress =
-  let txInfo = validCtx.scriptContextTxInfo
-      inputs = txInfo.txInfoInputs
-      effectIn = inputs !! 1
-      invalidEff =
-        effectIn
-          { txInInfoResolved =
-              effectIn.txInInfoResolved
-                { txOutAddress = Address (ScriptCredential wrongEffHash) Nothing
-                }
-          }
-   in validCtx
-        { scriptContextTxInfo =
-            txInfo
-              { txInfoInputs =
-                  [ head inputs
-                  , invalidEff
-                  ]
-              }
-        }
+  let builder :: MintingBuilder
+      builder =
+        mconcat
+          [ baseCtxBuilder
+          , input $
+              script wrongEffHash
+                . withValue (Value.singleton gatCs gatTn 1 <> minAda)
+                . withTxId "52b67b60260da3937510ad545c7f46f8d9915bd27e1082e76947fb309f913bd3"
+          ]
+   in either error id $ buildMinting builder