Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #213 from Liqwid-Labs/emiflake/liqwid-nix-2.0

Browse source 
use liqwid-nix 2.0
This commit is contained in:
emiflake 2022-12-08 17:52:21 +01:00 • committed by Emily Martins
commit d0b22a5d41
35 changed files with 38445 additions and 1089 deletions
Download patch file Download diff file Expand all files Collapse all files

6
agora-bench/Bench.hs
View file

@ -2,18 +2,16 @@
module Bench (Benchmark (..), benchmarkScript, specificationTreeToBenchmarks) where module Bench (Benchmark (..), benchmarkScript, specificationTreeToBenchmarks) where
import Codec.Serialise (serialise)
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Short qualified as SBS import Data.ByteString.Short qualified as SBS
import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord, toNamedRecord, (.=)) import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord, toNamedRecord, (.=))
import Data.List (intercalate) import Data.List (intercalate)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Plutarch.Evaluate (evalScript) import Plutarch.Evaluate (evalScript)
import Plutarch.Script (Script, serialiseScript)
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
ExBudget (ExBudget), ExBudget (ExBudget),
ExCPU (..), ExCPU (..),
ExMemory (..), ExMemory (..),
Script,
) )
import Prettyprinter (Pretty (pretty), indent, vsep) import Prettyprinter (Pretty (pretty), indent, vsep)
import Test.Specification ( import Test.Specification (
@ -66,7 +64,7 @@ benchmarkScript name script = Benchmark (pack name) cpu mem size
where where
(_res, ExBudget cpu mem, _traces) = evalScript script (_res, ExBudget cpu mem, _traces) = evalScript script
size = SBS.length . SBS.toShort . LBS.toStrict . serialise $ script size = SBS.length . serialiseScript $ script
specificationTreeToBenchmarks :: SpecificationTree -> [Benchmark] specificationTreeToBenchmarks :: SpecificationTree -> [Benchmark]
specificationTreeToBenchmarks = go [] specificationTreeToBenchmarks = go []

4
agora-specs/Property/Generator.hs
View file

@ -42,9 +42,9 @@ import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (..), Credential (..),
PubKeyHash (PubKeyHash), PubKeyHash (PubKeyHash),
ScriptHash (ScriptHash),
TxId (..), TxId (..),
TxOutRef (..), TxOutRef (..),
ValidatorHash (ValidatorHash),
Value, Value,
toBuiltin, toBuiltin,
) )
@ -76,7 +76,7 @@ genUserCredential = PubKeyCredential . PubKeyHash . toBuiltin <$> genHashByteStr
-- | Random script credential. -- | Random script credential.
genScriptCredential :: Gen Credential genScriptCredential :: Gen Credential
genScriptCredential = ScriptCredential . ValidatorHash . toBuiltin <$> genHashByteString genScriptCredential = ScriptCredential . ScriptHash . toBuiltin <$> genHashByteString
-- | Random credential: combination of user and script credential generators. -- | Random credential: combination of user and script credential generators.
genCredential :: Gen Credential genCredential :: Gen Credential

9
agora-specs/Property/Governor.hs
View file

@ -57,6 +57,7 @@ import Plutarch.Context (
import Plutarch.Evaluate (evalTerm) import Plutarch.Evaluate (evalTerm)
import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.Compile (mustCompile) import Plutarch.Extra.Compile (mustCompile)
import Plutarch.Script (Script)
import Plutarch.Test.QuickCheck ( import Plutarch.Test.QuickCheck (
Equality (OnPEq), Equality (OnPEq),
Partiality (ByComplete), Partiality (ByComplete),
@ -66,14 +67,14 @@ import Plutarch.Test.QuickCheck (
shouldCrash, shouldCrash,
shouldRun, shouldRun,
) )
import PlutusLedgerApi.V2 (Script, ScriptContext) import PlutusLedgerApi.V2 (ScriptContext)
import Property.Generator (genInput, genOutput) import Property.Generator (genInput, genOutput)
import Sample.Shared ( import Sample.Shared (
deterministicTracingConfig, deterministicTracingConfig,
governor, governor,
governorAssetClass, governorAssetClass,
governorScriptHash,
governorSymbol, governorSymbol,
governorValidatorHash,
gstUTXORef, gstUTXORef,
) )
import Test.QuickCheck ( import Test.QuickCheck (
@ -109,7 +110,7 @@ instance Arbitrary GovernorDatumCases where
-} -}
governorDatumValidProperty :: Property governorDatumValidProperty :: Property
governorDatumValidProperty = governorDatumValidProperty =
haskEquiv @( 'OnPEq) @( 'ByComplete) haskEquiv @('OnPEq) @('ByComplete)
isValidModelImpl isValidModelImpl
(TestableTerm pisGovernorDatumValid) (TestableTerm pisGovernorDatumValid)
(genDatum :* Nil) (genDatum :* Nil)
@ -283,7 +284,7 @@ mkGovMintingCasePropertyTest name case' positiveCaseName negativeCaseName =
outputToGov = outputToGov =
output $ output $
mconcat mconcat
[ script governorValidatorHash [ script governorScriptHash
, withValue gst , withValue gst
, withDatum govDatum , withDatum govDatum
] ]

4
agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs
View file

@ -6,7 +6,7 @@ module Sample.AuthorityToken.UnauthorizedMintingExploit (
import Control.Exception (assert) import Control.Exception (assert)
import Plutarch.Context (input, mint, normalizeValue, output, script, withValue) import Plutarch.Context (input, mint, normalizeValue, output, script, withValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import Sample.Shared (authorityTokenPolicy, authorityTokenSymbol, minAda) import Sample.Shared (authorityTokenPolicy, authorityTokenSymbol, minAda)
import Test.Specification (SpecificationTree, testPolicy) import Test.Specification (SpecificationTree, testPolicy)
@ -32,7 +32,7 @@ exploit (Parameters burntGAT mintedGAT) =
gatValue hash = gatValue hash =
Value.singleton Value.singleton
authorityTokenSymbol authorityTokenSymbol
(validatorHashToTokenName hash) (scriptHashToTokenName hash)
mkGATUTxO hash = mkGATUTxO hash =
mconcat mconcat

22
agora-specs/Sample/Effect/GovernorMutation.hs
View file

@ -2,7 +2,7 @@ module Sample.Effect.GovernorMutation (
mkEffectTxInfo, mkEffectTxInfo,
effectValidator, effectValidator,
effectValidatorAddress, effectValidatorAddress,
effectValidatorHash, effectScriptHash,
atAssetClass, atAssetClass,
govRef, govRef,
effectRef, effectRef,
@ -20,9 +20,10 @@ import Agora.SafeMoney (AuthorityTokenTag)
import Data.Default.Class (Default (def)) import Data.Default.Class (Default (def))
import Data.Map ((!)) import Data.Map ((!))
import Data.Tagged (Tagged (..)) import Data.Tagged (Tagged (..))
import Plutarch.Api.V2 (validatorHash) import Plutarch.Api.V2 (scriptHash)
import Plutarch.Extra.AssetClass (AssetClass (AssetClass), assetClassValue) import Plutarch.Extra.AssetClass (AssetClass (AssetClass), assetClassValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import Plutarch.Script (Script)
import PlutusLedgerApi.V1 qualified as Interval (always) import PlutusLedgerApi.V1 qualified as Interval (always)
import PlutusLedgerApi.V1.Address (scriptHashAddress) import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Value qualified as Value ( import PlutusLedgerApi.V1.Value qualified as Value (
@ -32,14 +33,13 @@ import PlutusLedgerApi.V2 (
Address, Address,
Datum (..), Datum (..),
OutputDatum (OutputDatumHash), OutputDatum (OutputDatumHash),
ScriptHash,
ScriptPurpose (Spending), ScriptPurpose (Spending),
ToData (..), ToData (..),
TxInInfo (..), TxInInfo (..),
TxInfo (..), TxInfo (..),
TxOut (..), TxOut (..),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
Validator (Validator),
ValidatorHash (..),
) )
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import Sample.Shared ( import Sample.Shared (
@ -54,22 +54,22 @@ import Sample.Shared (
import Test.Util (datumPair, toDatumHash) import Test.Util (datumPair, toDatumHash)
-- | The effect validator instance. -- | The effect validator instance.
effectValidator :: Validator effectValidator :: Script
effectValidator = Validator $ agoraScripts ! "agora:mutateGovernorValidator" effectValidator = agoraScripts ! "agora:mutateGovernorValidator"
-- | The hash of the validator instance. -- | The hash of the validator instance.
effectValidatorHash :: ValidatorHash effectScriptHash :: ScriptHash
effectValidatorHash = validatorHash effectValidator effectScriptHash = scriptHash effectValidator
-- | The address of the validator. -- | The address of the validator.
effectValidatorAddress :: Address effectValidatorAddress :: Address
effectValidatorAddress = scriptHashAddress effectValidatorHash effectValidatorAddress = scriptHashAddress effectScriptHash
-- | The assetclass of the authority token. -- | The assetclass of the authority token.
atAssetClass :: Tagged AuthorityTokenTag AssetClass atAssetClass :: Tagged AuthorityTokenTag AssetClass
atAssetClass = Tagged $ AssetClass authorityTokenSymbol tokenName atAssetClass = Tagged $ AssetClass authorityTokenSymbol tokenName
where where
tokenName = validatorHashToTokenName effectValidatorHash tokenName = scriptHashToTokenName effectScriptHash
-- | The mock reference of the governor state UTXO. -- | The mock reference of the governor state UTXO.
govRef :: TxOutRef govRef :: TxOutRef

14
agora-specs/Sample/Effect/TreasuryWithdrawal.hs
View file

@ -24,7 +24,8 @@ import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum), TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
) )
import Data.Map ((!)) import Data.Map ((!))
import Plutarch.Api.V2 (validatorHash) import Plutarch.Api.V2 (scriptHash)
import Plutarch.Script (Script)
import PlutusLedgerApi.V1.Interval qualified as Interval (always) import PlutusLedgerApi.V1.Interval qualified as Interval (always)
import PlutusLedgerApi.V1.Value qualified as Value (singleton) import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
@ -36,14 +37,13 @@ import PlutusLedgerApi.V2 (
PubKeyHash, PubKeyHash,
Redeemer (Redeemer), Redeemer (Redeemer),
ScriptContext (..), ScriptContext (..),
ScriptHash (ScriptHash),
ScriptPurpose (Spending), ScriptPurpose (Spending),
TokenName (TokenName), TokenName (TokenName),
TxInInfo (TxInInfo), TxInInfo (TxInInfo),
TxInfo (..), TxInfo (..),
TxOut (..), TxOut (..),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
Validator (Validator),
ValidatorHash (ValidatorHash),
Value, Value,
toBuiltinData, toBuiltinData,
) )
@ -72,7 +72,7 @@ inputGAT =
TxInInfo TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1) (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing { txOutAddress = Address (ScriptCredential $ scriptHash validator) Nothing
, txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST , txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
, txOutDatum = OutputDatumHash (DatumHash "") , txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing , txOutReferenceScript = Nothing
@ -147,12 +147,12 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs
} }
-- | Effect validator instance. -- | Effect validator instance.
validator :: Validator validator :: Script
validator = Validator $ agoraScripts ! "agora:treasuryWithdrawalValidator" validator = agoraScripts ! "agora:treasuryWithdrawalValidator"
-- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator. -- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator.
validatorHashTN :: TokenName validatorHashTN :: TokenName
validatorHashTN = let ValidatorHash vh = validatorHash validator in TokenName vh validatorHashTN = let ScriptHash hash = scriptHash validator in TokenName hash
buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext buildScriptContext :: [TxInInfo] -> [TxOut] -> ScriptContext
buildScriptContext inputs outputs = buildScriptContext inputs outputs =

30
agora-specs/Sample/Governor/Initialize.hs
View file

@ -31,10 +31,8 @@ import Data.Default (Default (..))
import Data.Map (Map, (!)) import Data.Map (Map, (!))
import Data.Text (Text) import Data.Text (Text)
import Optics (view) import Optics (view)
import Plutarch.Api.V2 ( import Plutarch (Script)
mintingPolicySymbol, import Plutarch.Api.V2 (scriptHash)
validatorHash,
)
import Plutarch.Context ( import Plutarch.Context (
input, input,
mint, mint,
@ -50,12 +48,10 @@ import Plutarch.Context (
import PlutusLedgerApi.V1.Value (AssetClass (..)) import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
CurrencySymbol, CurrencySymbol (CurrencySymbol),
MintingPolicy (MintingPolicy), ScriptHash,
Script,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
Validator (Validator), getScriptHash,
ValidatorHash,
) )
import Sample.Shared ( import Sample.Shared (
deterministicTracingConfig, deterministicTracingConfig,
@ -128,20 +124,20 @@ scripts =
governor governor
) )
govPolicy :: MintingPolicy govPolicy :: Script
govPolicy = MintingPolicy $ scripts ! "agora:governorPolicy" govPolicy = scripts ! "agora:governorPolicy"
govValidator :: Validator govValidator :: Script
govValidator = Validator $ scripts ! "agora:governorValidator" govValidator = scripts ! "agora:governorValidator"
govSymbol :: CurrencySymbol govSymbol :: CurrencySymbol
govSymbol = mintingPolicySymbol govPolicy govSymbol = CurrencySymbol . getScriptHash $ scriptHash govPolicy
govAssetClass :: AssetClass govAssetClass :: AssetClass
govAssetClass = AssetClass (govSymbol, "") govAssetClass = AssetClass (govSymbol, "")
govValidatorHash :: ValidatorHash govScriptHash :: ScriptHash
govValidatorHash = validatorHash govValidator govScriptHash = scriptHash govValidator
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -215,7 +211,7 @@ mintGST ps = builder
else mempty else mempty
in output $ in output $
mconcat mconcat
[ script govValidatorHash [ script govScriptHash
, withValue governorValue , withValue governorValue
, datum , datum
] ]

30
agora-specs/Sample/Governor/Mutate.hs
View file

@ -20,7 +20,9 @@ import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..)) import Agora.Proposal (ProposalId (ProposalId), ProposalThresholds (..))
import Data.Default (def) import Data.Default (def)
import Data.Map ((!)) import Data.Map ((!))
import Plutarch.Api.V2 (PMintingPolicy, mintingPolicySymbol, mkMintingPolicy, validatorHash) import Data.Text qualified as T
import Plutarch (Script)
import Plutarch.Api.V2 (PMintingPolicy, scriptHash)
import Plutarch.Context ( import Plutarch.Context (
input, input,
mint, mint,
@ -35,12 +37,9 @@ import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (scriptHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
CurrencySymbol (CurrencySymbol),
Data, Data,
ScriptHash (ScriptHash), ScriptHash,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
Validator (Validator),
ValidatorHash,
Value, Value,
toData, toData,
) )
@ -48,8 +47,8 @@ import Sample.Shared (
agoraScripts, agoraScripts,
authorityTokenSymbol, authorityTokenSymbol,
governorAssetClass, governorAssetClass,
governorScriptHash,
governorValidator, governorValidator,
governorValidatorHash,
minAda, minAda,
) )
import Test.Specification (SpecificationTree, testValidator) import Test.Specification (SpecificationTree, testValidator)
@ -151,14 +150,14 @@ mkGovernorBuilder ps =
gstOutput = gstOutput =
if ps.stealGST if ps.stealGST
then pubKey $ head pubKeyHashes then pubKey $ head pubKeyHashes
else script governorValidatorHash else script governorScriptHash
withGSTDatum = withGSTDatum =
maybe mempty withDatum $ maybe mempty withDatum $
mkGovernorOutputDatum ps.governorOutputDatumValidity mkGovernorOutputDatum ps.governorOutputDatumValidity
in mconcat in mconcat
[ input $ [ input $
mconcat mconcat
[ script governorValidatorHash [ script governorScriptHash
, withDatum governorInputDatum , withDatum governorInputDatum
, withValue value , withValue value
, withRef governorRef , withRef governorRef
@ -173,19 +172,18 @@ mkGovernorBuilder ps =
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
mockEffectValidator :: Validator mockEffectValidator :: Script
mockEffectValidator = Validator $ agoraScripts ! "agora:noOpValidator" mockEffectValidator = agoraScripts ! "agora:noOpValidator"
mockEffectValidatorHash :: ValidatorHash mockEffectScriptHash :: ScriptHash
mockEffectValidatorHash = validatorHash mockEffectValidator mockEffectScriptHash = scriptHash mockEffectValidator
mockAuthScript :: ClosedTerm PMintingPolicy mockAuthScript :: ClosedTerm PMintingPolicy
mockAuthScript = plam $ \_ _ -> popaque $ pcon PUnit mockAuthScript = plam $ \_ _ -> popaque $ pcon PUnit
mockAuthScriptHash :: ScriptHash mockAuthScriptHash :: ScriptHash
mockAuthScriptHash = mockAuthScriptHash =
let CurrencySymbol h = mintingPolicySymbol $ mkMintingPolicy def mockAuthScript scriptHash . either (error . T.unpack) id $ compile def mockAuthScript
in ScriptHash h
mkGATValue :: GATValidity -> Integer -> Value mkGATValue :: GATValidity -> Integer -> Value
mkGATValue NoGAT _ = mempty mkGATValue NoGAT _ = mempty
@ -211,12 +209,12 @@ mkMockEffectBuilder ps =
[ mint burnt [ mint burnt
, input $ , input $
mconcat mconcat
[ script mockEffectValidatorHash [ script mockEffectScriptHash
, withValue inputValue , withValue inputValue
] ]
, output $ , output $
mconcat mconcat
[ script mockEffectValidatorHash [ script mockEffectScriptHash
, withValue outputValue , withValue outputValue
] ]
] ]

19
agora-specs/Sample/Proposal/Advance.hs
View file

@ -101,7 +101,6 @@ import PlutusLedgerApi.V2 (
PubKeyHash, PubKeyHash,
ScriptHash, ScriptHash,
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
ValidatorHash,
) )
import PlutusTx qualified import PlutusTx qualified
import Sample.Proposal.Shared ( import Sample.Proposal.Shared (
@ -114,15 +113,15 @@ import Sample.Shared (
authorityTokenSymbol, authorityTokenSymbol,
governor, governor,
governorAssetClass, governorAssetClass,
governorScriptHash,
governorValidator, governorValidator,
governorValidatorHash,
minAda, minAda,
proposalAssetClass, proposalAssetClass,
proposalScriptHash,
proposalValidator, proposalValidator,
proposalValidatorHash,
signer, signer,
stakeAssetClass, stakeAssetClass,
stakeValidatorHash, stakeScriptHash,
) )
import Test.Specification ( import Test.Specification (
SpecificationTree, SpecificationTree,
@ -191,7 +190,7 @@ data AuthorityTokenParameters = forall
, PIsData pdatum , PIsData pdatum
) => ) =>
AuthorityTokenParameters AuthorityTokenParameters
{ mintGATsFor :: ValidatorHash { mintGATsFor :: ScriptHash
-- ^ GATs will be minted and sent to the given group of effects. -- ^ GATs will be minted and sent to the given group of effects.
, carryDatum :: Maybe datum , carryDatum :: Maybe datum
-- ^ The datum that GAT UTxOs will be carrying. -- ^ The datum that GAT UTxOs will be carrying.
@ -337,14 +336,14 @@ mkProposalBuilder ps =
in mconcat in mconcat
[ input $ [ input $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withRef proposalRef , withRef proposalRef
, withDatum (mkProposalInputDatum ps) , withDatum (mkProposalInputDatum ps)
, withValue value , withValue value
] ]
, output $ , output $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withDatum (mkProposalOutputDatum ps) , withDatum (mkProposalOutputDatum ps)
, withValue value , withValue value
] ]
@ -402,7 +401,7 @@ mkStakeBuilder ps =
[ withSig [ withSig
, referenceInput $ , referenceInput $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withRef (mkStakeRef idx) , withRef (mkStakeRef idx)
, withValue perStakeValue , withValue perStakeValue
, withInlineDatum i , withInlineDatum i
@ -450,7 +449,7 @@ mkGovernorBuilder ps@(GovernorParameters _ redeemer) =
in mconcat in mconcat
[ input $ [ input $
mconcat mconcat
[ script governorValidatorHash [ script governorScriptHash
, withValue value , withValue value
, withRef governorRef , withRef governorRef
, withDatum governorInputDatum , withDatum governorInputDatum
@ -458,7 +457,7 @@ mkGovernorBuilder ps@(GovernorParameters _ redeemer) =
] ]
, output $ , output $
mconcat mconcat
[ script governorValidatorHash [ script governorScriptHash
, withValue value , withValue value
, withRef governorRef , withRef governorRef
, withDatum (mkGovernorOutputDatum ps) , withDatum (mkGovernorOutputDatum ps)

12
agora-specs/Sample/Proposal/Cosign.hs
View file

@ -76,11 +76,11 @@ import Sample.Shared (
governor, governor,
minAda, minAda,
proposalAssetClass, proposalAssetClass,
proposalScriptHash,
proposalValidator, proposalValidator,
proposalValidatorHash,
stakeAssetClass, stakeAssetClass,
stakeScriptHash,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification ( import Test.Specification (
SpecificationTree, SpecificationTree,
@ -248,7 +248,7 @@ cosign ps = builder
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeValue , withValue stakeValue
, withInlineDatum stakeInputDatum , withInlineDatum stakeInputDatum
, withRef stakeRef , withRef stakeRef
@ -256,7 +256,7 @@ cosign ps = builder
] ]
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeValue , withValue stakeValue
, withInlineDatum stakeOutputDatum , withInlineDatum stakeOutputDatum
] ]
@ -275,7 +275,7 @@ cosign ps = builder
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withDatum proposalInputDatum , withDatum proposalInputDatum
, withRef proposalRef , withRef proposalRef
@ -283,7 +283,7 @@ cosign ps = builder
] ]
, output $ , output $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withDatum proposalOutputDatum , withDatum proposalOutputDatum
] ]

22
agora-specs/Sample/Proposal/Create.hs
View file

@ -71,7 +71,7 @@ import Plutarch.Context (
withValue, withValue,
) )
import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Credential (PubKeyCredential), Credential (PubKeyCredential),
@ -86,20 +86,20 @@ import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared ( import Sample.Shared (
governor, governor,
governorAssetClass, governorAssetClass,
governorScriptHash,
governorValidator, governorValidator,
governorValidatorHash,
minAda, minAda,
proposalAssetClass, proposalAssetClass,
proposalPolicy, proposalPolicy,
proposalPolicySymbol, proposalPolicySymbol,
proposalScriptHash,
proposalStartingTimeFromTimeRange, proposalStartingTimeFromTimeRange,
proposalValidatorHash,
signer, signer,
signer2, signer2,
stakeAssetClass, stakeAssetClass,
stakeScriptHash,
stakeSymbol, stakeSymbol,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, group, testPolicy, testValidator) import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
import Test.Util ( import Test.Util (
@ -319,7 +319,7 @@ createProposal ps = builder
, withValue $ , withValue $
Value.singleton Value.singleton
stakeSymbol stakeSymbol
(validatorHashToTokenName attacker) (scriptHashToTokenName attacker)
1 1
, withDatum $ , withDatum $
(mkStakeInputDatum ps) (mkStakeInputDatum ps)
@ -363,7 +363,7 @@ createProposal ps = builder
timeRange $ mkTimeRange ps timeRange $ mkTimeRange ps
, input $ , input $
mconcat mconcat
[ script governorValidatorHash [ script governorScriptHash
, withValue governorValue , withValue governorValue
, withDatum governorInputDatum , withDatum governorInputDatum
, withRedeemer ps.governorRedeemer , withRedeemer ps.governorRedeemer
@ -371,7 +371,7 @@ createProposal ps = builder
] ]
, output $ , output $
mconcat mconcat
[ script governorValidatorHash [ script governorScriptHash
, withValue governorValue , withValue governorValue
, withDatum (mkGovernorOutputDatum ps) , withDatum (mkGovernorOutputDatum ps)
] ]
@ -385,7 +385,7 @@ createProposal ps = builder
, withValue $ , withValue $
Value.singleton Value.singleton
stakeSymbol stakeSymbol
(validatorHashToTokenName attacker) (scriptHashToTokenName attacker)
1 1
, withDatum $ , withDatum $
(mkStakeInputDatum ps) (mkStakeInputDatum ps)
@ -397,14 +397,14 @@ createProposal ps = builder
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeValue , withValue stakeValue
, withDatum (mkStakeInputDatum ps) , withDatum (mkStakeInputDatum ps)
, withRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeValue , withValue stakeValue
, withDatum (mkStakeOutputDatum ps) , withDatum (mkStakeOutputDatum ps)
] ]
@ -412,7 +412,7 @@ createProposal ps = builder
, --- , ---
output $ output $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withDatum (mkProposalOutputDatum ps) , withDatum (mkProposalOutputDatum ps)
] ]

12
agora-specs/Sample/Proposal/PrivilegeEscalate.hs
View file

@ -49,11 +49,11 @@ import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared ( import Sample.Shared (
minAda, minAda,
proposalAssetClass, proposalAssetClass,
proposalScriptHash,
proposalValidator, proposalValidator,
proposalValidatorHash,
stakeAssetClass, stakeAssetClass,
stakeScriptHash,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, group, testValidator) import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes) import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes)
@ -166,7 +166,7 @@ privilegeEscalate op =
mconcat @b mconcat @b
[ input $ [ input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withDatum stakeInput , withDatum stakeInput
, withValue stakeValue , withValue stakeValue
, withRef $ mkStakeRef index , withRef $ mkStakeRef index
@ -174,7 +174,7 @@ privilegeEscalate op =
] ]
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withDatum stakeOutput , withDatum stakeOutput
, withValue stakeValue , withValue stakeValue
] ]
@ -196,7 +196,7 @@ privilegeEscalate op =
mconcat @b mconcat @b
[ input $ [ input $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withDatum proposalInput , withDatum proposalInput
, withRedeemer $ mkProposalRedeemer op , withRedeemer $ mkProposalRedeemer op
, withValue proposalValue , withValue proposalValue
@ -204,7 +204,7 @@ privilegeEscalate op =
] ]
, output $ , output $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withDatum proposalOutput , withDatum proposalOutput
, withValue proposalValue , withValue proposalValue
] ]

16
agora-specs/Sample/Proposal/Unlock.hs
View file

@ -72,7 +72,7 @@ import Plutarch.Context (
withValue, withValue,
) )
import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Credential (PubKeyCredential), Credential (PubKeyCredential),
@ -85,11 +85,11 @@ import Sample.Shared (
governor, governor,
minAda, minAda,
proposalAssetClass, proposalAssetClass,
proposalScriptHash,
proposalValidator, proposalValidator,
proposalValidatorHash, stakeScriptHash,
stakeSymbol, stakeSymbol,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, group, testValidator) import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes) import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes)
@ -282,7 +282,7 @@ unlock ps = builder
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withDatum proposalInputDatum , withDatum proposalInputDatum
, withRef proposalRef , withRef proposalRef
@ -290,7 +290,7 @@ unlock ps = builder
] ]
, output $ , output $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withDatum proposalOutputDatum , withDatum proposalOutputDatum
] ]
@ -299,7 +299,7 @@ unlock ps = builder
--- ---
sstName = case ps.stakeParameters.sstOwner of sstName = case ps.stakeParameters.sstOwner of
StakeValidator -> validatorHashToTokenName stakeValidatorHash StakeValidator -> scriptHashToTokenName stakeScriptHash
_ -> "" _ -> ""
sst = Value.singleton stakeSymbol sstName 1 sst = Value.singleton stakeSymbol sstName 1
@ -350,14 +350,14 @@ unlock ps = builder
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeInputValue , withValue stakeInputValue
, withDatum stakeInputDatum , withDatum stakeInputDatum
, withRef $ mkStakeRef i , withRef $ mkStakeRef i
] ]
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeOutputValue , withValue stakeOutputValue
, withDatum stakeOutputDatum , withDatum stakeOutputDatum
] ]

12
agora-specs/Sample/Proposal/Vote.hs
View file

@ -76,11 +76,11 @@ import Sample.Shared (
governor, governor,
minAda, minAda,
proposalAssetClass, proposalAssetClass,
proposalScriptHash,
proposalValidator, proposalValidator,
proposalValidatorHash,
stakeAssetClass, stakeAssetClass,
stakeScriptHash,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, group, testValidator) import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util ( import Test.Util (
@ -297,7 +297,7 @@ vote params =
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeInputValue , withValue stakeInputValue
, withInlineDatum $ mixOwner i stakeInputDatum , withInlineDatum $ mixOwner i stakeInputDatum
, withRedeemer stakeRedeemer , withRedeemer stakeRedeemer
@ -308,7 +308,7 @@ vote params =
else else
output $ output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeOutputValue , withValue stakeOutputValue
, withInlineDatum $ mixOwner i stakeOutputDatum , withInlineDatum $ mixOwner i stakeOutputDatum
] ]
@ -353,7 +353,7 @@ vote params =
mconcat mconcat
[ input $ [ input $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withRedeemer proposalRedeemer , withRedeemer proposalRedeemer
, withInlineDatum proposalInputDatum , withInlineDatum proposalInputDatum
@ -361,7 +361,7 @@ vote params =
] ]
, output $ , output $
mconcat mconcat
[ script proposalValidatorHash [ script proposalScriptHash
, withValue proposalValue , withValue proposalValue
, withInlineDatum proposalOutputDatum , withInlineDatum proposalOutputDatum
] ]

100
agora-specs/Sample/Shared.hs
View file

@ -24,7 +24,7 @@ module Sample.Shared (
stakeAssetClass, stakeAssetClass,
stakePolicy, stakePolicy,
stakeValidator, stakeValidator,
stakeValidatorHash, stakeScriptHash,
stakeAddress, stakeAddress,
stakeSymbol, stakeSymbol,
@ -35,14 +35,14 @@ module Sample.Shared (
governorSymbol, governorSymbol,
governorAssetClass, governorAssetClass,
governorValidatorAddress, governorValidatorAddress,
governorValidatorHash, governorScriptHash,
gstUTXORef, gstUTXORef,
-- ** Proposal -- ** Proposal
proposalPolicy, proposalPolicy,
proposalPolicySymbol, proposalPolicySymbol,
proposalValidator, proposalValidator,
proposalValidatorHash, proposalScriptHash,
proposalValidatorAddress, proposalValidatorAddress,
proposalStartingTimeFromTimeRange, proposalStartingTimeFromTimeRange,
proposalAssetClass, proposalAssetClass,
@ -77,13 +77,10 @@ import Data.Map (Map, (!))
import Data.Tagged (Tagged (..)) import Data.Tagged (Tagged (..))
import Data.Text (Text) import Data.Text (Text)
import Optics (view) import Optics (view)
import Plutarch (Config (..), TracingMode (DetTracing)) import Plutarch (Config (..), Script, TracingMode (DetTracing))
import Plutarch.Api.V2 ( import Plutarch.Api.V1 (scriptHash)
mintingPolicySymbol,
validatorHash,
)
import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Address (scriptHashAddress) import PlutusLedgerApi.V1.Address (scriptHashAddress)
import PlutusLedgerApi.V1.Value (TokenName, Value) import PlutusLedgerApi.V1.Value (TokenName, Value)
import PlutusLedgerApi.V1.Value qualified as Value ( import PlutusLedgerApi.V1.Value qualified as Value (
@ -92,16 +89,15 @@ import PlutusLedgerApi.V1.Value qualified as Value (
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (ScriptCredential), Credential (ScriptCredential),
CurrencySymbol, CurrencySymbol (CurrencySymbol),
Extended (..), Extended (..),
Interval (..), Interval (..),
LowerBound (..), LowerBound (..),
MintingPolicy (..),
OutputDatum (NoOutputDatum), OutputDatum (NoOutputDatum),
POSIXTimeRange, POSIXTimeRange,
PubKeyHash, PubKeyHash,
Redeemer (..), Redeemer (..),
Script, ScriptHash (getScriptHash),
ToData (toBuiltinData), ToData (toBuiltinData),
TxOut ( TxOut (
TxOut, TxOut,
@ -112,8 +108,6 @@ import PlutusLedgerApi.V2 (
), ),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
UpperBound (..), UpperBound (..),
Validator (Validator),
ValidatorHash (ValidatorHash),
) )
import PlutusTx qualified import PlutusTx qualified
import ScriptExport.ScriptInfo (runLinker) import ScriptExport.ScriptInfo (runLinker)
@ -146,50 +140,50 @@ agoraScripts =
governor governor
) )
stakePolicy :: MintingPolicy stakePolicy :: Script
stakePolicy = MintingPolicy $ agoraScripts ! "agora:stakePolicy" stakePolicy = agoraScripts ! "agora:stakePolicy"
stakeSymbol :: CurrencySymbol stakeSymbol :: CurrencySymbol
stakeSymbol = mintingPolicySymbol stakePolicy stakeSymbol = CurrencySymbol . getScriptHash $ scriptHash stakePolicy
stakeAssetClass :: Tagged StakeSTTag AssetClass stakeAssetClass :: Tagged StakeSTTag AssetClass
stakeAssetClass = Tagged $ AssetClass stakeSymbol (validatorHashToTokenName stakeValidatorHash) stakeAssetClass = Tagged $ AssetClass stakeSymbol (scriptHashToTokenName stakeScriptHash)
stakeValidator :: Validator stakeValidator :: Script
stakeValidator = Validator $ agoraScripts ! "agora:stakeValidator" stakeValidator = agoraScripts ! "agora:stakeValidator"
stakeValidatorHash :: ValidatorHash stakeScriptHash :: ScriptHash
stakeValidatorHash = validatorHash stakeValidator stakeScriptHash = scriptHash stakeValidator
stakeAddress :: Address stakeAddress :: Address
stakeAddress = Address (ScriptCredential stakeValidatorHash) Nothing stakeAddress = Address (ScriptCredential stakeScriptHash) Nothing
gstUTXORef :: TxOutRef gstUTXORef :: TxOutRef
gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0 gstUTXORef = TxOutRef "f28cd7145c24e66fd5bcd2796837aeb19a48a2656e7833c88c62a2d0450bd00d" 0
governorPolicy :: MintingPolicy governorPolicy :: Script
governorPolicy = MintingPolicy $ agoraScripts ! "agora:governorPolicy" governorPolicy = agoraScripts ! "agora:governorPolicy"
governorValidator :: Validator governorValidator :: Script
governorValidator = Validator $ agoraScripts ! "agora:governorValidator" governorValidator = agoraScripts ! "agora:governorValidator"
governorSymbol :: CurrencySymbol governorSymbol :: CurrencySymbol
governorSymbol = mintingPolicySymbol governorPolicy governorSymbol = CurrencySymbol . getScriptHash $ scriptHash governorPolicy
governorAssetClass :: Tagged GovernorSTTag AssetClass governorAssetClass :: Tagged GovernorSTTag AssetClass
governorAssetClass = Tagged $ AssetClass governorSymbol "" governorAssetClass = Tagged $ AssetClass governorSymbol ""
governorValidatorHash :: ValidatorHash governorScriptHash :: ScriptHash
governorValidatorHash = validatorHash governorValidator governorScriptHash = scriptHash governorValidator
governorValidatorAddress :: Address governorValidatorAddress :: Address
governorValidatorAddress = scriptHashAddress governorValidatorHash governorValidatorAddress = scriptHashAddress governorScriptHash
proposalPolicy :: MintingPolicy proposalPolicy :: Script
proposalPolicy = MintingPolicy $ agoraScripts ! "agora:proposalPolicy" proposalPolicy = agoraScripts ! "agora:proposalPolicy"
proposalPolicySymbol :: CurrencySymbol proposalPolicySymbol :: CurrencySymbol
proposalPolicySymbol = mintingPolicySymbol proposalPolicy proposalPolicySymbol = CurrencySymbol . getScriptHash $ scriptHash proposalPolicy
proposalAssetClass :: Tagged ProposalSTTag AssetClass proposalAssetClass :: Tagged ProposalSTTag AssetClass
proposalAssetClass = Tagged $ AssetClass proposalPolicySymbol "" proposalAssetClass = Tagged $ AssetClass proposalPolicySymbol ""
@ -202,14 +196,14 @@ signer = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be7401214142019c"
signer2 :: PubKeyHash signer2 :: PubKeyHash
signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192" signer2 = "8a30896c4fd5e79843e4ca1bd2cdbaa36f8c0bc3be74012141420192"
proposalValidator :: Validator proposalValidator :: Script
proposalValidator = Validator $ agoraScripts ! "agora:proposalValidator" proposalValidator = agoraScripts ! "agora:proposalValidator"
proposalValidatorHash :: ValidatorHash proposalScriptHash :: ScriptHash
proposalValidatorHash = validatorHash proposalValidator proposalScriptHash = scriptHash proposalValidator
proposalValidatorAddress :: Address proposalValidatorAddress :: Address
proposalValidatorAddress = scriptHashAddress proposalValidatorHash proposalValidatorAddress = scriptHashAddress proposalScriptHash
{- | Default value of 'Agora.Proposal.ProposalThresholds'. {- | Default value of 'Agora.Proposal.ProposalThresholds'.
For testing purpose only. For testing purpose only.
@ -224,11 +218,11 @@ instance Default ProposalThresholds where
, cosign = Tagged 100 , cosign = Tagged 100
} }
authorityTokenPolicy :: MintingPolicy authorityTokenPolicy :: Script
authorityTokenPolicy = MintingPolicy $ agoraScripts ! "agora:authorityTokenPolicy" authorityTokenPolicy = agoraScripts ! "agora:authorityTokenPolicy"
authorityTokenSymbol :: CurrencySymbol authorityTokenSymbol :: CurrencySymbol
authorityTokenSymbol = mintingPolicySymbol authorityTokenPolicy authorityTokenSymbol = CurrencySymbol . getScriptHash $ scriptHash authorityTokenPolicy
{- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'. {- | Default value of 'Agora.Governor.GovernorDatum.proposalTimings'.
For testing purpose only. For testing purpose only.
@ -279,32 +273,30 @@ treasuryOut =
gatCs :: CurrencySymbol gatCs :: CurrencySymbol
gatCs = authorityTokenSymbol gatCs = authorityTokenSymbol
trValidator :: Validator trValidator :: Script
trValidator = Validator $ agoraScripts ! "agora:treasuryValidator" trValidator = agoraScripts ! "agora:treasuryValidator"
-- | `ScriptCredential` used for the dummy treasury validator. -- | `ScriptCredential` used for the dummy treasury validator.
trCredential :: Credential trCredential :: Credential
trCredential = ScriptCredential $ validatorHash trValidator trCredential = ScriptCredential $ scriptHash trValidator
-- | `TokenName` for GAT generated from address of `mockTrEffect`. -- | `TokenName` for GAT generated from address of `mockTrEffect`.
gatTn :: TokenName gatTn :: TokenName
gatTn = validatorHashToTokenName $ validatorHash mockTrEffect gatTn = scriptHashToTokenName $ scriptHash mockTrEffect
-- | Mock treasury effect script, used for testing. -- | Mock treasury effect script, used for testing.
mockTrEffect :: Validator mockTrEffect :: Script
mockTrEffect = Validator $ agoraScripts ! "agora:noOpValidator" mockTrEffect = agoraScripts ! "agora:noOpValidator"
-- | Mock treasury effect validator hash -- | Mock treasury effect validator hash
mockTrEffectHash :: ValidatorHash mockTrEffectHash :: ScriptHash
mockTrEffectHash = validatorHash mockTrEffect mockTrEffectHash = scriptHash mockTrEffect
{- | A SHA-256 hash which (in all certainty) should not match the {- | A SHA-256 hash which (in all certainty) should not match the
hash of the dummy effect script. hash of the dummy effect script.
-} -}
wrongEffHash :: ValidatorHash wrongEffHash :: ScriptHash
wrongEffHash = wrongEffHash = "a21bc4a1d95600f9fa0a00b97ed0fa49a152a72de76253cb706f90b4b40f837b"
ValidatorHash
"a21bc4a1d95600f9fa0a00b97ed0fa49a152a72de76253cb706f90b4b40f837b"
------------------------------------------------------------------ ------------------------------------------------------------------

6
agora-specs/Sample/Stake.hs
View file

@ -44,8 +44,8 @@ import Sample.Shared (
governor, governor,
signer, signer,
stakeAssetClass, stakeAssetClass,
stakeScriptHash,
stakeSymbol, stakeSymbol,
stakeValidatorHash,
) )
import Test.Util (sortValue) import Test.Util (sortValue)
@ -77,7 +77,7 @@ stakeDepositWithdraw config =
, signedWith signer , signedWith signer
, input $ , input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue , withValue
( sortValue $ ( sortValue $
st st
@ -88,7 +88,7 @@ stakeDepositWithdraw config =
] ]
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue , withValue
( sortValue $ ( sortValue $
st st

8
agora-specs/Sample/Stake/Create.hs
View file

@ -35,7 +35,7 @@ import Plutarch.Context (
withValue, withValue,
) )
import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import Plutarch.Lift (PUnsafeLiftDecl (PLifted)) import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
@ -49,8 +49,8 @@ import Sample.Shared (
signer, signer,
signer2, signer2,
stakePolicy, stakePolicy,
stakeScriptHash,
stakeSymbol, stakeSymbol,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, testPolicy) import Test.Specification (SpecificationTree, testPolicy)
import Test.Util (CombinableBuilder, mkMinting, validatorHashes) import Test.Util (CombinableBuilder, mkMinting, validatorHashes)
@ -93,7 +93,7 @@ create ps@Parameters {stakeDatum} =
sstName = sstName =
if ps.invalidSSTName if ps.invalidSSTName
then "114514" then "114514"
else validatorHashToTokenName stakeValidatorHash else scriptHashToTokenName stakeScriptHash
sst = Value.singleton stakeSymbol sstName 1 sst = Value.singleton stakeSymbol sstName 1
@ -105,7 +105,7 @@ create ps@Parameters {stakeDatum} =
stakeBuilder = stakeBuilder =
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue $ normalizeValue $ sst <> perStakeGTs , withValue $ normalizeValue $ sst <> perStakeGTs
, withStakeDatum , withStakeDatum
] ]

4
agora-specs/Sample/Stake/Destroy.hs
View file

@ -53,9 +53,9 @@ import Sample.Shared (
signer2, signer2,
stakeAssetClass, stakeAssetClass,
stakePolicy, stakePolicy,
stakeScriptHash,
stakeSymbol, stakeSymbol,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification ( import Test.Specification (
SpecificationTree, SpecificationTree,
@ -125,7 +125,7 @@ destroy ps =
stakeUTxOTemplate = stakeUTxOTemplate =
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withDatum stakeInputDatum , withDatum stakeInputDatum
, withValue $ normalizeValue $ sst <> minAda , withValue $ normalizeValue $ sst <> minAda
] ]

6
agora-specs/Sample/Stake/SetDelegate.hs
View file

@ -50,8 +50,8 @@ import Sample.Shared (
signer, signer,
signer2, signer2,
stakeAssetClass, stakeAssetClass,
stakeScriptHash,
stakeValidator, stakeValidator,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, testValidator) import Test.Specification (SpecificationTree, testValidator)
import Test.Util (pubKeyHashes, sortValue) import Test.Util (pubKeyHashes, sortValue)
@ -132,14 +132,14 @@ setDelegate ps = buildSpending' builder
, signedWith signer , signedWith signer
, input $ , input $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeValue , withValue stakeValue
, withDatum stakeInput , withDatum stakeInput
, withRef stakeRef , withRef stakeRef
] ]
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue stakeValue , withValue stakeValue
, withDatum stakeOutput , withDatum stakeOutput
] ]

8
agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs
View file

@ -13,14 +13,14 @@ import Plutarch.Context (
withValue, withValue,
) )
import Plutarch.Extra.AssetClass (assetClassValue) import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import Sample.Shared ( import Sample.Shared (
minAda, minAda,
stakeAssetClass, stakeAssetClass,
stakePolicy, stakePolicy,
stakeScriptHash,
stakeSymbol, stakeSymbol,
stakeValidatorHash,
) )
import Test.Specification (SpecificationTree, testPolicy) import Test.Specification (SpecificationTree, testPolicy)
import Test.Util ( import Test.Util (
@ -51,7 +51,7 @@ exploit (Parameters inputSST) =
, mint sst , mint sst
, output $ , output $
mconcat mconcat
[ script stakeValidatorHash [ script stakeScriptHash
, withValue $ , withValue $
normalizeValue $ normalizeValue $
minAda <> sst minAda <> sst
@ -63,7 +63,7 @@ exploit (Parameters inputSST) =
fakeSSTValue = fakeSSTValue =
Value.singleton Value.singleton
stakeSymbol stakeSymbol
(validatorHashToTokenName attacker) (scriptHashToTokenName attacker)
. fromIntegral . fromIntegral
sst = assetClassValue stakeAssetClass 1 sst = assetClassValue stakeAssetClass 1

4
agora-specs/Sample/Treasury.hs
View file

@ -37,7 +37,7 @@ import PlutusLedgerApi.V2 (
Credential (PubKeyCredential), Credential (PubKeyCredential),
OutputDatum (NoOutputDatum), OutputDatum (NoOutputDatum),
PubKeyHash (PubKeyHash), PubKeyHash (PubKeyHash),
ValidatorHash (ValidatorHash), ScriptHash (ScriptHash),
) )
import PlutusLedgerApi.V2.Contexts ( import PlutusLedgerApi.V2.Contexts (
ScriptContext (..), ScriptContext (..),
@ -101,7 +101,7 @@ treasuryRef =
-} -}
walletIn :: TxInInfo walletIn :: TxInInfo
walletIn = walletIn =
let (ValidatorHash addressBs) = mockTrEffectHash let (ScriptHash addressBs) = mockTrEffectHash
in TxInInfo in TxInInfo
{ txInInfoOutRef = { txInInfoOutRef =
TxOutRef TxOutRef

12
agora-specs/Spec/AuthorityToken.hs
View file

@ -12,16 +12,16 @@ module Spec.AuthorityToken (specs) where
import Agora.AuthorityToken (singleAuthorityTokenBurned) import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Data.Tagged (Tagged (Tagged)) import Data.Tagged (Tagged (Tagged))
import Plutarch.Extra.Compile (mustCompile) import Plutarch.Extra.Compile (mustCompile)
import Plutarch.Script (Script)
import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Unsafe (punsafeCoerce)
import PlutusLedgerApi.V1 ( import PlutusLedgerApi.V1 (
Address (Address), Address (Address),
Credential (PubKeyCredential, ScriptCredential), Credential (PubKeyCredential, ScriptCredential),
CurrencySymbol, CurrencySymbol,
Script, ScriptHash (ScriptHash),
TxInInfo (TxInInfo), TxInInfo (TxInInfo),
TxOut (TxOut), TxOut (TxOut),
TxOutRef (TxOutRef), TxOutRef (TxOutRef),
ValidatorHash (ValidatorHash),
Value, Value,
) )
import PlutusLedgerApi.V1.Value qualified as Value ( import PlutusLedgerApi.V1.Value qualified as Value (
@ -68,7 +68,7 @@ specs =
<> Value.singleton "aa" "USDC" 100_000 <> Value.singleton "aa" "USDC" 100_000
) )
[ TxOut [ TxOut
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing)
(Value.singleton currencySymbol "deadbeef" 1) (Value.singleton currencySymbol "deadbeef" 1)
Nothing Nothing
] ]
@ -84,7 +84,7 @@ specs =
(Value.singleton "aaabcc" "hello-token" 1) (Value.singleton "aaabcc" "hello-token" 1)
Nothing Nothing
, TxOut , TxOut
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing)
(Value.singleton currencySymbol "deadbeef" 1) (Value.singleton currencySymbol "deadbeef" 1)
Nothing Nothing
, TxOut , TxOut
@ -99,7 +99,7 @@ specs =
( Value.singleton currencySymbol "i'm not deadbeef!" (-1) ( Value.singleton currencySymbol "i'm not deadbeef!" (-1)
) )
[ TxOut [ TxOut
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing)
(Value.singleton currencySymbol "i'm not deadbeef!" 1) (Value.singleton currencySymbol "i'm not deadbeef!" 1)
Nothing Nothing
] ]
@ -136,7 +136,7 @@ specs =
<> Value.singleton "aa" "USDC" 100_000 <> Value.singleton "aa" "USDC" 100_000
) )
[ TxOut [ TxOut
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing) (Address (ScriptCredential (ScriptHash "deadbeef")) Nothing)
(Value.singleton currencySymbol "deadbeef" 2) (Value.singleton currencySymbol "deadbeef" 2)
Nothing Nothing
] ]

5
agora-specs/Spec/Treasury.hs
View file

@ -21,11 +21,12 @@ Tests need to fail when:
-} -}
module Spec.Treasury (specs) where module Spec.Treasury (specs) where
import Plutarch.Script (Script)
import PlutusLedgerApi.V1.Credential ( import PlutusLedgerApi.V1.Credential (
StakingCredential (StakingHash), StakingCredential (StakingHash),
) )
import PlutusLedgerApi.V1.Value qualified as Value (singleton) import PlutusLedgerApi.V1.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey), Validator) import PlutusLedgerApi.V2 (DCert (DCertDelegRegKey))
import PlutusLedgerApi.V2.Contexts ( import PlutusLedgerApi.V2.Contexts (
ScriptContext (scriptContextPurpose, scriptContextTxInfo), ScriptContext (scriptContextPurpose, scriptContextTxInfo),
ScriptPurpose (Certifying, Minting, Rewarding), ScriptPurpose (Certifying, Minting, Rewarding),
@ -46,7 +47,7 @@ import Test.Specification (
validatorSucceedsWith, validatorSucceedsWith,
) )
compiledTreasuryValidator :: Validator compiledTreasuryValidator :: Script
compiledTreasuryValidator = trValidator compiledTreasuryValidator = trValidator
specs :: [SpecificationTree] specs :: [SpecificationTree]

61
agora-testlib/Test/Specification.hs
View file

@ -53,23 +53,21 @@ import Control.Composition ((.**), (.***))
import Data.Coerce (coerce) import Data.Coerce (coerce)
import Data.Text qualified as Text import Data.Text qualified as Text
import Plutarch.Evaluate (evalScript) import Plutarch.Evaluate (evalScript)
import PlutusLedgerApi.V1.Scripts ( import Plutarch.Script (Script (Script))
Context (Context), import PlutusCore.Data qualified as PLC
applyMintingPolicyScript, import PlutusCore.MkPlc qualified as PLC
applyValidator,
)
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Datum (..), Datum (..),
MintingPolicy,
Redeemer (Redeemer), Redeemer (Redeemer),
Script,
ScriptContext, ScriptContext,
ToData (toBuiltinData), ToData (toBuiltinData),
Validator, toData,
) )
import PlutusPrelude (over)
import PlutusTx.IsData qualified as PlutusTx (ToData) import PlutusTx.IsData qualified as PlutusTx (ToData)
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase) import Test.Tasty.HUnit (assertFailure, testCase)
import UntypedPlutusCore qualified as UPLC
{- | Expectations upon execution of script {- | Expectations upon execution of script
@Success@ indicates a successful execution. @Success@ indicates a successful execution.
@ -169,9 +167,6 @@ scriptSucceeds name script = Terminal $ Specification name Success script
scriptFails :: String -> Script -> SpecificationTree scriptFails :: String -> Script -> SpecificationTree
scriptFails name script = Terminal $ Specification name Failure script scriptFails name script = Terminal $ Specification name Failure script
mkContext :: ScriptContext -> Context
mkContext = Context . toBuiltinData
mkRedeemer :: mkRedeemer ::
forall redeemer. forall redeemer.
(PlutusTx.ToData redeemer) => (PlutusTx.ToData redeemer) =>
@ -188,37 +183,39 @@ mkDatum = Datum . toBuiltinData
applyMintingPolicy' :: applyMintingPolicy' ::
(PlutusTx.ToData redeemer) => (PlutusTx.ToData redeemer) =>
MintingPolicy -> Script ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
Script Script
applyMintingPolicy' policy redeemer scriptContext = applyMintingPolicy' policy redeemer scriptContext =
applyMintingPolicyScript applyArguments
(mkContext scriptContext)
policy policy
(mkRedeemer redeemer) [ toData $ mkRedeemer redeemer
, toData scriptContext
]
applyValidator' :: applyValidator' ::
( PlutusTx.ToData datum ( PlutusTx.ToData datum
, PlutusTx.ToData redeemer , PlutusTx.ToData redeemer
) => ) =>
Validator -> Script ->
datum -> datum ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
Script Script
applyValidator' validator datum redeemer scriptContext = applyValidator' validator datum redeemer scriptContext =
applyValidator applyArguments
(mkContext scriptContext)
validator validator
(mkDatum datum) [ toData $ mkDatum datum
(mkRedeemer redeemer) , toData $ mkRedeemer redeemer
, toData scriptContext
]
-- | Check that a policy script succeeds, given a name and arguments. -- | Check that a policy script succeeds, given a name and arguments.
policySucceedsWith :: policySucceedsWith ::
(PlutusTx.ToData redeemer) => (PlutusTx.ToData redeemer) =>
String -> String ->
MintingPolicy -> Script ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
SpecificationTree SpecificationTree
@ -229,7 +226,7 @@ policySucceedsWith tag =
policyFailsWith :: policyFailsWith ::
(PlutusTx.ToData redeemer) => (PlutusTx.ToData redeemer) =>
String -> String ->
MintingPolicy -> Script ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
SpecificationTree SpecificationTree
@ -242,7 +239,7 @@ validatorSucceedsWith ::
, PlutusTx.ToData redeemer , PlutusTx.ToData redeemer
) => ) =>
String -> String ->
Validator -> Script ->
datum -> datum ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
@ -256,7 +253,7 @@ validatorFailsWith ::
, PlutusTx.ToData redeemer , PlutusTx.ToData redeemer
) => ) =>
String -> String ->
Validator -> Script ->
datum -> datum ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
@ -269,7 +266,7 @@ effectSucceedsWith ::
( PlutusTx.ToData datum ( PlutusTx.ToData datum
) => ) =>
String -> String ->
Validator -> Script ->
datum -> datum ->
ScriptContext -> ScriptContext ->
SpecificationTree SpecificationTree
@ -280,7 +277,7 @@ effectFailsWith ::
( PlutusTx.ToData datum ( PlutusTx.ToData datum
) => ) =>
String -> String ->
Validator -> Script ->
datum -> datum ->
ScriptContext -> ScriptContext ->
SpecificationTree SpecificationTree
@ -293,7 +290,7 @@ testValidator ::
-- | Is this test case expected to succeed? -- | Is this test case expected to succeed?
Bool -> Bool ->
String -> String ->
Validator -> Script ->
datum -> datum ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
@ -310,7 +307,7 @@ testPolicy ::
-- | Is this test case expected to succeed? -- | Is this test case expected to succeed?
Bool -> Bool ->
String -> String ->
MintingPolicy -> Script ->
redeemer -> redeemer ->
ScriptContext -> ScriptContext ->
SpecificationTree SpecificationTree
@ -318,3 +315,11 @@ testPolicy isValid =
if isValid if isValid
then policySucceedsWith then policySucceedsWith
else policyFailsWith else policyFailsWith
--------------------------------------------------------------------------------
applyArguments :: Script -> [PLC.Data] -> Script
applyArguments (Script p) args =
let termArgs = fmap (PLC.mkConstant ()) args
applied t = PLC.mkIterApp () t termArgs
in Script $ over UPLC.progTerm applied p

5
agora-testlib/Test/Util.hs
View file

@ -57,7 +57,6 @@ import PlutusLedgerApi.V2 (
ScriptContext, ScriptContext,
ScriptHash (ScriptHash), ScriptHash (ScriptHash),
TxOutRef, TxOutRef,
ValidatorHash (ValidatorHash),
) )
import PlutusTx.AssocMap qualified as AssocMap import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins qualified as PlutusTx import PlutusTx.Builtins qualified as PlutusTx
@ -157,8 +156,8 @@ userCredentials :: [Credential]
userCredentials = PubKeyCredential <$> pubKeyHashes userCredentials = PubKeyCredential <$> pubKeyHashes
-- | An infinite list of *valid* validator hashes. -- | An infinite list of *valid* validator hashes.
validatorHashes :: [ValidatorHash] validatorHashes :: [ScriptHash]
validatorHashes = ValidatorHash . PlutusTx.toBuiltin <$> blake2b_224Hashes validatorHashes = ScriptHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
-- | An infinite list of *valid* script credentials. -- | An infinite list of *valid* script credentials.
scriptCredentials :: [Credential] scriptCredentials :: [Credential]

1
agora.cabal
View file

@ -103,7 +103,6 @@ common deps
, optics , optics
, plutarch , plutarch
, plutarch-extra , plutarch-extra
, plutarch-numeric
, plutus-core , plutus-core
, plutus-ledger-api , plutus-ledger-api
, plutus-tx , plutus-tx

13
agora/Agora/Effect/GovernorMutation.hs
View file

@ -27,8 +27,9 @@ import Agora.Governor (
) )
import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag) import Agora.SafeMoney (AuthorityTokenTag, GovernorSTTag)
import Agora.Utils (ptaggedSymbolValueOf) import Agora.Utils (ptaggedSymbolValueOf)
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash) import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PScriptHash,
PScriptPurpose (PSpending), PScriptPurpose (PSpending),
PTxOutRef, PTxOutRef,
PValidator, PValidator,
@ -43,9 +44,9 @@ import Plutarch.Extra.Maybe (passertPJust, pfromJust)
import Plutarch.Extra.Record (mkRecordConstr, (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pisScriptAddress, pisScriptAddress,
pscriptHashFromAddress,
ptryFromOutputDatum, ptryFromOutputDatum,
ptryFromRedeemer, ptryFromRedeemer,
pvalidatorHashFromAddress,
) )
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC) import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
@ -150,7 +151,7 @@ deriving anyclass instance PTryFrom PData PMutateGovernorDatum
-} -}
mutateGovernorValidator :: mutateGovernorValidator ::
ClosedTerm ClosedTerm
( PValidatorHash ( PScriptHash
:--> PTagged GovernorSTTag PCurrencySymbol :--> PTagged GovernorSTTag PCurrencySymbol
:--> PTagged AuthorityTokenTag PCurrencySymbol :--> PTagged AuthorityTokenTag PCurrencySymbol
:--> PValidator :--> PValidator
@ -194,12 +195,12 @@ mutateGovernorValidator =
, ptraceIfFalse "Can only modify the pinned governor" $ , ptraceIfFalse "Can only modify the pinned governor" $
inputF.outRef #== effectDatumF.governorRef inputF.outRef #== effectDatumF.governorRef
, ptraceIfFalse "Governor validator run" $ , ptraceIfFalse "Governor validator run" $
let inputValidatorHash = let inputScriptHash =
pfromJust pfromJust
#$ pvalidatorHashFromAddress #$ pscriptHashFromAddress
#$ pfield @"address" #$ pfield @"address"
# inputF.resolved # inputF.resolved
in inputValidatorHash #== govValidatorHash in inputScriptHash #== govValidatorHash
] ]
in isGovernorInput in isGovernorInput
) )

147
agora/Agora/Governor/Scripts.hs
View file

@ -43,11 +43,12 @@ import Agora.Stake (
) )
import Agora.Utils (ptaggedSymbolValueOf, ptoScottEncodingT, puntag) import Agora.Utils (ptaggedSymbolValueOf, ptoScottEncodingT, puntag)
import Data.Function (on) import Data.Function (on)
import Plutarch.Api.V1 (PCurrencySymbol, PValidatorHash) import Plutarch.Api.V1 (PCurrencySymbol)
import Plutarch.Api.V1.AssocMap (plookup) import Plutarch.Api.V1.AssocMap (plookup)
import Plutarch.Api.V1.AssocMap qualified as AssocMap import Plutarch.Api.V1.AssocMap qualified as AssocMap
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PMintingPolicy, PMintingPolicy,
PScriptHash,
PScriptPurpose (PMinting, PSpending), PScriptPurpose (PMinting, PSpending),
PTxOut, PTxOut,
PTxOutRef, PTxOutRef,
@ -67,7 +68,6 @@ import Plutarch.Extra.ScriptContext (
pscriptHashToTokenName, pscriptHashToTokenName,
ptryFromDatumHash, ptryFromDatumHash,
ptryFromOutputDatum, ptryFromOutputDatum,
pvalidatorHashFromAddress,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
@ -264,7 +264,7 @@ governorPolicy =
governorValidator :: governorValidator ::
-- | Lazy precompiled scripts. -- | Lazy precompiled scripts.
ClosedTerm ClosedTerm
( PValidatorHash ( PScriptHash
:--> PTagged StakeSTTag PAssetClassData :--> PTagged StakeSTTag PAssetClassData
:--> PTagged GovernorSTTag PCurrencySymbol :--> PTagged GovernorSTTag PCurrencySymbol
:--> PTagged ProposalSTTag PCurrencySymbol :--> PTagged ProposalSTTag PCurrencySymbol
@ -272,7 +272,7 @@ governorValidator ::
:--> PValidator :--> PValidator
) )
governorValidator = governorValidator =
plam $ \proposalValidatorHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do plam $ \proposalScriptHash sstClass gstSymbol pstSymbol atSymbol datum redeemer ctx -> unTermCont $ do
ctxF <- pletAllC ctx ctxF <- pletAllC ctx
txInfo <- pletC $ pfromData ctxF.txInfo txInfo <- pletC $ pfromData ctxF.txInfo
txInfoF <- txInfoF <-
@ -317,7 +317,7 @@ governorValidator =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Own by governor validator" $ [ ptraceIfFalse "Own by governor validator" $
((#==) `on` (pvalidatorHashFromAddress #)) ((#==) `on` (pscriptHashFromAddress #))
outputF.address outputF.address
governorInputF.address governorInputF.address
, ptraceIfFalse "Has governor ST" $ , ptraceIfFalse "Has governor ST" $
@ -345,8 +345,8 @@ governorValidator =
plam $ plam $
flip (pletFields @'["value", "datum", "address"]) $ \txOutF -> flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
let isProposalUTxO = let isProposalUTxO =
(pfromJust #$ pvalidatorHashFromAddress # pfromData txOutF.address) (pfromJust #$ pscriptHashFromAddress # pfromData txOutF.address)
#== proposalValidatorHash #== proposalScriptHash
#&& passetClassValueOf #&& passetClassValueOf
# pstClass # pstClass
# txOutF.value # txOutF.value
@ -500,82 +500,83 @@ governorValidator =
-- The effects of the winner outcome. -- The effects of the winner outcome.
effectGroup <- pletC $ ptryLookup # finalResultTag #$ proposalInputDatumF.effects effectGroup <- pletC $ ptryLookup # finalResultTag #$ proposalInputDatumF.effects
let -- For a given output, check if it contains a single valid GAT. let
getReceiverScriptHash = -- For a given output, check if it contains a single valid GAT.
plam getReceiverScriptHash =
( \output -> unTermCont $ do plam
outputF <- pletFieldsC @'["address", "datum", "value"] output ( \output -> unTermCont $ do
outputF <- pletFieldsC @'["address", "datum", "value"] output
let atAmount = let atAmount =
ptaggedSymbolValueOf ptaggedSymbolValueOf
# atSymbol # atSymbol
# outputF.value # outputF.value
handleAuthorityUTxO = handleAuthorityUTxO =
do do
receiverScriptHash <- receiverScriptHash <-
pletC $ pletC $
passertPJust passertPJust
# "GAT receiver should be a script" # "GAT receiver should be a script"
#$ pscriptHashFromAddress #$ pscriptHashFromAddress
# outputF.address # outputF.address
effect <- effect <-
pletAllC $ pletAllC $
passertPJust passertPJust
# "Receiver should be in the effect group" # "Receiver should be in the effect group"
#$ AssocMap.plookup #$ AssocMap.plookup
# receiverScriptHash # receiverScriptHash
# effectGroup # effectGroup
let tagToken = let tagToken =
pmaybeData pmaybeData
# pconstant "" # pconstant ""
# plam (pscriptHashToTokenName . pfromData) # plam (pscriptHashToTokenName . pfromData)
# effect.scriptHash # effect.scriptHash
gatAssetClass = passetClass # puntag atSymbol # tagToken gatAssetClass = passetClass # puntag atSymbol # tagToken
valueGATCorrect = valueGATCorrect =
passetClassValueOf passetClassValueOf
# gatAssetClass # gatAssetClass
# outputF.value # outputF.value
#== 1 #== 1
let hasCorrectDatum = let hasCorrectDatum =
effect.datumHash #== ptryFromDatumHash # outputF.datum effect.datumHash #== ptryFromDatumHash # outputF.datum
pguardC "Authority output valid" $ pguardC "Authority output valid" $
foldr1 foldr1
(#&&) (#&&)
[ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output [ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output
, ptraceIfFalse "Correct datum" hasCorrectDatum , ptraceIfFalse "Correct datum" hasCorrectDatum
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect , ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
] ]
pure $ pjust # receiverScriptHash pure $ pjust # receiverScriptHash
pmatchC pmatchC
( pcompareBy ( pcompareBy
# pfromOrd # pfromOrd
# atAmount # atAmount
# 1 # 1
) )
>>= \case >>= \case
-- atAmount == 1 -- atAmount == 1
PEQ -> handleAuthorityUTxO PEQ -> handleAuthorityUTxO
-- atAmount < 1 -- atAmount < 1
PLT -> pure pnothing PLT -> pure pnothing
-- atAmount > 1 -- atAmount > 1
PGT -> pure $ ptraceError "More than one GAT in one UTxO" PGT -> pure $ ptraceError "More than one GAT in one UTxO"
) )
-- The sorted hashes of all the GAT receivers. -- The sorted hashes of all the GAT receivers.
actualReceivers = actualReceivers =
psort psort
#$ pmapMaybe @PList #$ pmapMaybe @PList
# getReceiverScriptHash # getReceiverScriptHash
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
expectedReceivers = pkeys @PList # effectGroup expectedReceivers = pkeys @PList # effectGroup
-- This check ensures that it's impossible to send more than one GATs -- This check ensures that it's impossible to send more than one GATs
-- to a validator in the winning effect group. -- to a validator in the winning effect group.

30
agora/Agora/Linker.hs
View file

@ -7,14 +7,12 @@ import Agora.SafeMoney (AuthorityTokenTag, GTTag, GovernorSTTag, ProposalSTTag,
import Data.Aeson qualified as Aeson import Data.Aeson qualified as Aeson
import Data.Map (fromList) import Data.Map (fromList)
import Data.Tagged (Tagged (Tagged)) import Data.Tagged (Tagged (Tagged))
import Plutarch.Api.V2 (mintingPolicySymbol, validatorHash) import Plutarch.Api.V1 (scriptHash)
import Plutarch.Extra.AssetClass (AssetClass (AssetClass)) import Plutarch.Extra.AssetClass (AssetClass (AssetClass))
import Plutarch.Extra.ScriptContext (validatorHashToTokenName) import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1 (CurrencySymbol, TxOutRef, ValidatorHash) import PlutusLedgerApi.V1 (CurrencySymbol (CurrencySymbol), ScriptHash, TxOutRef, getScriptHash)
import Ply ( import Ply (
ScriptRole (MintingPolicyRole, ValidatorRole), ScriptRole (MintingPolicyRole, ValidatorRole),
toMintingPolicy,
toValidator,
(#), (#),
) )
import ScriptExport.ScriptInfo ( import ScriptExport.ScriptInfo (
@ -23,6 +21,7 @@ import ScriptExport.ScriptInfo (
fetchTS, fetchTS,
getParam, getParam,
toRoledScript, toRoledScript,
toScript,
) )
import Prelude hiding ((#)) import Prelude hiding ((#))
@ -54,7 +53,7 @@ linker = do
govVal <- govVal <-
fetchTS fetchTS
@ValidatorRole @ValidatorRole
@'[ ValidatorHash @'[ ScriptHash
, Tagged StakeSTTag AssetClass , Tagged StakeSTTag AssetClass
, Tagged GovernorSTTag CurrencySymbol , Tagged GovernorSTTag CurrencySymbol
, Tagged ProposalSTTag CurrencySymbol , Tagged ProposalSTTag CurrencySymbol
@ -110,7 +109,7 @@ linker = do
mutateGovVal <- mutateGovVal <-
fetchTS fetchTS
@ValidatorRole @ValidatorRole
@'[ ValidatorHash @'[ ScriptHash
, Tagged GovernorSTTag CurrencySymbol , Tagged GovernorSTTag CurrencySymbol
, Tagged AuthorityTokenTag CurrencySymbol , Tagged AuthorityTokenTag CurrencySymbol
] ]
@ -126,16 +125,13 @@ linker = do
# Tagged gstSymbol # Tagged gstSymbol
# Tagged pstSymbol # Tagged pstSymbol
# Tagged atSymbol # Tagged atSymbol
gstSymbol = gstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript govPol'
mintingPolicySymbol $
toMintingPolicy
govPol'
gstAssetClass = gstAssetClass =
AssetClass gstSymbol "" AssetClass gstSymbol ""
govValHash = validatorHash $ toValidator govVal' govValHash = scriptHash $ toScript govVal'
atPol' = atkPol # Tagged gstAssetClass atPol' = atkPol # Tagged gstAssetClass
atSymbol = mintingPolicySymbol $ toMintingPolicy atPol' atSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript atPol'
propPol' = prpPol # Tagged gstAssetClass propPol' = prpPol # Tagged gstAssetClass
propVal' = propVal' =
@ -144,8 +140,8 @@ linker = do
# Tagged gstSymbol # Tagged gstSymbol
# Tagged pstSymbol # Tagged pstSymbol
# governor.maximumCosigners # governor.maximumCosigners
propValHash = validatorHash $ toValidator propVal' propValHash = scriptHash $ toScript propVal'
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol' pstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript propPol'
pstAssetClass = AssetClass pstSymbol "" pstAssetClass = AssetClass pstSymbol ""
stakPol' = stkPol # governor.gtClassRef stakPol' = stkPol # governor.gtClassRef
@ -154,9 +150,9 @@ linker = do
# Tagged sstSymbol # Tagged sstSymbol
# Tagged pstAssetClass # Tagged pstAssetClass
# governor.gtClassRef # governor.gtClassRef
sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol' sstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript stakPol'
stakValTokenName = stakValTokenName =
validatorHashToTokenName $ validatorHash $ toValidator stakVal' scriptHashToTokenName $ scriptHash $ toScript stakVal'
sstAssetClass = AssetClass sstSymbol stakValTokenName sstAssetClass = AssetClass sstSymbol stakValTokenName
treaVal' = treVal # Tagged atSymbol treaVal' = treVal # Tagged atSymbol

8
agora/Agora/Proposal.hs
View file

@ -53,7 +53,7 @@ import Agora.SafeMoney (GTTag)
import Data.Map.Strict qualified as StrictMap import Data.Map.Strict qualified as StrictMap
import Data.Tagged (Tagged) import Data.Tagged (Tagged)
import Generics.SOP qualified as SOP import Generics.SOP qualified as SOP
import Plutarch.Api.V1 (PCredential, PMap, PValidatorHash) import Plutarch.Api.V1 (PCredential, PMap)
import Plutarch.Api.V1.AssocMap qualified as PAssocMap import Plutarch.Api.V1.AssocMap qualified as PAssocMap
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
KeyGuarantees (Sorted), KeyGuarantees (Sorted),
@ -88,7 +88,7 @@ import Plutarch.Lift (
PUnsafeLiftDecl (type PLifted), PUnsafeLiftDecl (type PLifted),
) )
import Plutarch.Orphans () import Plutarch.Orphans ()
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash) import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash)
import PlutusTx qualified import PlutusTx qualified
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -315,7 +315,7 @@ data ProposalEffectMetadata = ProposalEffectMetadata
via (ProductIsData ProposalEffectMetadata) via (ProductIsData ProposalEffectMetadata)
-- | @since 1.0.0 -- | @since 1.0.0
type ProposalEffectGroup = StrictMap.Map ValidatorHash ProposalEffectMetadata type ProposalEffectGroup = StrictMap.Map ScriptHash ProposalEffectMetadata
{- | Haskell-level datum for Proposal scripts. {- | Haskell-level datum for Proposal scripts.
@ -695,7 +695,7 @@ instance PTryFrom PData (PAsData PProposalEffectMetadata)
type PProposalEffectGroup = type PProposalEffectGroup =
PMap PMap
'Sorted 'Sorted
PValidatorHash PScriptHash
PProposalEffectMetadata PProposalEffectMetadata
{- | Plutarch-level version of 'ProposalDatum'. {- | Plutarch-level version of 'ProposalDatum'.

127
agora/Agora/Proposal/Scripts.hs
View file

@ -71,8 +71,8 @@ import Plutarch.Extra.Ord (pfromOrdBy, pinsertUniqueBy, psort)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pscriptHashFromAddress,
ptryFromOutputDatum, ptryFromOutputDatum,
pvalidatorHashFromAddress,
) )
import Plutarch.Extra.Sum (PSum (PSum)) import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
@ -285,7 +285,7 @@ proposalValidator =
foldl1 foldl1
(#&&) (#&&)
[ ptraceIfFalse "Own by proposal validator" $ [ ptraceIfFalse "Own by proposal validator" $
((#==) `on` (pvalidatorHashFromAddress #)) ((#==) `on` (pscriptHashFromAddress #))
outputF.address outputF.address
proposalInputF.address proposalInputF.address
, ptraceIfFalse "Has proposal ST" $ , ptraceIfFalse "Has proposal ST" $
@ -523,39 +523,40 @@ proposalValidator =
pguardC "Vote option should be valid" $ pguardC "Vote option should be valid" $
pisJust #$ plookup # voteFor # voteMap pisJust #$ plookup # voteFor # voteMap
let -- The amount of new votes should be the 'stakedAmount'. let
-- Update the vote counter of the proposal, and leave other stuff as is. -- The amount of new votes should be the 'stakedAmount'.
expectedNewVotes = -- Update the vote counter of the proposal, and leave other stuff as is.
pcon $ expectedNewVotes =
PProposalVotes $ pcon $
pupdate PProposalVotes $
# plam pupdate
( \votes -> # plam
pcon $ PJust $ votes + pto totalStakeAmount ( \votes ->
) pcon $ PJust $ votes + pto totalStakeAmount
# voteFor )
# pto (pfromData proposalInputDatumF.votes) # voteFor
# pto (pfromData proposalInputDatumF.votes)
expectedProposalOut = expectedProposalOut =
mkRecordConstr mkRecordConstr
PProposalDatum PProposalDatum
( #proposalId ( #proposalId
.= proposalInputDatumF.proposalId .= proposalInputDatumF.proposalId
.& #effects .& #effects
.= proposalInputDatumF.effects .= proposalInputDatumF.effects
.& #status .& #status
.= proposalInputDatumF.status .= proposalInputDatumF.status
.& #cosigners .& #cosigners
.= proposalInputDatumF.cosigners .= proposalInputDatumF.cosigners
.& #thresholds .& #thresholds
.= proposalInputDatumF.thresholds .= proposalInputDatumF.thresholds
.& #votes .& #votes
.= pdata expectedNewVotes .= pdata expectedNewVotes
.& #timingConfig .& #timingConfig
.= proposalInputDatumF.timingConfig .= proposalInputDatumF.timingConfig
.& #startingTime .& #startingTime
.= proposalInputDatumF.startingTime .= proposalInputDatumF.startingTime
) )
pguardC "Output proposal should be valid" $ pguardC "Output proposal should be valid" $
proposalOutputDatum #== expectedProposalOut proposalOutputDatum #== expectedProposalOut
@ -615,34 +616,36 @@ proposalValidator =
pguardC "Proposal output correct" $ pguardC "Proposal output correct" $
pif pif
shouldUpdateVotes shouldUpdateVotes
( let -- Remove votes and leave other parts of the proposal as it. ( let
expectedProposalOut = -- Remove votes and leave other parts of the proposal as it.
mkRecordConstr expectedProposalOut =
PProposalDatum mkRecordConstr
( #proposalId PProposalDatum
.= proposalInputDatumF.proposalId ( #proposalId
.& #effects .= proposalInputDatumF.proposalId
.= proposalInputDatumF.effects .& #effects
.& #status .= proposalInputDatumF.effects
.= proposalInputDatumF.status .& #status
.& #cosigners .= proposalInputDatumF.status
.= proposalInputDatumF.cosigners .& #cosigners
.& #thresholds .= proposalInputDatumF.cosigners
.= proposalInputDatumF.thresholds .& #thresholds
.& #votes .= proposalInputDatumF.thresholds
.= expectedVotes .& #votes
.& #timingConfig .= expectedVotes
.= proposalInputDatumF.timingConfig .& #timingConfig
.& #startingTime .= proposalInputDatumF.timingConfig
.= proposalInputDatumF.startingTime .& #startingTime
) .= proposalInputDatumF.startingTime
in foldl1 )
(#&&) in
[ ptraceIfFalse "Votes changed" $ foldl1
pnot #$ expectedVotes #== proposalInputDatumF.votes (#&&)
, ptraceIfFalse "Proposal update correct" $ [ ptraceIfFalse "Votes changed" $
expectedProposalOut #== proposalOutputDatum pnot #$ expectedVotes #== proposalInputDatumF.votes
] , ptraceIfFalse "Proposal update correct" $
expectedProposalOut #== proposalOutputDatum
]
) )
-- No change to the proposal is allowed. -- No change to the proposal is allowed.
( ptraceIfFalse "Proposal unchanged" $ ( ptraceIfFalse "Proposal unchanged" $

16
agora/Agora/Stake/Scripts.hs
View file

@ -90,9 +90,9 @@ import Plutarch.Extra.Maybe (
import Plutarch.Extra.Ord (POrdering (PEQ, PGT, PLT), pcompareBy, pfromOrd) import Plutarch.Extra.Ord (POrdering (PEQ, PGT, PLT), pcompareBy, pfromOrd)
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pscriptHashFromAddress,
pscriptHashToTokenName,
ptryFromOutputDatum, ptryFromOutputDatum,
pvalidatorHashFromAddress,
pvalidatorHashToTokenName,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.Tagged (PTagged) import Plutarch.Extra.Tagged (PTagged)
@ -122,7 +122,7 @@ import Prelude hiding (Num ((+)))
- Check that exactly one state thread is minted. - Check that exactly one state thread is minted.
- Check that an output exists with a state thread and a valid datum. - Check that an output exists with a state thread and a valid datum.
- Check that no state thread is an input. - Check that no state thread is an input.
- assert @'PlutusLedgerApi.V1.TokenName' == 'PlutusLedgerApi.V1.ValidatorHash'@ - assert @'PlutusLedgerApi.V1.TokenName' == 'PlutusLedgerApi.V1.ScriptHash'@
of the script that we pay to. of the script that we pay to.
=== For burning: === For burning:
@ -290,14 +290,14 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
# (pfield @"_0" # stakeInputRef) # (pfield @"_0" # stakeInputRef)
# txInfoF.inputs # txInfoF.inputs
stakeValidatorHash <- stakeScriptHash <-
pletC $ pletC $
pfromJust pfromJust
#$ pvalidatorHashFromAddress #$ pscriptHashFromAddress
#$ pfield @"address" #$ pfield @"address"
# validatedInput # validatedInput
let sstName = pvalidatorHashToTokenName stakeValidatorHash let sstName = pscriptHashToTokenName stakeScriptHash
sstClass <- pletC $ passetClass # puntag sstSymbol # sstName sstClass <- pletC $ passetClass # puntag sstSymbol # sstName
@ -321,11 +321,11 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
PEQ -> PEQ ->
let ownerValidatoHash = let ownerValidatoHash =
pfromJust pfromJust
#$ pvalidatorHashFromAddress #$ pscriptHashFromAddress
# txOutF.address # txOutF.address
isOwnedByStakeValidator = isOwnedByStakeValidator =
ownerValidatoHash #== stakeValidatorHash ownerValidatoHash #== stakeScriptHash
datum = datum =
ptrace "Resolve stake datum" $ ptrace "Resolve stake datum" $

12
agora/Agora/Utils.hs
View file

@ -8,7 +8,7 @@ Description: Plutarch utility functions that should be upstreamed or don't belon
Plutarch utility functions that should be upstreamed or don't belong anywhere else. Plutarch utility functions that should be upstreamed or don't belong anywhere else.
-} -}
module Agora.Utils ( module Agora.Utils (
validatorHashToAddress, scriptHashToAddress,
pstringIntercalate, pstringIntercalate,
punwords, punwords,
pisNothing, pisNothing,
@ -33,15 +33,15 @@ import Plutarch.Unsafe (punsafeDowncast)
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (
Address (Address), Address (Address),
Credential (ScriptCredential), Credential (ScriptCredential),
ValidatorHash, ScriptHash,
) )
{- | Create an 'Address' from a given 'ValidatorHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'. {- | Create an 'Address' from a given 'ScriptHash' with no 'PlutusLedgerApi.V1.Credential.StakingCredential'.
@since 0.1.0 @since 1.0.0
-} -}
validatorHashToAddress :: ValidatorHash -> Address scriptHashToAddress :: ScriptHash -> Address
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing scriptHashToAddress vh = Address (ScriptCredential vh) Nothing
-- | @since 1.0.0 -- | @since 1.0.0
pstringIntercalate :: pstringIntercalate ::

38534
flake.lock generated
View file

File diff suppressed because it is too large Load diff

215
flake.nix
View file

@ -1,173 +1,56 @@
{ {
description = "agora"; description = "agora";
inputs = { nixConfig = {
nixpkgs.follows = "plutarch/nixpkgs"; extra-experimental-features = [ "nix-command" "flakes" "ca-derivations" ];
nixpkgs-latest.url = "github:NixOS/nixpkgs"; extra-substituters = [ "https://cache.iog.io" "https://public-plutonomicon.cachix.org" "https://mlabs.cachix.org" ];
# temporary fix for nix versions that have the transitive follows bug extra-trusted-public-keys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "public-plutonomicon.cachix.org-1:3AKJMhCLn32gri1drGuaZmFrmnue+KkKrhhubQk/CWc=" ];
# see https://github.com/NixOS/nix/issues/6013 allow-import-from-derivation = "true";
nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; }; max-jobs = "auto";
nixpkgs-2205 = { url = "github:NixOS/nixpkgs/nixos-22.05"; }; auto-optimise-store = "true";
haskell-nix-extra-hackage.follows = "plutarch/haskell-nix-extra-hackage";
haskell-nix.follows = "plutarch/haskell-nix";
iohk-nix.follows = "plutarch/iohk-nix";
haskell-language-server.follows = "plutarch/haskell-language-server";
# Plutarch and its friends
plutarch = {
url = "github:Plutonomicon/plutarch-plutus?ref=master";
inputs.emanote.follows =
"plutarch/haskell-nix/nixpkgs-unstable";
inputs.nixpkgs.follows =
"plutarch/haskell-nix/nixpkgs-unstable";
};
ply = {
url = "github:mlabs-haskell/ply?ref=master";
inputs.haskell-nix.follows = "haskell-nix";
inputs.nixpkgs.follows = "nixpkgs";
inputs.extra-hackage.follows = "haskell-nix-extra-hackage";
inputs.iohk-nix.follows = "iohk-nix";
inputs.plutarch.follows = "plutarch";
};
plutarch-numeric = {
url = "github:Liqwid-Labs/plutarch-numeric?ref=main";
inputs.nixpkgs.follows = "nixpkgs";
inputs.nixpkgs-latest.follows = "nixpkgs-latest";
inputs.nixpkgs-2111.follows = "nixpkgs-2111";
inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage";
inputs.haskell-nix.follows = "haskell-nix";
inputs.iohk-nix.follows = "iohk-nix";
inputs.haskell-language-server.follows = "haskell-language-server";
inputs.plutarch.follows = "plutarch";
};
liqwid-plutarch-extra = {
url = "github:Liqwid-Labs/liqwid-plutarch-extra?ref=main";
inputs.nixpkgs.follows = "nixpkgs";
inputs.nixpkgs-latest.follows = "nixpkgs-latest";
inputs.nixpkgs-2111.follows = "nixpkgs-2111";
inputs.nixpkgs-2205.follows = "nixpkgs-2205";
inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage";
inputs.haskell-nix.follows = "haskell-nix";
inputs.iohk-nix.follows = "iohk-nix";
inputs.haskell-language-server.follows = "haskell-language-server";
inputs.plutarch.follows = "plutarch";
inputs.plutarch-quickcheck.follows = "plutarch-quickcheck";
inputs.plutarch-numeric.follows = "plutarch-numeric";
inputs.plutarch-context-builder.follows = "plutarch-context-builder";
inputs.ply.follows = "ply";
};
plutarch-quickcheck = {
url = "github:liqwid-labs/plutarch-quickcheck?ref=main";
inputs.nixpkgs.follows = "nixpkgs";
inputs.nixpkgs-latest.follows = "nixpkgs-latest";
inputs.nixpkgs-2111.follows = "nixpkgs-2111";
inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage";
inputs.haskell-nix.follows = "haskell-nix";
inputs.iohk-nix.follows = "iohk-nix";
inputs.haskell-language-server.follows = "haskell-language-server";
inputs.plutarch.follows = "plutarch";
};
plutarch-context-builder = {
url = "github:Liqwid-Labs/plutarch-context-builder?ref=main";
inputs.nixpkgs.follows = "nixpkgs";
inputs.nixpkgs-latest.follows = "nixpkgs-latest";
inputs.nixpkgs-2111.follows = "nixpkgs-2111";
inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage";
inputs.haskell-nix.follows = "haskell-nix";
inputs.iohk-nix.follows = "iohk-nix";
inputs.haskell-language-server.follows = "haskell-language-server";
inputs.plutarch.follows = "plutarch";
};
liqwid-script-export = {
url = "github:Liqwid-Labs/liqwid-script-export?ref=main";
inputs.nixpkgs.follows = "nixpkgs";
inputs.nixpkgs-latest.follows = "nixpkgs-latest";
inputs.nixpkgs-2111.follows = "nixpkgs-2111";
inputs.haskell-nix-extra-hackage.follows = "haskell-nix-extra-hackage";
inputs.haskell-nix.follows = "haskell-nix";
inputs.iohk-nix.follows = "iohk-nix";
inputs.haskell-language-server.follows = "haskell-language-server";
inputs.plutarch.follows = "plutarch";
inputs.ply.follows = "ply";
inputs.plutarch-numeric.follows = "plutarch-numeric";
inputs.liqwid-plutarch-extra.follows = "liqwid-plutarch-extra";
};
# Dependencies need addChecks, which was removed after this commit
liqwid-nix = {
url = "github:Liqwid-Labs/liqwid-nix";
inputs.nixpkgs-2205.follows = "nixpkgs-2205";
};
}; };
outputs = inputs@{ liqwid-nix, ... }: inputs = {
let nixpkgs.follows = "liqwid-nix/nixpkgs";
benchCheckOverlay = self: super: { nixpkgs-latest.url = "github:NixOS/nixpkgs";
toFlake =
let liqwid-nix = {
inherit (self) inputs perSystem pkgsFor'; url = "github:Liqwid-Labs/liqwid-nix/v2.0.0";
flake = super.toFlake or { }; inputs.nixpkgs-latest.follows = "nixpkgs-latest";
name = "benchCheck"; };
in
flake // { liqwid-plutarch-extra.url = "github:Liqwid-Labs/liqwid-plutarch-extra";
checks = perSystem (system: plutarch-quickcheck.url = "github:Liqwid-Labs/plutarch-quickcheck";
flake.checks.${system} // { plutarch-context-builder.url = "github:Liqwid-Labs/plutarch-context-builder";
${name} = liqwid-script-export.url = "github:Liqwid-Labs/liqwid-script-export";
let };
pkgs' = pkgsFor' system;
bench = flake.packages.${system}."agora:bench:agora-bench"; outputs = { self, liqwid-nix, flake-parts, ... }:
in flake-parts.lib.mkFlake { inherit self; } {
pkgs'.runCommand name imports = liqwid-nix.allModules;
{ systems = [ "x86_64-linux" "aarch64-darwin" "x86_64-darwin" "aarch64-linux" ];
nativeBuildInputs = [ pkgs'.diffutils ]; perSystem = { config, self', inputs', pkgs, system, ... }:
} '' let
export LC_CTYPE=C.UTF-8 pkgs = import self.inputs.nixpkgs {
export LC_ALL=C.UTF-8 inherit system;
export LANG=C.UTF-8
cd ${inputs.self}
${bench}/bin/agora-bench | diff bench.csv - \
|| (echo "bench.csv is outdated"; exit 1)
mkdir "$out"
'';
});
}; };
}; in
in {
(liqwid-nix.buildProject onchain.default = {
{ src = ./.;
inherit inputs; ghc.version = "ghc925";
src = ./.; shell = { };
} enableBuildChecks = true;
[ extraHackageDeps = [
liqwid-nix.haskellProject "${self.inputs.plutarch-quickcheck}"
liqwid-nix.plutarchProject "${self.inputs.plutarch-context-builder}"
(liqwid-nix.addDependencies [ "${self.inputs.liqwid-plutarch-extra}"
"${inputs.plutarch-numeric}" "${self.inputs.liqwid-script-export}"
"${inputs.plutarch-quickcheck}" "${self.inputs.liqwid-script-export.inputs.ply}/ply-core"
"${inputs.plutarch-context-builder}" "${self.inputs.liqwid-script-export.inputs.ply}/ply-plutarch"
"${inputs.liqwid-plutarch-extra}" ];
"${inputs.liqwid-script-export}" };
"${inputs.liqwid-script-export.inputs.ply}/ply-core" ci.required = [ "all_onchain" ];
"${inputs.liqwid-script-export.inputs.ply}/ply-plutarch" };
]) };
(liqwid-nix.enableFormatCheck [
"-XQuasiQuotes"
"-XTemplateHaskell"
"-XTypeApplications"
"-XImportQualifiedPost"
"-XPatternSynonyms"
"-XOverloadedRecordDot"
])
liqwid-nix.enableLintCheck
liqwid-nix.enableCabalFormatCheck
liqwid-nix.enableNixFormatCheck
liqwid-nix.addBuildChecks
liqwid-nix.addCommonRunScripts
(liqwid-nix.addCommandLineTools (pkgs: _: [
pkgs.haskellPackages.hasktags
]))
benchCheckOverlay
]
).toFlake;
} }