Restructure

`agora-spec` and `agora-spec` is merged to be `agora-specs`;
`agora-testlib` contains what previously was `Spec.Specification`.

agora-specs/Sample/Effect/GovernorMutation.hs

@@ -0,0 +1,193 @@
+module Sample.Effect.GovernorMutation (
+  mkEffectTxInfo,
+  effectValidator,
+  effectValidatorAddress,
+  effectValidatorHash,
+  atAssetClass,
+  govRef,
+  effectRef,
+  invalidNewGovernorDatum,
+  validNewGovernorDatum,
+  mkEffectDatum,
+) where
+
+--------------------------------------------------------------------------------
+
+import Agora.Effect.GovernorMutation (
+  MutateGovernorDatum (..),
+  mutateGovernorValidator,
+ )
+import Agora.Governor (GovernorDatum (..))
+import Agora.Proposal (ProposalId (..), ProposalThresholds (..))
+
+--------------------------------------------------------------------------------
+
+import Data.Tagged (Tagged (..))
+import Plutarch.Api.V1 (mkValidator, validatorHash)
+import Plutus.V1.Ledger.Address (scriptHashAddress)
+import Plutus.V1.Ledger.Api (
+  Address,
+  Datum (..),
+  ToData (..),
+  TokenName (..),
+  TxInInfo (..),
+  TxInfo (..),
+  TxOut (..),
+  TxOutRef (TxOutRef),
+  Validator,
+  ValidatorHash (..),
+ )
+import Plutus.V1.Ledger.Api qualified as Interval
+import Plutus.V1.Ledger.Value (AssetClass, assetClass)
+import Plutus.V1.Ledger.Value qualified as Value
+
+--------------------------------------------------------------------------------
+
+import Sample.Shared (
+  authorityTokenSymbol,
+  govAssetClass,
+  govValidatorAddress,
+  governor,
+  minAda,
+  signer,
+ )
+import Test.Util (datumPair, toDatumHash)
+
+--------------------------------------------------------------------------------
+
+import Data.Default.Class (Default (def))
+
+--------------------------------------------------------------------------------
+
+-- | The effect validator instance.
+effectValidator :: Validator
+effectValidator = mkValidator $ mutateGovernorValidator governor
+
+-- | The hash of the validator instance.
+effectValidatorHash :: ValidatorHash
+effectValidatorHash = validatorHash effectValidator
+
+-- | The address of the validator.
+effectValidatorAddress :: Address
+effectValidatorAddress = scriptHashAddress effectValidatorHash
+
+-- | The assetclass of the authority token.
+atAssetClass :: AssetClass
+atAssetClass = assetClass authorityTokenSymbol tokenName
+  where
+    -- TODO: use 'validatorHashToTokenName'
+    ValidatorHash bs = effectValidatorHash
+    tokenName = TokenName bs
+
+-- | The mock reference of the governor state UTXO.
+govRef :: TxOutRef
+govRef = TxOutRef "614481d2159bfb72350222d61fce17e548e0fc00e5a1f841ff1837c431346ce7" 1
+
+-- | The mock reference of the effect UTXO.
+effectRef :: TxOutRef
+effectRef = TxOutRef "c31164dc11835de7eb6187f67d0e1a19c1dfc0786a456923eef5043189cdb578" 1
+
+-- | The input effect datum in 'mkEffectTransaction'.
+mkEffectDatum :: GovernorDatum -> MutateGovernorDatum
+mkEffectDatum newGovDatum =
+  MutateGovernorDatum
+    { governorRef = govRef
+    , newDatum = newGovDatum
+    }
+
+{- | Given the new governor state, create an effect to update the governor's state.
+
+    Note that the transaction is valid only if the given new datum is valid.
+-}
+mkEffectTxInfo :: GovernorDatum -> TxInfo
+mkEffectTxInfo newGovDatum =
+  let gst = Value.assetClassValue govAssetClass 1
+      at = Value.assetClassValue atAssetClass 1
+
+      -- One authority token is burnt in the process.
+      burnt = Value.assetClassValue atAssetClass (-1)
+
+      --
+
+      governorInputDatum' :: GovernorDatum
+      governorInputDatum' =
+        GovernorDatum
+          { proposalThresholds = def
+          , nextProposalId = ProposalId 0
+          , proposalTimings = def
+          , createProposalTimeRangeMaxWidth = def
+          }
+      governorInputDatum :: Datum
+      governorInputDatum = Datum $ toBuiltinData governorInputDatum'
+      governorInput :: TxOut
+      governorInput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = gst
+          , txOutDatumHash = Just $ toDatumHash governorInputDatum
+          }
+
+      --
+
+      -- The effect should update 'nextProposalId'
+      effectInputDatum' :: MutateGovernorDatum
+      effectInputDatum' = mkEffectDatum newGovDatum
+      effectInputDatum :: Datum
+      effectInputDatum = Datum $ toBuiltinData effectInputDatum'
+      effectInput :: TxOut
+      effectInput =
+        TxOut
+          { txOutAddress = effectValidatorAddress
+          , txOutValue = at -- The effect carry an authotity token.
+          , txOutDatumHash = Just $ toDatumHash effectInputDatum
+          }
+
+      --
+
+      governorOutputDatum' :: GovernorDatum
+      governorOutputDatum' = effectInputDatum'.newDatum
+      governorOutputDatum :: Datum
+      governorOutputDatum = Datum $ toBuiltinData governorOutputDatum'
+      governorOutput :: TxOut
+      governorOutput =
+        TxOut
+          { txOutAddress = govValidatorAddress
+          , txOutValue = mconcat [gst, minAda]
+          , txOutDatumHash = Just $ toDatumHash governorOutputDatum
+          }
+   in TxInfo
+        { txInfoInputs =
+            [ TxInInfo effectRef effectInput
+            , TxInInfo govRef governorInput
+            ]
+        , txInfoOutputs = [governorOutput]
+        , txInfoFee = Value.singleton "" "" 2
+        , txInfoMint = burnt
+        , txInfoDCert = []
+        , txInfoWdrl = []
+        , txInfoValidRange = Interval.always
+        , txInfoSignatories = [signer]
+        , txInfoData = datumPair <$> [governorInputDatum, governorOutputDatum, effectInputDatum]
+        , txInfoId = "4dae3806cc69615b721d52ed09b758f43f25a8f39b7934d6b28514caf71f5f7b"
+        }
+
+validNewGovernorDatum :: GovernorDatum
+validNewGovernorDatum =
+  GovernorDatum
+    { proposalThresholds = def
+    , nextProposalId = ProposalId 42
+    , proposalTimings = def
+    , createProposalTimeRangeMaxWidth = def
+    }
+
+invalidNewGovernorDatum :: GovernorDatum
+invalidNewGovernorDatum =
+  GovernorDatum
+    { proposalThresholds =
+        def
+          { countVoting = Tagged (-1)
+          }
+    , nextProposalId = ProposalId 42
+    , proposalTimings = def
+    , createProposalTimeRangeMaxWidth = def
+    }

agora-specs/Sample/Effect/TreasuryWithdrawal.hs

@@ -0,0 +1,172 @@
+{- |
+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 (
+  inputTreasury,
+  inputUser,
+  inputGAT,
+  inputCollateral,
+  outputTreasury,
+  outputUser,
+  buildReceiversOutputFromDatum,
+  currSymbol,
+  users,
+  treasuries,
+  buildScriptContext,
+) where
+
+import Plutarch.Api.V1 (mkValidator, validatorHash)
+import Plutus.V1.Ledger.Api (
+  Address (Address),
+  Credential (..),
+  CurrencySymbol (CurrencySymbol),
+  DatumHash (DatumHash),
+  PubKeyHash (PubKeyHash),
+  ScriptContext (..),
+  ScriptPurpose (Spending),
+  TokenName (TokenName),
+  TxInInfo (TxInInfo),
+  TxInfo (
+    TxInfo,
+    txInfoDCert,
+    txInfoData,
+    txInfoFee,
+    txInfoId,
+    txInfoInputs,
+    txInfoMint,
+    txInfoOutputs,
+    txInfoSignatories,
+    txInfoValidRange,
+    txInfoWdrl
+  ),
+  TxOut (..),
+  TxOutRef (TxOutRef),
+  Validator,
+  ValidatorHash (ValidatorHash),
+  Value,
+  toBuiltin,
+ )
+import Plutus.V1.Ledger.Interval qualified as Interval
+import Plutus.V1.Ledger.Value qualified as Value
+
+import Data.ByteString.Char8 qualified as C
+import Data.ByteString.Hash (sha2)
+
+import Agora.Effect.TreasuryWithdrawal (
+  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
+  treasuryWithdrawalValidator,
+ )
+
+-- | A sample Currency Symbol.
+currSymbol :: CurrencySymbol
+currSymbol = CurrencySymbol "12312099"
+
+-- | A sample 'PubKeyHash'.
+signer :: PubKeyHash
+signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
+
+-- | List of users who the effect will pay to.
+users :: [Credential]
+users = PubKeyCredential . PubKeyHash . toBuiltin . sha2 . C.pack . show <$> ([1 ..] :: [Integer])
+
+-- | List of users who the effect will pay to.
+treasuries :: [Credential]
+treasuries = ScriptCredential . ValidatorHash . toBuiltin . sha2 . C.pack . show <$> ([1 ..] :: [Integer])
+
+inputGAT :: TxInInfo
+inputGAT =
+  TxInInfo
+    (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
+    TxOut
+      { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
+      , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
+      , txOutDatumHash = Just (DatumHash "")
+      }
+
+inputTreasury :: Int -> Value -> TxInInfo
+inputTreasury indx val =
+  TxInInfo
+    (TxOutRef "" 1)
+    TxOut
+      { txOutAddress = Address (treasuries !! indx) Nothing
+      , txOutValue = val
+      , txOutDatumHash = Just (DatumHash "")
+      }
+
+inputUser :: Int -> Value -> TxInInfo
+inputUser indx val =
+  TxInInfo
+    (TxOutRef "" 1)
+    TxOut
+      { txOutAddress = Address (users !! indx) Nothing
+      , txOutValue = val
+      , txOutDatumHash = Just (DatumHash "")
+      }
+
+inputCollateral :: Int -> TxInInfo
+inputCollateral indx =
+  TxInInfo -- Initiator
+    (TxOutRef "" 1)
+    TxOut
+      { txOutAddress = Address (users !! indx) Nothing
+      , txOutValue = Value.singleton "" "" 2000000
+      , txOutDatumHash = Just (DatumHash "")
+      }
+
+outputTreasury :: Int -> Value -> TxOut
+outputTreasury indx val =
+  TxOut
+    { txOutAddress = Address (treasuries !! indx) Nothing
+    , txOutValue = val
+    , txOutDatumHash = Nothing
+    }
+
+outputUser :: Int -> Value -> TxOut
+outputUser indx val =
+  TxOut
+    { txOutAddress = Address (users !! indx) Nothing
+    , txOutValue = val
+    , txOutDatumHash = Nothing
+    }
+
+buildReceiversOutputFromDatum :: TreasuryWithdrawalDatum -> [TxOut]
+buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs
+  where
+    f x =
+      TxOut
+        { txOutAddress = Address (fst x) Nothing
+        , txOutValue = snd x
+        , txOutDatumHash = Nothing
+        }
+
+-- | Effect validator instance.
+validator :: Validator
+validator = mkValidator $ treasuryWithdrawalValidator currSymbol
+
+-- | 'TokenName' that represents the hash of the 'Stake' validator.
+validatorHashTN :: TokenName
+validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh
+
+buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext
+buildScriptContext inputs outputs =
+  ScriptContext
+    { scriptContextTxInfo =
+        TxInfo
+          { txInfoInputs = inputs
+          , txInfoOutputs = outputs
+          , txInfoFee = Value.singleton "" "" 2
+          , txInfoMint = Value.singleton currSymbol validatorHashTN (-1)
+          , txInfoDCert = []
+          , txInfoWdrl = []
+          , txInfoValidRange = Interval.always
+          , txInfoSignatories = [signer]
+          , txInfoData = []
+          , txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
+          }
+    , scriptContextPurpose =
+        Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
+    }