Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

use liqwid-nix 2.0

Browse source
This commit is contained in:
Emily Martins 2022-11-30 01:26:47 +01:00
parent 25255a202b
commit 2843e1dd63
35 changed files with 458 additions and 564 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
import Codec.Serialise (serialise)
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Short qualified as SBS
import Data.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord, toNamedRecord, (.=))
import Data.List (intercalate)
import Data.Text (Text, pack)
import Plutarch.Evaluate (evalScript)
import Plutarch.Script (Script, serialiseScript)
import PlutusLedgerApi.V2 (
ExBudget (ExBudget),
ExCPU (..),
ExMemory (..),
Script,
)
import Prettyprinter (Pretty (pretty), indent, vsep)
import Test.Specification (
@ -66,7 +64,7 @@ benchmarkScript name script = Benchmark (pack name) cpu mem size
where
(_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 = go []

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

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

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

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

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

@ -6,7 +6,7 @@ module Sample.AuthorityToken.UnauthorizedMintingExploit (
import Control.Exception (assert)
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 Sample.Shared (authorityTokenPolicy, authorityTokenSymbol, minAda)
import Test.Specification (SpecificationTree, testPolicy)
@ -32,7 +32,7 @@ exploit (Parameters burntGAT mintedGAT) =
gatValue hash =
Value.singleton
authorityTokenSymbol
(validatorHashToTokenName hash)
(scriptHashToTokenName hash)
mkGATUTxO hash =
mconcat

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

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

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

@ -24,7 +24,8 @@ import Agora.Effect.TreasuryWithdrawal (
TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
)
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.Value qualified as Value (singleton)
import PlutusLedgerApi.V2 (
@ -36,14 +37,13 @@ import PlutusLedgerApi.V2 (
PubKeyHash,
Redeemer (Redeemer),
ScriptContext (..),
ScriptHash (ScriptHash),
ScriptPurpose (Spending),
TokenName (TokenName),
TxInInfo (TxInInfo),
TxInfo (..),
TxOut (..),
TxOutRef (TxOutRef),
Validator (Validator),
ValidatorHash (ValidatorHash),
Value,
toBuiltinData,
)
@ -72,7 +72,7 @@ inputGAT =
TxInInfo
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
TxOut
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
{ txOutAddress = Address (ScriptCredential $ scriptHash validator) Nothing
, txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
, txOutDatum = OutputDatumHash (DatumHash "")
, txOutReferenceScript = Nothing
@ -147,12 +147,12 @@ buildReceiversOutputFromDatum (TreasuryWithdrawalDatum xs _) = f <$> xs
}
-- | Effect validator instance.
validator :: Validator
validator = Validator $ agoraScripts ! "agora:treasuryWithdrawalValidator"
validator :: Script
validator = agoraScripts ! "agora:treasuryWithdrawalValidator"
-- | 'TokenName' that represents the hash of the 'Agora.Stake.Stake' validator.
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 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.Text (Text)
import Optics (view)
import Plutarch.Api.V2 (
mintingPolicySymbol,
validatorHash,
)
import Plutarch (Script)
import Plutarch.Api.V2 (scriptHash)
import Plutarch.Context (
input,
mint,
@ -50,12 +48,10 @@ import Plutarch.Context (
import PlutusLedgerApi.V1.Value (AssetClass (..))
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
CurrencySymbol,
MintingPolicy (MintingPolicy),
Script,
CurrencySymbol (CurrencySymbol),
ScriptHash,
TxOutRef (TxOutRef),
Validator (Validator),
ValidatorHash,
getScriptHash,
)
import Sample.Shared (
deterministicTracingConfig,
@ -128,20 +124,20 @@ scripts =
governor
)
govPolicy :: MintingPolicy
govPolicy = MintingPolicy $ scripts ! "agora:governorPolicy"
govPolicy :: Script
govPolicy = scripts ! "agora:governorPolicy"
govValidator :: Validator
govValidator = Validator $ scripts ! "agora:governorValidator"
govValidator :: Script
govValidator = scripts ! "agora:governorValidator"
govSymbol :: CurrencySymbol
govSymbol = mintingPolicySymbol govPolicy
govSymbol = CurrencySymbol . getScriptHash $ scriptHash govPolicy
govAssetClass :: AssetClass
govAssetClass = AssetClass (govSymbol, "")
govValidatorHash :: ValidatorHash
govValidatorHash = validatorHash govValidator
govScriptHash :: ScriptHash
govScriptHash = scriptHash govValidator
--------------------------------------------------------------------------------
@ -215,7 +211,7 @@ mintGST ps = builder
else mempty
in output $
mconcat
[ script govValidatorHash
[ script govScriptHash
, withValue governorValue
, 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 Data.Default (def)
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 (
input,
mint,
@ -35,12 +37,9 @@ import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
CurrencySymbol (CurrencySymbol),
Data,
ScriptHash (ScriptHash),
ScriptHash,
TxOutRef (TxOutRef),
Validator (Validator),
ValidatorHash,
Value,
toData,
)
@ -48,8 +47,8 @@ import Sample.Shared (
agoraScripts,
authorityTokenSymbol,
governorAssetClass,
governorScriptHash,
governorValidator,
governorValidatorHash,
minAda,
)
import Test.Specification (SpecificationTree, testValidator)
@ -151,14 +150,14 @@ mkGovernorBuilder ps =
gstOutput =
if ps.stealGST
then pubKey $ head pubKeyHashes
else script governorValidatorHash
else script governorScriptHash
withGSTDatum =
maybe mempty withDatum $
mkGovernorOutputDatum ps.governorOutputDatumValidity
in mconcat
[ input $
mconcat
[ script governorValidatorHash
[ script governorScriptHash
, withDatum governorInputDatum
, withValue value
, withRef governorRef
@ -173,19 +172,18 @@ mkGovernorBuilder ps =
--------------------------------------------------------------------------------
mockEffectValidator :: Validator
mockEffectValidator = Validator $ agoraScripts ! "agora:noOpValidator"
mockEffectValidator :: Script
mockEffectValidator = agoraScripts ! "agora:noOpValidator"
mockEffectValidatorHash :: ValidatorHash
mockEffectValidatorHash = validatorHash mockEffectValidator
mockEffectScriptHash :: ScriptHash
mockEffectScriptHash = scriptHash mockEffectValidator
mockAuthScript :: ClosedTerm PMintingPolicy
mockAuthScript = plam $ \_ _ -> popaque $ pcon PUnit
mockAuthScriptHash :: ScriptHash
mockAuthScriptHash =
let CurrencySymbol h = mintingPolicySymbol $ mkMintingPolicy def mockAuthScript
in ScriptHash h
scriptHash . either (error . T.unpack) id $ compile def mockAuthScript
mkGATValue :: GATValidity -> Integer -> Value
mkGATValue NoGAT _ = mempty
@ -211,12 +209,12 @@ mkMockEffectBuilder ps =
[ mint burnt
, input $
mconcat
[ script mockEffectValidatorHash
[ script mockEffectScriptHash
, withValue inputValue
]
, output $
mconcat
[ script mockEffectValidatorHash
[ script mockEffectScriptHash
, withValue outputValue
]
]

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

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

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

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

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

@ -71,7 +71,7 @@ import Plutarch.Context (
withValue,
)
import Plutarch.Extra.AssetClass (assetClassValue)
import Plutarch.Extra.ScriptContext (validatorHashToTokenName)
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 (
Credential (PubKeyCredential),
@ -86,20 +86,20 @@ import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared (
governor,
governorAssetClass,
governorScriptHash,
governorValidator,
governorValidatorHash,
minAda,
proposalAssetClass,
proposalPolicy,
proposalPolicySymbol,
proposalScriptHash,
proposalStartingTimeFromTimeRange,
proposalValidatorHash,
signer,
signer2,
stakeAssetClass,
stakeScriptHash,
stakeSymbol,
stakeValidator,
stakeValidatorHash,
)
import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
import Test.Util (
@ -319,7 +319,7 @@ createProposal ps = builder
, withValue $
Value.singleton
stakeSymbol
(validatorHashToTokenName attacker)
(scriptHashToTokenName attacker)
1
, withDatum $
(mkStakeInputDatum ps)
@ -363,7 +363,7 @@ createProposal ps = builder
timeRange $ mkTimeRange ps
, input $
mconcat
[ script governorValidatorHash
[ script governorScriptHash
, withValue governorValue
, withDatum governorInputDatum
, withRedeemer ps.governorRedeemer
@ -371,7 +371,7 @@ createProposal ps = builder
]
, output $
mconcat
[ script governorValidatorHash
[ script governorScriptHash
, withValue governorValue
, withDatum (mkGovernorOutputDatum ps)
]
@ -385,7 +385,7 @@ createProposal ps = builder
, withValue $
Value.singleton
stakeSymbol
(validatorHashToTokenName attacker)
(scriptHashToTokenName attacker)
1
, withDatum $
(mkStakeInputDatum ps)
@ -397,14 +397,14 @@ createProposal ps = builder
mconcat
[ input $
mconcat
[ script stakeValidatorHash
[ script stakeScriptHash
, withValue stakeValue
, withDatum (mkStakeInputDatum ps)
, withRef stakeRef
]
, output $
mconcat
[ script stakeValidatorHash
[ script stakeScriptHash
, withValue stakeValue
, withDatum (mkStakeOutputDatum ps)
]
@ -412,7 +412,7 @@ createProposal ps = builder
, ---
output $
mconcat
[ script proposalValidatorHash
[ script proposalScriptHash
, withValue proposalValue
, 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 (
minAda,
proposalAssetClass,
proposalScriptHash,
proposalValidator,
proposalValidatorHash,
stakeAssetClass,
stakeScriptHash,
stakeValidator,
stakeValidatorHash,
)
import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util (CombinableBuilder, closedBoundedInterval, mkSpending, pubKeyHashes)
@ -166,7 +166,7 @@ privilegeEscalate op =
mconcat @b
[ input $
mconcat
[ script stakeValidatorHash
[ script stakeScriptHash
, withDatum stakeInput
, withValue stakeValue
, withRef $ mkStakeRef index
@ -174,7 +174,7 @@ privilegeEscalate op =
]
, output $
mconcat
[ script stakeValidatorHash
[ script stakeScriptHash
, withDatum stakeOutput
, withValue stakeValue
]
@ -196,7 +196,7 @@ privilegeEscalate op =
mconcat @b
[ input $
mconcat
[ script proposalValidatorHash
[ script proposalScriptHash
, withDatum proposalInput
, withRedeemer $ mkProposalRedeemer op
, withValue proposalValue
@ -204,7 +204,7 @@ privilegeEscalate op =
]
, output $
mconcat
[ script proposalValidatorHash
[ script proposalScriptHash
, withDatum proposalOutput
, withValue proposalValue
]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -53,23 +53,21 @@ import Control.Composition ((.**), (.***))
import Data.Coerce (coerce)
import Data.Text qualified as Text
import Plutarch.Evaluate (evalScript)
import PlutusLedgerApi.V1.Scripts (
Context (Context),
applyMintingPolicyScript,
applyValidator,
)
import Plutarch.Script (Script (Script))
import PlutusCore.Data qualified as PLC
import PlutusCore.MkPlc qualified as PLC
import PlutusLedgerApi.V2 (
Datum (..),
MintingPolicy,
Redeemer (Redeemer),
Script,
ScriptContext,
ToData (toBuiltinData),
Validator,
toData,
)
import PlutusPrelude (over)
import PlutusTx.IsData qualified as PlutusTx (ToData)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase)
import UntypedPlutusCore qualified as UPLC
{- | Expectations upon execution of script
@Success@ indicates a successful execution.
@ -169,9 +167,6 @@ scriptSucceeds name script = Terminal $ Specification name Success script
scriptFails :: String -> Script -> SpecificationTree
scriptFails name script = Terminal $ Specification name Failure script
mkContext :: ScriptContext -> Context
mkContext = Context . toBuiltinData
mkRedeemer ::
forall redeemer.
(PlutusTx.ToData redeemer) =>
@ -188,37 +183,39 @@ mkDatum = Datum . toBuiltinData
applyMintingPolicy' ::
(PlutusTx.ToData redeemer) =>
MintingPolicy ->
Script ->
redeemer ->
ScriptContext ->
Script
applyMintingPolicy' policy redeemer scriptContext =
applyMintingPolicyScript
(mkContext scriptContext)
applyArguments
policy
(mkRedeemer redeemer)
[ toData $ mkRedeemer redeemer
, toData scriptContext
]
applyValidator' ::
( PlutusTx.ToData datum
, PlutusTx.ToData redeemer
) =>
Validator ->
Script ->
datum ->
redeemer ->
ScriptContext ->
Script
applyValidator' validator datum redeemer scriptContext =
applyValidator
(mkContext scriptContext)
applyArguments
validator
(mkDatum datum)
(mkRedeemer redeemer)
[ toData $ mkDatum datum
, toData $ mkRedeemer redeemer
, toData scriptContext
]
-- | Check that a policy script succeeds, given a name and arguments.
policySucceedsWith ::
(PlutusTx.ToData redeemer) =>
String ->
MintingPolicy ->
Script ->
redeemer ->
ScriptContext ->
SpecificationTree
@ -229,7 +226,7 @@ policySucceedsWith tag =
policyFailsWith ::
(PlutusTx.ToData redeemer) =>
String ->
MintingPolicy ->
Script ->
redeemer ->
ScriptContext ->
SpecificationTree
@ -242,7 +239,7 @@ validatorSucceedsWith ::
, PlutusTx.ToData redeemer
) =>
String ->
Validator ->
Script ->
datum ->
redeemer ->
ScriptContext ->
@ -256,7 +253,7 @@ validatorFailsWith ::
, PlutusTx.ToData redeemer
) =>
String ->
Validator ->
Script ->
datum ->
redeemer ->
ScriptContext ->
@ -269,7 +266,7 @@ effectSucceedsWith ::
( PlutusTx.ToData datum
) =>
String ->
Validator ->
Script ->
datum ->
ScriptContext ->
SpecificationTree
@ -280,7 +277,7 @@ effectFailsWith ::
( PlutusTx.ToData datum
) =>
String ->
Validator ->
Script ->
datum ->
ScriptContext ->
SpecificationTree
@ -293,7 +290,7 @@ testValidator ::
-- | Is this test case expected to succeed?
Bool ->
String ->
Validator ->
Script ->
datum ->
redeemer ->
ScriptContext ->
@ -310,7 +307,7 @@ testPolicy ::
-- | Is this test case expected to succeed?
Bool ->
String ->
MintingPolicy ->
Script ->
redeemer ->
ScriptContext ->
SpecificationTree
@ -318,3 +315,11 @@ testPolicy isValid =
if isValid
then policySucceedsWith
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,
ScriptHash (ScriptHash),
TxOutRef,
ValidatorHash (ValidatorHash),
)
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins qualified as PlutusTx
@ -157,8 +156,8 @@ userCredentials :: [Credential]
userCredentials = PubKeyCredential <$> pubKeyHashes
-- | An infinite list of *valid* validator hashes.
validatorHashes :: [ValidatorHash]
validatorHashes = ValidatorHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
validatorHashes :: [ScriptHash]
validatorHashes = ScriptHash . PlutusTx.toBuiltin <$> blake2b_224Hashes
-- | An infinite list of *valid* script credentials.
scriptCredentials :: [Credential]

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

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

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

@ -43,11 +43,12 @@ import Agora.Stake (
)
import Agora.Utils (ptaggedSymbolValueOf, ptoScottEncodingT, puntag)
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 qualified as AssocMap
import Plutarch.Api.V2 (
PMintingPolicy,
PScriptHash,
PScriptPurpose (PMinting, PSpending),
PTxOut,
PTxOutRef,
@ -67,7 +68,6 @@ import Plutarch.Extra.ScriptContext (
pscriptHashToTokenName,
ptryFromDatumHash,
ptryFromOutputDatum,
pvalidatorHashFromAddress,
pvalueSpent,
)
import Plutarch.Extra.Tagged (PTagged)
@ -264,7 +264,7 @@ governorPolicy =
governorValidator ::
-- | Lazy precompiled scripts.
ClosedTerm
( PValidatorHash
( PScriptHash
:--> PTagged StakeSTTag PAssetClassData
:--> PTagged GovernorSTTag PCurrencySymbol
:--> PTagged ProposalSTTag PCurrencySymbol
@ -272,7 +272,7 @@ governorValidator ::
:--> PValidator
)
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
txInfo <- pletC $ pfromData ctxF.txInfo
txInfoF <-
@ -317,7 +317,7 @@ governorValidator =
foldl1
(#&&)
[ ptraceIfFalse "Own by governor validator" $
((#==) `on` (pvalidatorHashFromAddress #))
((#==) `on` (pscriptHashFromAddress #))
outputF.address
governorInputF.address
, ptraceIfFalse "Has governor ST" $
@ -345,8 +345,8 @@ governorValidator =
plam $
flip (pletFields @'["value", "datum", "address"]) $ \txOutF ->
let isProposalUTxO =
(pfromJust #$ pvalidatorHashFromAddress # pfromData txOutF.address)
#== proposalValidatorHash
(pfromJust #$ pscriptHashFromAddress # pfromData txOutF.address)
#== proposalScriptHash
#&& passetClassValueOf
# pstClass
# txOutF.value
@ -500,82 +500,83 @@ governorValidator =
-- The effects of the winner outcome.
effectGroup <- pletC $ ptryLookup # finalResultTag #$ proposalInputDatumF.effects
let -- For a given output, check if it contains a single valid GAT.
getReceiverScriptHash =
plam
( \output -> unTermCont $ do
outputF <- pletFieldsC @'["address", "datum", "value"] output
let
-- For a given output, check if it contains a single valid GAT.
getReceiverScriptHash =
plam
( \output -> unTermCont $ do
outputF <- pletFieldsC @'["address", "datum", "value"] output
let atAmount =
ptaggedSymbolValueOf
# atSymbol
# outputF.value
let atAmount =
ptaggedSymbolValueOf
# atSymbol
# outputF.value
handleAuthorityUTxO =
do
receiverScriptHash <-
pletC $
passertPJust
# "GAT receiver should be a script"
#$ pscriptHashFromAddress
# outputF.address
handleAuthorityUTxO =
do
receiverScriptHash <-
pletC $
passertPJust
# "GAT receiver should be a script"
#$ pscriptHashFromAddress
# outputF.address
effect <-
pletAllC $
passertPJust
# "Receiver should be in the effect group"
#$ AssocMap.plookup
# receiverScriptHash
# effectGroup
effect <-
pletAllC $
passertPJust
# "Receiver should be in the effect group"
#$ AssocMap.plookup
# receiverScriptHash
# effectGroup
let tagToken =
pmaybeData
# pconstant ""
# plam (pscriptHashToTokenName . pfromData)
# effect.scriptHash
gatAssetClass = passetClass # puntag atSymbol # tagToken
valueGATCorrect =
passetClassValueOf
# gatAssetClass
# outputF.value
#== 1
let tagToken =
pmaybeData
# pconstant ""
# plam (pscriptHashToTokenName . pfromData)
# effect.scriptHash
gatAssetClass = passetClass # puntag atSymbol # tagToken
valueGATCorrect =
passetClassValueOf
# gatAssetClass
# outputF.value
#== 1
let hasCorrectDatum =
effect.datumHash #== ptryFromDatumHash # outputF.datum
let hasCorrectDatum =
effect.datumHash #== ptryFromDatumHash # outputF.datum
pguardC "Authority output valid" $
foldr1
(#&&)
[ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output
, ptraceIfFalse "Correct datum" hasCorrectDatum
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
]
pguardC "Authority output valid" $
foldr1
(#&&)
[ ptraceIfFalse "GAT valid" $ authorityTokensValidIn # atSymbol # output
, ptraceIfFalse "Correct datum" hasCorrectDatum
, ptraceIfFalse "Value correctly encodes Auth Check script" valueGATCorrect
]
pure $ pjust # receiverScriptHash
pure $ pjust # receiverScriptHash
pmatchC
( pcompareBy
# pfromOrd
# atAmount
# 1
)
>>= \case
-- atAmount == 1
PEQ -> handleAuthorityUTxO
-- atAmount < 1
PLT -> pure pnothing
-- atAmount > 1
PGT -> pure $ ptraceError "More than one GAT in one UTxO"
)
pmatchC
( pcompareBy
# pfromOrd
# atAmount
# 1
)
>>= \case
-- atAmount == 1
PEQ -> handleAuthorityUTxO
-- atAmount < 1
PLT -> pure pnothing
-- atAmount > 1
PGT -> pure $ ptraceError "More than one GAT in one UTxO"
)
-- The sorted hashes of all the GAT receivers.
actualReceivers =
psort
#$ pmapMaybe @PList
# getReceiverScriptHash
# pfromData txInfoF.outputs
-- The sorted hashes of all the GAT receivers.
actualReceivers =
psort
#$ pmapMaybe @PList
# getReceiverScriptHash
# pfromData txInfoF.outputs
expectedReceivers = pkeys @PList # effectGroup
expectedReceivers = pkeys @PList # effectGroup
-- This check ensures that it's impossible to send more than one GATs
-- 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.Map (fromList)
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.ScriptContext (validatorHashToTokenName)
import PlutusLedgerApi.V1 (CurrencySymbol, TxOutRef, ValidatorHash)
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
import PlutusLedgerApi.V1 (CurrencySymbol (CurrencySymbol), ScriptHash, TxOutRef, getScriptHash)
import Ply (
ScriptRole (MintingPolicyRole, ValidatorRole),
toMintingPolicy,
toValidator,
(#),
)
import ScriptExport.ScriptInfo (
@ -23,6 +21,7 @@ import ScriptExport.ScriptInfo (
fetchTS,
getParam,
toRoledScript,
toScript,
)
import Prelude hiding ((#))
@ -54,7 +53,7 @@ linker = do
govVal <-
fetchTS
@ValidatorRole
@'[ ValidatorHash
@'[ ScriptHash
, Tagged StakeSTTag AssetClass
, Tagged GovernorSTTag CurrencySymbol
, Tagged ProposalSTTag CurrencySymbol
@ -110,7 +109,7 @@ linker = do
mutateGovVal <-
fetchTS
@ValidatorRole
@'[ ValidatorHash
@'[ ScriptHash
, Tagged GovernorSTTag CurrencySymbol
, Tagged AuthorityTokenTag CurrencySymbol
]
@ -126,16 +125,13 @@ linker = do
# Tagged gstSymbol
# Tagged pstSymbol
# Tagged atSymbol
gstSymbol =
mintingPolicySymbol $
toMintingPolicy
govPol'
gstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript govPol'
gstAssetClass =
AssetClass gstSymbol ""
govValHash = validatorHash $ toValidator govVal'
govValHash = scriptHash $ toScript govVal'
atPol' = atkPol # Tagged gstAssetClass
atSymbol = mintingPolicySymbol $ toMintingPolicy atPol'
atSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript atPol'
propPol' = prpPol # Tagged gstAssetClass
propVal' =
@ -144,8 +140,8 @@ linker = do
# Tagged gstSymbol
# Tagged pstSymbol
# governor.maximumCosigners
propValHash = validatorHash $ toValidator propVal'
pstSymbol = mintingPolicySymbol $ toMintingPolicy propPol'
propValHash = scriptHash $ toScript propVal'
pstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript propPol'
pstAssetClass = AssetClass pstSymbol ""
stakPol' = stkPol # governor.gtClassRef
@ -154,9 +150,9 @@ linker = do
# Tagged sstSymbol
# Tagged pstAssetClass
# governor.gtClassRef
sstSymbol = mintingPolicySymbol $ toMintingPolicy stakPol'
sstSymbol = CurrencySymbol . getScriptHash . scriptHash $ toScript stakPol'
stakValTokenName =
validatorHashToTokenName $ validatorHash $ toValidator stakVal'
scriptHashToTokenName $ scriptHash $ toScript stakVal'
sstAssetClass = AssetClass sstSymbol stakValTokenName
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.Tagged (Tagged)
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.V2 (
KeyGuarantees (Sorted),
@ -88,7 +88,7 @@ import Plutarch.Lift (
PUnsafeLiftDecl (type PLifted),
)
import Plutarch.Orphans ()
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash)
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash)
import PlutusTx qualified
--------------------------------------------------------------------------------
@ -315,7 +315,7 @@ data ProposalEffectMetadata = ProposalEffectMetadata
via (ProductIsData ProposalEffectMetadata)
-- | @since 1.0.0
type ProposalEffectGroup = StrictMap.Map ValidatorHash ProposalEffectMetadata
type ProposalEffectGroup = StrictMap.Map ScriptHash ProposalEffectMetadata
{- | Haskell-level datum for Proposal scripts.
@ -695,7 +695,7 @@ instance PTryFrom PData (PAsData PProposalEffectMetadata)
type PProposalEffectGroup =
PMap
'Sorted
PValidatorHash
PScriptHash
PProposalEffectMetadata
{- | 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.ScriptContext (
pfindTxInByTxOutRef,
pscriptHashFromAddress,
ptryFromOutputDatum,
pvalidatorHashFromAddress,
)
import Plutarch.Extra.Sum (PSum (PSum))
import Plutarch.Extra.Tagged (PTagged)
@ -285,7 +285,7 @@ proposalValidator =
foldl1
(#&&)
[ ptraceIfFalse "Own by proposal validator" $
((#==) `on` (pvalidatorHashFromAddress #))
((#==) `on` (pscriptHashFromAddress #))
outputF.address
proposalInputF.address
, ptraceIfFalse "Has proposal ST" $
@ -523,39 +523,40 @@ proposalValidator =
pguardC "Vote option should be valid" $
pisJust #$ plookup # voteFor # voteMap
let -- The amount of new votes should be the 'stakedAmount'.
-- Update the vote counter of the proposal, and leave other stuff as is.
expectedNewVotes =
pcon $
PProposalVotes $
pupdate
# plam
( \votes ->
pcon $ PJust $ votes + pto totalStakeAmount
)
# voteFor
# pto (pfromData proposalInputDatumF.votes)
let
-- The amount of new votes should be the 'stakedAmount'.
-- Update the vote counter of the proposal, and leave other stuff as is.
expectedNewVotes =
pcon $
PProposalVotes $
pupdate
# plam
( \votes ->
pcon $ PJust $ votes + pto totalStakeAmount
)
# voteFor
# pto (pfromData proposalInputDatumF.votes)
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId
.= proposalInputDatumF.proposalId
.& #effects
.= proposalInputDatumF.effects
.& #status
.= proposalInputDatumF.status
.& #cosigners
.= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= pdata expectedNewVotes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
)
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId
.= proposalInputDatumF.proposalId
.& #effects
.= proposalInputDatumF.effects
.& #status
.= proposalInputDatumF.status
.& #cosigners
.= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= pdata expectedNewVotes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
)
pguardC "Output proposal should be valid" $
proposalOutputDatum #== expectedProposalOut
@ -615,34 +616,36 @@ proposalValidator =
pguardC "Proposal output correct" $
pif
shouldUpdateVotes
( let -- Remove votes and leave other parts of the proposal as it.
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId
.= proposalInputDatumF.proposalId
.& #effects
.= proposalInputDatumF.effects
.& #status
.= proposalInputDatumF.status
.& #cosigners
.= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= expectedVotes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
)
in foldl1
(#&&)
[ ptraceIfFalse "Votes changed" $
pnot #$ expectedVotes #== proposalInputDatumF.votes
, ptraceIfFalse "Proposal update correct" $
expectedProposalOut #== proposalOutputDatum
]
( let
-- Remove votes and leave other parts of the proposal as it.
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId
.= proposalInputDatumF.proposalId
.& #effects
.= proposalInputDatumF.effects
.& #status
.= proposalInputDatumF.status
.& #cosigners
.= proposalInputDatumF.cosigners
.& #thresholds
.= proposalInputDatumF.thresholds
.& #votes
.= expectedVotes
.& #timingConfig
.= proposalInputDatumF.timingConfig
.& #startingTime
.= proposalInputDatumF.startingTime
)
in
foldl1
(#&&)
[ ptraceIfFalse "Votes changed" $
pnot #$ expectedVotes #== proposalInputDatumF.votes
, ptraceIfFalse "Proposal update correct" $
expectedProposalOut #== proposalOutputDatum
]
)
-- No change to the proposal is allowed.
( 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.ScriptContext (
pfindTxInByTxOutRef,
pscriptHashFromAddress,
pscriptHashToTokenName,
ptryFromOutputDatum,
pvalidatorHashFromAddress,
pvalidatorHashToTokenName,
pvalueSpent,
)
import Plutarch.Extra.Tagged (PTagged)
@ -122,7 +122,7 @@ import Prelude hiding (Num ((+)))
- Check that exactly one state thread is minted.
- Check that an output exists with a state thread and a valid datum.
- 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.
=== For burning:
@ -290,14 +290,14 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
# (pfield @"_0" # stakeInputRef)
# txInfoF.inputs
stakeValidatorHash <-
stakeScriptHash <-
pletC $
pfromJust
#$ pvalidatorHashFromAddress
#$ pscriptHashFromAddress
#$ pfield @"address"
# validatedInput
let sstName = pvalidatorHashToTokenName stakeValidatorHash
let sstName = pscriptHashToTokenName stakeScriptHash
sstClass <- pletC $ passetClass # puntag sstSymbol # sstName
@ -321,11 +321,11 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
PEQ ->
let ownerValidatoHash =
pfromJust
#$ pvalidatorHashFromAddress
#$ pscriptHashFromAddress
# txOutF.address
isOwnedByStakeValidator =
ownerValidatoHash #== stakeValidatorHash
ownerValidatoHash #== stakeScriptHash
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.
-}
module Agora.Utils (
validatorHashToAddress,
scriptHashToAddress,
pstringIntercalate,
punwords,
pisNothing,
@ -33,15 +33,15 @@ import Plutarch.Unsafe (punsafeDowncast)
import PlutusLedgerApi.V2 (
Address (Address),
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
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing
scriptHashToAddress :: ScriptHash -> Address
scriptHashToAddress vh = Address (ScriptCredential vh) Nothing
-- | @since 1.0.0
pstringIntercalate ::

3
default.nix Normal file
View file

@ -0,0 +1,3 @@
{
imports = [ ./flake-module.nix ];
}

28
flake-module.nix Normal file
View file

@ -0,0 +1,28 @@
{ self, ... }:
{
perSystem = { config, pkgs', self', inputs, system, ... }:
let
pkgs = import self.inputs.nixpkgs {
inherit system;
};
in
{
onchain.default = {
src = ./.;
ghc = {
version = "ghc923";
};
shell = { };
enableBuildChecks = true;
extraHackageDeps = [
"${self.inputs.plutarch-numeric}"
"${self.inputs.plutarch-quickcheck}"
"${self.inputs.plutarch-context-builder}"
"${self.inputs.liqwid-plutarch-extra}"
"${self.inputs.liqwid-script-export}"
"${self.inputs.liqwid-script-export.inputs.ply}/ply-core"
"${self.inputs.liqwid-script-export.inputs.ply}/ply-plutarch"
];
};
};
}

207
flake.nix
View file

@ -1,173 +1,46 @@
{
description = "agora";
inputs = {
nixpkgs.follows = "plutarch/nixpkgs";
nixpkgs-latest.url = "github:NixOS/nixpkgs";
# temporary fix for nix versions that have the transitive follows bug
# see https://github.com/NixOS/nix/issues/6013
nixpkgs-2111 = { url = "github:NixOS/nixpkgs/nixpkgs-21.11-darwin"; };
nixpkgs-2205 = { url = "github:NixOS/nixpkgs/nixos-22.05"; };
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";
};
nixConfig = {
extra-experimental-features = [ "nix-command" "flakes" "ca-derivations" ];
extra-substituters = [ "https://cache.iog.io" "https://public-plutonomicon.cachix.org" "https://mlabs.cachix.org" ];
extra-trusted-public-keys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "public-plutonomicon.cachix.org-1:3AKJMhCLn32gri1drGuaZmFrmnue+KkKrhhubQk/CWc=" ];
allow-import-from-derivation = "true";
bash-prompt = "\\[\\e[0m\\][\\[\\e[0;2m\\]liqwid-nix \\e[0;5m\\]2.0 \\[\\e[0;93m\\]\\w\\[\\e[0m\\]]\\[\\e[0m\\]$ \\[\\e[0m\\]";
max-jobs = "auto";
auto-optimise-store = "true";
};
outputs = inputs@{ liqwid-nix, ... }:
let
benchCheckOverlay = self: super: {
toFlake =
let
inherit (self) inputs perSystem pkgsFor';
flake = super.toFlake or { };
name = "benchCheck";
in
flake // {
checks = perSystem (system:
flake.checks.${system} // {
${name} =
let
pkgs' = pkgsFor' system;
bench = flake.packages.${system}."agora:bench:agora-bench";
in
pkgs'.runCommand name
{
nativeBuildInputs = [ pkgs'.diffutils ];
} ''
export LC_CTYPE=C.UTF-8
export LC_ALL=C.UTF-8
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
(liqwid-nix.buildProject
{
inherit inputs;
src = ./.;
}
[
liqwid-nix.haskellProject
liqwid-nix.plutarchProject
(liqwid-nix.addDependencies [
"${inputs.plutarch-numeric}"
"${inputs.plutarch-quickcheck}"
"${inputs.plutarch-context-builder}"
"${inputs.liqwid-plutarch-extra}"
"${inputs.liqwid-script-export}"
"${inputs.liqwid-script-export.inputs.ply}/ply-core"
"${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;
inputs = {
nixpkgs.follows = "liqwid-nix/nixpkgs";
nixpkgs-latest.url = "github:NixOS/nixpkgs";
liqwid-nix = {
url = "github:Liqwid-Labs/liqwid-nix/liqwid-nix-2.0";
inputs.nixpkgs-latest.follows = "nixpkgs-latest";
};
ply.url = "github:emiflake/ply?ref=emiflake/add-missing-instance";
plutarch-numeric.url = "github:Liqwid-Labs/plutarch-numeric/emiflake/liqwid-nix-2.0";
plutarch-numeric.inputs.ply.follows = "ply";
liqwid-plutarch-extra.url = "github:Liqwid-Labs/liqwid-plutarch-extra/emiflake/liqwid-nix-2.0";
liqwid-plutarch-extra.inputs.ply.follows = "ply";
plutarch-quickcheck.url = "github:liqwid-labs/plutarch-quickcheck/emiflake/liqwid-nix-2.0";
plutarch-quickcheck.inputs.ply.follows = "ply";
plutarch-context-builder.url = "github:Liqwid-Labs/plutarch-context-builder/emiflake/liqwid-nix-2.0";
plutarch-context-builder.inputs.ply.follows = "ply";
liqwid-script-export.url = "github:Liqwid-Labs/liqwid-script-export/emiflake/liqwid-nix-2.0";
liqwid-script-export.inputs.ply.follows = "ply";
};
outputs = { self, liqwid-nix, flake-parts, ... }:
flake-parts.lib.mkFlake { inherit self; } {
imports = [
liqwid-nix.onchain
liqwid-nix.run
./.
];
systems = [ "x86_64-linux" "aarch64-darwin" "x86_64-darwin" "aarch64-linux" ];
perSystem = { config, self', inputs', pkgs, system, ... }: { };
};
}