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

flake: bump plutarch, fix resulting issues

Browse source 
Collection of things fixed:
- `agora-test`: Fix compile resulting from some changes to hackage.
- `agora-benchmark`: Switched to `plutarch`-style `evalScript`.
- CI: Ported over new flake changes.

This is quite a mess.
This commit is contained in:
Emily Martins 2022-06-02 20:30:28 +02:00
parent 0348f72499
commit 5049441dfc
49 changed files with 3487 additions and 3829 deletions
Download patch file Download diff file Expand all files Collapse all files

59
agora/Agora/Proposal.hs
View file

@ -38,6 +38,7 @@ module Agora.Proposal (
import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I))
import Plutarch.Api.V1 (
KeyGuarantees (Unsorted),
PDatumHash,
PMap,
PPubKeyHash,
@ -63,8 +64,8 @@ import Plutarch.Lift (
import Plutarch.SafeMoney (PDiscrete)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)
import Plutus.V1.Ledger.Api (DatumHash, PubKeyHash, ValidatorHash)
import Plutus.V1.Ledger.Value (AssetClass)
import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
import PlutusLedgerApi.V1.Value (AssetClass)
--------------------------------------------------------------------------------
-- Haskell-land
@ -322,14 +323,14 @@ deriving via (DerivePConstantViaData ProposalStatus PProposalStatus) instance (P
-- | Plutarch-level version of 'ProposalThresholds'.
newtype PProposalThresholds (s :: S) = PProposalThresholds
{ getProposalThresholds ::
Term
s
( PDataRecord
'[ "execute" ':= PDiscrete GTTag
, "draft" ':= PDiscrete GTTag
, "vote" ':= PDiscrete GTTag
]
)
Term
s
( PDataRecord
'[ "execute" ':= PDiscrete GTTag
, "draft" ':= PDiscrete GTTag
, "vote" ':= PDiscrete GTTag
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
@ -343,17 +344,17 @@ deriving via (DerivePConstantViaData ProposalThresholds PProposalThresholds) ins
-- | Plutarch-level version of 'ProposalVotes'.
newtype PProposalVotes (s :: S)
= PProposalVotes (Term s (PMap PResultTag PInteger))
deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap PResultTag PInteger))
= PProposalVotes (Term s (PMap 'Unsorted PResultTag PInteger))
deriving (PlutusType, PIsData) via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
instance PUnsafeLiftDecl PProposalVotes where type PLifted PProposalVotes = ProposalVotes
deriving via
(DerivePConstantViaNewtype ProposalVotes PProposalVotes (PMap PResultTag PInteger))
(DerivePConstantViaNewtype ProposalVotes PProposalVotes (PMap 'Unsorted PResultTag PInteger))
instance
(PConstantDecl ProposalVotes)
-- | Plutarch-level version of 'emptyVotesFor'.
pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap PResultTag a :--> PProposalVotes)
pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap 'Unsorted PResultTag a :--> PProposalVotes)
pemptyVotesFor =
phoistAcyclic $
plam
@ -365,19 +366,19 @@ pemptyVotesFor =
-- | Plutarch-level version of 'ProposalDatum'.
newtype PProposalDatum (s :: S) = PProposalDatum
{ getProposalDatum ::
Term
s
( PDataRecord
'[ "proposalId" ':= PProposalId
, "effects" ':= PMap PResultTag (PMap PValidatorHash PDatumHash)
, "status" ':= PProposalStatus
, "cosigners" ':= PBuiltinList (PAsData PPubKeyHash)
, "thresholds" ':= PProposalThresholds
, "votes" ':= PProposalVotes
, "timingConfig" ':= PProposalTimingConfig
, "startingTime" ':= PProposalStartingTime
]
)
Term
s
( PDataRecord
'[ "proposalId" ':= PProposalId
, "effects" ':= PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
, "status" ':= PProposalStatus
, "cosigners" ':= PBuiltinList (PAsData PPubKeyHash)
, "thresholds" ':= PProposalThresholds
, "votes" ':= PProposalVotes
, "timingConfig" ':= PProposalTimingConfig
, "startingTime" ':= PProposalStartingTime
]
)
}
deriving stock (GHC.Generic)
deriving anyclass (Generic)
@ -530,7 +531,7 @@ phighestVotes = phoistAcyclic $
pneutralOption ::
Term
s
( PMap PResultTag (PMap PValidatorHash PDatumHash)
( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
:--> PResultTag
)
pneutralOption = phoistAcyclic $
@ -538,7 +539,7 @@ pneutralOption = phoistAcyclic $
let l :: Term _ (PBuiltinList (PBuiltinPair (PAsData PResultTag) _))
l = pto effects
f :: Term _ (PBuiltinPair (PAsData PResultTag) (PAsData (PMap _ _)) :--> PBool)
f :: Term _ (PBuiltinPair (PAsData PResultTag) (PAsData (PMap 'Unsorted _ _)) :--> PBool)
f = phoistAcyclic $
plam $ \((pfromData . (psndBuiltin #) -> el)) ->
let el' :: Term _ (PBuiltinList _)