agora/agora-specs/Sample/Effect/TreasuryWithdrawal.hs

{- |
Module     : Sample.Effect.TreasuryWithdrawalEffect
Maintainer : seungheon.ooh@gmail.com
Description: Sample based testing for Treasury Withdrawal Effect

This module provides samples for Treasury Withdrawal Effect tests.
-}
module Sample.Effect.TreasuryWithdrawal (
  validator,
  inputTreasury,
  inputUser,
  inputGAT,
  inputCollateral,
  outputTreasury,
  outputUser,
  buildReceiversOutputFromDatum,
  currSymbol,
  users,
  treasuries,
  buildScriptContext,
) where

import Agora.Effect.TreasuryWithdrawal (
  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
 )
import Data.Map ((!))
import Plutarch.Api.V2 (scriptHash)
import Plutarch.Script (Script)
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 (
  Address (Address),
  Credential (..),
  CurrencySymbol,
  DatumHash (DatumHash),
  OutputDatum (OutputDatumHash),
  PubKeyHash,
  Redeemer (Redeemer),
  ScriptContext (..),
  ScriptHash (ScriptHash),
  ScriptPurpose (Spending),
  TokenName (TokenName),
  TxInInfo (TxInInfo),
  TxInfo (..),
  TxOut (..),
  TxOutRef (TxOutRef),
  Value,
  toBuiltinData,
 )
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Shared (agoraScripts, authorityTokenSymbol)
import Test.Util (scriptCredentials, userCredentials)

-- | A sample Currency Symbol.
currSymbol :: CurrencySymbol
currSymbol = authorityTokenSymbol

-- | A sample 'PubKeyHash'.
signer :: PubKeyHash
signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"

-- | List of users who the effect will pay to.
users :: [Credential]
users = userCredentials

-- | List of users who the effect will pay to.
treasuries :: [Credential]
treasuries = scriptCredentials

inputGAT :: TxInInfo
inputGAT =
  TxInInfo
    (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
    TxOut
      { txOutAddress = Address (ScriptCredential $ scriptHash validator) Nothing
      , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
      , txOutDatum = OutputDatumHash (DatumHash "")
      , txOutReferenceScript = Nothing
      }

-- | Create an input given the index of the treasury and the 'Value' at this input.
inputTreasury :: Int -> Value -> TxInInfo
inputTreasury indx val =
  TxInInfo
    (TxOutRef "" 1)
    TxOut
      { txOutAddress = Address (treasuries !! indx) Nothing
      , txOutValue = val
      , txOutDatum = OutputDatumHash (DatumHash "")
      , txOutReferenceScript = Nothing
      }

-- | Create a input given the index of the user and the 'Value' at this input.
inputUser :: Int -> Value -> TxInInfo
inputUser indx val =
  TxInInfo
    (TxOutRef "" 1)
    TxOut
      { txOutAddress = Address (users !! indx) Nothing
      , txOutValue = val
      , txOutDatum = OutputDatumHash (DatumHash "")
      , txOutReferenceScript = Nothing
      }

-- | Create a input representing the collateral given by a user.
inputCollateral :: Int -> TxInInfo
inputCollateral indx =
  TxInInfo -- Initiator
    (TxOutRef "" 1)
    TxOut
      { txOutAddress = Address (users !! indx) Nothing
      , txOutValue = Value.singleton "" "" 2000000
      , txOutDatum = OutputDatumHash (DatumHash "")
      , txOutReferenceScript = Nothing
      }

-- | Create an output at the nth treasury with the given 'Value'.
outputTreasury :: Int -> Value -> TxOut
outputTreasury indx val =
  TxOut
    { txOutAddress = Address (treasuries !! indx) Nothing
    , txOutValue = val
    , txOutDatum = OutputDatumHash (DatumHash "")
    , txOutReferenceScript = Nothing
    }

-- | Create an output at the nth user with the given 'Value'.
outputUser :: Int -> Value -> TxOut
outputUser indx val =
  TxOut
    { txOutAddress = Address (users !! indx) Nothing
    , txOutValue = val
    , txOutDatum = OutputDatumHash (DatumHash "")
    , txOutReferenceScript = Nothing
    }

-- | Create a list of the outputs that are required as encoded in 'TreasuryWithdrawalDatum'.
buildReceiversOutputFromDatum :: TreasuryWithdrawalDatum -> [TxOut]
buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs
  where
    f x =
      TxOut
        { txOutAddress = Address (fst x) Nothing
        , txOutValue = snd x
        , txOutDatum = OutputDatumHash (DatumHash "")
        , txOutReferenceScript = Nothing
        }

-- | Effect validator instance.
validator :: Script
validator = agoraScripts ! "agora:treasuryWithdrawalValidator"

-- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator.
validatorHashTN :: TokenName
validatorHashTN = let ScriptHash hash = scriptHash validator in TokenName hash

buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext
buildScriptContext inputs outputs =
  let spending = Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
   in ScriptContext
        { scriptContextTxInfo =
            TxInfo
              { txInfoInputs = inputs
              , txInfoReferenceInputs = []
              , txInfoOutputs = outputs
              , txInfoFee = Value.singleton "" "" 2
              , txInfoMint = Value.singleton currSymbol validatorHashTN (-1)
              , txInfoDCert = []
              , txInfoWdrl = AssocMap.empty
              , txInfoValidRange = Interval.always
              , txInfoSignatories = [signer]
              , txInfoData = AssocMap.empty
              , txInfoRedeemers =
                  AssocMap.fromList
                    [ (spending, Redeemer $ toBuiltinData ())
                    ]
              , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
              }
        , scriptContextPurpose = spending
        }