fix Agora's PTryFrom instances through orphans
This commit is contained in:
Emily Martins
parent
f6f061a344
commit
f48027f353
8 changed files with 208 additions and 116 deletions
|
|
@ -153,7 +153,10 @@ library
|
|||
Agora.Treasury
|
||||
Agora.Utils
|
||||
|
||||
other-modules: Agora.Aeson.Orphans
|
||||
other-modules:
|
||||
Agora.Aeson.Orphans
|
||||
Agora.Plutarch.Orphans
|
||||
|
||||
hs-source-dirs: agora
|
||||
|
||||
library pprelude
|
||||
|
|
|
|||
|
|
@ -29,12 +29,12 @@ import Agora.Governor.Scripts (
|
|||
authorityTokenSymbolFromGovernor,
|
||||
governorSTAssetClassFromGovernor,
|
||||
)
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import Agora.Utils (
|
||||
isScriptAddress,
|
||||
mustBePDJust,
|
||||
mustBePJust,
|
||||
)
|
||||
import Control.Applicative (Const)
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, I (I))
|
||||
import Plutarch.Api.V1 (
|
||||
|
|
@ -51,8 +51,6 @@ import Plutarch.DataRepr (
|
|||
)
|
||||
import Plutarch.Extra.TermCont (pguardC)
|
||||
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
|
||||
import Plutarch.TryFrom (PTryFrom (..))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (..))
|
||||
import PlutusTx qualified
|
||||
|
|
@ -120,13 +118,8 @@ instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernor
|
|||
-- | @since 0.1.0
|
||||
deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) instance (PConstantDecl MutateGovernorDatum)
|
||||
|
||||
-- TODO: Derive this.
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PMutateGovernorDatum) where
|
||||
type PTryFromExcess PData (PAsData PMutateGovernorDatum) = Const ()
|
||||
ptryFrom' d k =
|
||||
k (punsafeCoerce d, ())
|
||||
deriving via PAsData (PIsDataReprInstances PMutateGovernorDatum) instance PTryFrom PData (PAsData PMutateGovernorDatum)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -14,8 +14,8 @@ module Agora.Effect.TreasuryWithdrawal (
|
|||
) where
|
||||
|
||||
import Agora.Effect (makeEffect)
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import Agora.Utils (isPubKey)
|
||||
import Control.Applicative (Const)
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, I (I))
|
||||
import Plutarch.Api.V1 (
|
||||
|
|
@ -35,9 +35,7 @@ import Plutarch.DataRepr (
|
|||
PIsDataReprInstances (..),
|
||||
)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC, pmatchC)
|
||||
import Plutarch.Internal (punsafeCoerce)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||
import Plutarch.TryFrom (PTryFrom (..))
|
||||
import PlutusLedgerApi.V1.Credential (Credential)
|
||||
import PlutusLedgerApi.V1.Value (CurrencySymbol, Value)
|
||||
import PlutusTx qualified
|
||||
|
|
@ -118,12 +116,10 @@ deriving via
|
|||
(PConstantDecl TreasuryWithdrawalDatum)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PTreasuryWithdrawalDatum) where
|
||||
type PTryFromExcess PData (PAsData PTreasuryWithdrawalDatum) = Const ()
|
||||
ptryFrom' opq cont =
|
||||
-- TODO: This should not use 'punsafeCoerce'.
|
||||
-- Blocked by 'PCredential', and 'PTuple'.
|
||||
cont (punsafeCoerce opq, ())
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PTreasuryWithdrawalDatum)
|
||||
instance
|
||||
PTryFrom PData (PAsData PTreasuryWithdrawalDatum)
|
||||
|
||||
{- | Withdraws given list of values to specific target addresses.
|
||||
It can be evoked by burning GAT. The transaction should have correct
|
||||
|
|
|
|||
|
|
@ -36,7 +36,6 @@ import Agora.Proposal.Time (
|
|||
ProposalTimingConfig,
|
||||
)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Control.Applicative (Const)
|
||||
import Data.Tagged (Tagged (..))
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, I (I))
|
||||
|
|
@ -49,8 +48,6 @@ import Plutarch.Extra.Comonad (pextract)
|
|||
import Plutarch.Extra.TermCont (pletC, pmatchC)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||
import Plutarch.SafeMoney (PDiscrete (..))
|
||||
import Plutarch.TryFrom (PTryFrom (..))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import PlutusLedgerApi.V1 (TxOutRef)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass (..))
|
||||
import PlutusTx qualified
|
||||
|
|
@ -168,14 +165,8 @@ instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = Gove
|
|||
-- | @since 0.1.0
|
||||
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum)
|
||||
|
||||
-- FIXME: derive this via 'PIsDataReprInstances'
|
||||
-- Blocked by: PProposalThresholds
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PGovernorDatum) where
|
||||
type PTryFromExcess PData (PAsData PGovernorDatum) = Const ()
|
||||
|
||||
ptryFrom' d k = k (punsafeCoerce d, ())
|
||||
deriving via PAsData (PIsDataReprInstances PGovernorDatum) instance PTryFrom PData (PAsData PGovernorDatum)
|
||||
|
||||
{- | Plutarch-level version of 'GovernorRedeemer'.
|
||||
|
||||
|
|
|
|||
134
agora/Agora/Plutarch/Orphans.hs
Normal file
134
agora/Agora/Plutarch/Orphans.hs
Normal file
|
|
@ -0,0 +1,134 @@
|
|||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
{- FIXME: All of the following instances and
|
||||
types ought to belong in either plutarch or
|
||||
plutarch-extra.
|
||||
|
||||
A number of these have been "stolen" from Mango's
|
||||
PR: https://github.com/Plutonomicon/plutarch/pull/438/
|
||||
-}
|
||||
|
||||
module Agora.Plutarch.Orphans () where
|
||||
|
||||
import Control.Arrow (first)
|
||||
import Plutarch.Api.V1 (PAddress, PCredential, PCurrencySymbol, PDatumHash, PMap, PMaybeData, PPOSIXTime, PPubKeyHash, PStakingCredential, PTokenName, PTxId, PTxOutRef, PValidatorHash, PValue)
|
||||
import Plutarch.Builtin (PBuiltinMap)
|
||||
import Plutarch.DataRepr (PIsDataReprInstances (..))
|
||||
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
|
||||
import Plutarch.Reducible (Reduce, Reducible)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import Prelude hiding ((+))
|
||||
|
||||
instance Reducible (f x y) => Reducible (Flip f y x) where
|
||||
type Reduce (Flip f y x) = Reduce (f x y)
|
||||
|
||||
newtype Flip f a b = Flip (f b a)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData b) => PTryFrom PData (PAsData (DerivePNewtype c b)) where
|
||||
type
|
||||
PTryFromExcess PData (PAsData (DerivePNewtype c b)) =
|
||||
PTryFromExcess PData (PAsData b)
|
||||
ptryFrom' d k =
|
||||
ptryFrom' @_ @(PAsData b) d $ k . first punsafeCoerce
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PPubKeyHash) where
|
||||
type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
|
||||
ptryFrom' opq = runTermCont $ do
|
||||
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
|
||||
tcont $ ptryFrom @(PAsData PByteString) opq
|
||||
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a PubKeyHash should be 28 bytes long")
|
||||
pure (punsafeCoerce wrapped, punsafeCoerce $ unwrapped)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance AdditiveSemigroup (Term s PPOSIXTime) where
|
||||
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PPOSIXTime PInteger)
|
||||
instance
|
||||
PTryFrom PData (PAsData PPOSIXTime)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PTxId)
|
||||
instance
|
||||
PTryFrom PData (PAsData PTxId)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PTxOutRef)
|
||||
instance
|
||||
PTryFrom PData (PAsData PTxOutRef)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (DerivePNewtype (PMap g k v) (PBuiltinMap k v))
|
||||
instance
|
||||
( PTryFrom PData (PAsData k)
|
||||
, PTryFrom PData (PAsData v)
|
||||
) =>
|
||||
PTryFrom PData (PAsData (PMap g k v))
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PValidatorHash) where
|
||||
type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash
|
||||
ptryFrom' opq = runTermCont $ do
|
||||
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
|
||||
tcont $ ptryFrom @(PAsData PByteString) opq
|
||||
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a ValidatorHash should be 28 bytes long")
|
||||
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PDatumHash) where
|
||||
type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
|
||||
ptryFrom' opq = runTermCont $ do
|
||||
(wrapped :: Term _ (PAsData PByteString), unwrapped :: Term _ PByteString) <-
|
||||
tcont $ ptryFrom @(PAsData PByteString) opq
|
||||
tcont $ \f -> pif (plengthBS # unwrapped #== 28) (f ()) (ptraceError "a DatumHash should be 28 bytes long")
|
||||
pure (punsafeCoerce wrapped, punsafeCoerce unwrapped)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PCurrencySymbol PByteString)
|
||||
instance
|
||||
PTryFrom PData (PAsData PCurrencySymbol)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PTokenName PByteString)
|
||||
instance
|
||||
PTryFrom PData (PAsData PTokenName)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (DerivePNewtype (PValue k v) (PMap k PCurrencySymbol (PMap k PTokenName PInteger)))
|
||||
instance
|
||||
PTryFrom PData (PAsData (PValue k v))
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances (PMaybeData a))
|
||||
instance
|
||||
PTryFrom PData (PAsData a) => PTryFrom PData (PAsData (PMaybeData a))
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PAddress)
|
||||
instance
|
||||
PTryFrom PData (PAsData PAddress)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PCredential)
|
||||
instance
|
||||
PTryFrom PData (PAsData PCredential)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PStakingCredential)
|
||||
instance
|
||||
PTryFrom PData (PAsData PStakingCredential)
|
||||
|
|
@ -39,8 +39,6 @@ module Agora.Proposal (
|
|||
import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Utils (mustBePJust)
|
||||
import Control.Applicative (Const)
|
||||
import Control.Arrow (first)
|
||||
import Data.Tagged (Tagged)
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, I (I))
|
||||
|
|
@ -62,8 +60,6 @@ import Plutarch.Lift (
|
|||
PUnsafeLiftDecl (..),
|
||||
)
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import PlutusLedgerApi.V1 (DatumHash, PubKeyHash, ValidatorHash)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass)
|
||||
import PlutusTx qualified
|
||||
|
|
@ -394,22 +390,11 @@ deriving via
|
|||
instance
|
||||
(PConstantDecl ResultTag)
|
||||
|
||||
-- FIXME: This instance and the one below, for 'PProposalId', should be derived.
|
||||
-- Soon this will be possible through 'DerivePNewtype'.
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PResultTag) where
|
||||
type PTryFromExcess PData (PAsData PResultTag) = PTryFromExcess PData (PAsData PInteger)
|
||||
ptryFrom' d k =
|
||||
ptryFrom' @_ @(PAsData PInteger) d $
|
||||
-- JUSTIFICATION:
|
||||
-- We are coercing from @PAsData PInteger@ to @PAsData PResultTag@.
|
||||
-- Since 'PResultTag' is a simple newtype, their shape is the same.
|
||||
|
||||
-- JUSTIFICATION:
|
||||
-- We are coercing from @PAsData PInteger@ to @PAsData PResultTag@.
|
||||
-- Since 'PResultTag' is a simple newtype, their shape is the same.
|
||||
k . first punsafeCoerce
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PResultTag PInteger)
|
||||
instance
|
||||
PTryFrom PData (PAsData PResultTag)
|
||||
|
||||
{- | Plutarch-level version of 'PProposalId'.
|
||||
|
||||
|
|
@ -429,18 +414,10 @@ newtype PProposalId (s :: S) = PProposalId (Term s PInteger)
|
|||
via (DerivePNewtype PProposalId PInteger)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PProposalId) where
|
||||
type PTryFromExcess PData (PAsData PProposalId) = PTryFromExcess PData (PAsData PInteger)
|
||||
ptryFrom' d k =
|
||||
ptryFrom' @_ @(PAsData PInteger) d $
|
||||
-- JUSTIFICATION:
|
||||
-- We are coercing from @PAsData PInteger@ to @PAsData PProposalId@.
|
||||
-- Since 'PProposalId' is a simple newtype, their shape is the same.
|
||||
|
||||
-- JUSTIFICATION:
|
||||
-- We are coercing from @PAsData PInteger@ to @PAsData PProposalId@.
|
||||
-- Since 'PProposalId' is a simple newtype, their shape is the same.
|
||||
k . first punsafeCoerce
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PProposalId PInteger)
|
||||
instance
|
||||
PTryFrom PData (PAsData PProposalId)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PProposalId where type PLifted PProposalId = ProposalId
|
||||
|
|
@ -487,6 +464,9 @@ data PProposalStatus (s :: S)
|
|||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PProposalStatus where type PLifted PProposalStatus = ProposalStatus
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via PAsData (PIsDataReprInstances PProposalStatus) instance PTryFrom PData (PAsData PProposalStatus)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via (DerivePConstantViaData ProposalStatus PProposalStatus) instance (PConstantDecl ProposalStatus)
|
||||
|
||||
|
|
@ -527,11 +507,20 @@ newtype PProposalThresholds (s :: S) = PProposalThresholds
|
|||
)
|
||||
via (PIsDataReprInstances PProposalThresholds)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PProposalThresholds)
|
||||
instance
|
||||
PTryFrom PData (PAsData PProposalThresholds)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PProposalThresholds where type PLifted PProposalThresholds = ProposalThresholds
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via (DerivePConstantViaData ProposalThresholds PProposalThresholds) instance (PConstantDecl ProposalThresholds)
|
||||
deriving via
|
||||
(DerivePConstantViaData ProposalThresholds PProposalThresholds)
|
||||
instance
|
||||
(PConstantDecl ProposalThresholds)
|
||||
|
||||
{- | Plutarch-level version of 'ProposalVotes'.
|
||||
|
||||
|
|
@ -547,6 +536,12 @@ newtype PProposalVotes (s :: S)
|
|||
)
|
||||
via (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PProposalVotes (PMap 'Unsorted PResultTag PInteger))
|
||||
instance
|
||||
PTryFrom PData (PAsData PProposalVotes)
|
||||
|
||||
{- | Retract votes given the option and the amount of votes.
|
||||
|
||||
@since 0.1.0
|
||||
|
|
@ -634,13 +629,8 @@ newtype PProposalDatum (s :: S) = PProposalDatum
|
|||
)
|
||||
via (PIsDataReprInstances PProposalDatum)
|
||||
|
||||
-- TODO: Derive this.
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PProposalDatum) where
|
||||
type PTryFromExcess PData (PAsData PProposalDatum) = Const ()
|
||||
ptryFrom' d k =
|
||||
k (punsafeCoerce d, ())
|
||||
deriving via PAsData (PIsDataReprInstances PProposalDatum) instance PTryFrom PData (PAsData PProposalDatum)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PProposalDatum where type PLifted PProposalDatum = ProposalDatum
|
||||
|
|
@ -677,19 +667,11 @@ data PProposalRedeemer (s :: S)
|
|||
)
|
||||
via PIsDataReprInstances PProposalRedeemer
|
||||
|
||||
-- See below.
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PTryFrom PData (PAsData PProposalRedeemer) where
|
||||
type PTryFromExcess PData (PAsData PProposalRedeemer) = Const ()
|
||||
ptryFrom' d k =
|
||||
k (punsafeCoerce d, ())
|
||||
|
||||
-- TODO: Waiting on PTryFrom for 'PPubKeyHash'
|
||||
-- deriving via
|
||||
-- PAsData (PIsDataReprInstances PProposalRedeemer)
|
||||
-- instance
|
||||
-- PTryFrom PData (PAsData PProposalRedeemer)
|
||||
deriving via
|
||||
PAsData (PIsDataReprInstances PProposalRedeemer)
|
||||
instance
|
||||
PTryFrom PData (PAsData PProposalRedeemer)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PProposalRedeemer where type PLifted PProposalRedeemer = ProposalRedeemer
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
{- |
|
||||
Module : Agora.Proposal.Time
|
||||
|
|
@ -29,6 +28,7 @@ module Agora.Proposal.Time (
|
|||
isExecutionPeriod,
|
||||
) where
|
||||
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
|
||||
import Plutarch.Api.V1 (
|
||||
|
|
@ -51,7 +51,6 @@ import Plutarch.Lift (
|
|||
PUnsafeLiftDecl (..),
|
||||
)
|
||||
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import PlutusLedgerApi.V1.Time (POSIXTime)
|
||||
import PlutusTx qualified
|
||||
import Prelude hiding ((+))
|
||||
|
|
@ -183,6 +182,11 @@ newtype PProposalStartingTime (s :: S) = PProposalStartingTime (Term s PPOSIXTim
|
|||
instance PUnsafeLiftDecl PProposalStartingTime where
|
||||
type PLifted PProposalStartingTime = ProposalStartingTime
|
||||
|
||||
deriving via
|
||||
PAsData (DerivePNewtype PProposalStartingTime PPOSIXTime)
|
||||
instance
|
||||
PTryFrom PData (PAsData PProposalStartingTime)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via
|
||||
(DerivePConstantViaNewtype ProposalStartingTime PProposalStartingTime PPOSIXTime)
|
||||
|
|
@ -227,6 +231,9 @@ newtype PProposalTimingConfig (s :: S) = PProposalTimingConfig
|
|||
)
|
||||
via (PIsDataReprInstances PProposalTimingConfig)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via PAsData (PIsDataReprInstances PProposalTimingConfig) instance PTryFrom PData (PAsData PProposalTimingConfig)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PProposalTimingConfig where
|
||||
type PLifted PProposalTimingConfig = ProposalTimingConfig
|
||||
|
|
@ -252,6 +259,9 @@ newtype PMaxTimeRangeWidth (s :: S)
|
|||
)
|
||||
via (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via PAsData (DerivePNewtype PMaxTimeRangeWidth PPOSIXTime) instance PTryFrom PData (PAsData PMaxTimeRangeWidth)
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance PUnsafeLiftDecl PMaxTimeRangeWidth where type PLifted PMaxTimeRangeWidth = MaxTimeRangeWidth
|
||||
|
||||
|
|
@ -263,12 +273,6 @@ deriving via
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- FIXME: Orphan instance, move this to plutarch-extra.
|
||||
|
||||
-- | @since 0.1.0
|
||||
instance AdditiveSemigroup (Term s PPOSIXTime) where
|
||||
(punsafeCoerce @_ @_ @PInteger -> x) + (punsafeCoerce @_ @_ @PInteger -> y) = punsafeCoerce $ x + y
|
||||
|
||||
{- | Get the starting time of a proposal, from the 'PlutusLedgerApi.V1.txInfoValidPeriod' field.
|
||||
For every proposal, this is only meant to run once upon creation. Given time range should be
|
||||
tight enough, meaning that the width of the time range should be less than the maximum value.
|
||||
|
|
|
|||
|
|
@ -26,22 +26,12 @@ module Agora.Stake (
|
|||
pgetStakeUsage,
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Control.Applicative (Const)
|
||||
import Agora.Plutarch.Orphans ()
|
||||
import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Data.Tagged (Tagged (..))
|
||||
import GHC.Generics qualified as GHC
|
||||
import Generics.SOP (Generic, HasDatatypeInfo, I (I))
|
||||
import Prelude hiding (Num (..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import PlutusLedgerApi.V1 (PubKeyHash)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass)
|
||||
import PlutusTx qualified
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutarch.Api.V1 (
|
||||
PDatum,
|
||||
PDatumHash,
|
||||
|
|
@ -63,12 +53,10 @@ import Plutarch.Extra.TermCont (pletC, pletFieldsC, pmatchC)
|
|||
import Plutarch.Internal (punsafeCoerce)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import PlutusLedgerApi.V1 (PubKeyHash)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass)
|
||||
import PlutusTx qualified
|
||||
import Prelude hiding (Num (..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -229,13 +217,14 @@ newtype PStakeDatum (s :: S) = PStakeDatum
|
|||
)
|
||||
via (PIsDataReprInstances PStakeDatum)
|
||||
|
||||
instance PTryFrom PData (PAsData PStakeDatum) where
|
||||
type PTryFromExcess PData (PAsData PStakeDatum) = Const ()
|
||||
ptryFrom' d k =
|
||||
k (punsafeCoerce d, ())
|
||||
-- | @since 0.1.0
|
||||
instance Plutarch.Lift.PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum
|
||||
|
||||
instance PUnsafeLiftDecl PStakeDatum where type PLifted PStakeDatum = StakeDatum
|
||||
deriving via (DerivePConstantViaData StakeDatum PStakeDatum) instance (PConstantDecl StakeDatum)
|
||||
-- | @since 0.1.0
|
||||
deriving via (DerivePConstantViaData StakeDatum PStakeDatum) instance (Plutarch.Lift.PConstantDecl StakeDatum)
|
||||
|
||||
-- | @since 0.1.0
|
||||
deriving via PAsData (PIsDataReprInstances PStakeDatum) instance PTryFrom PData (PAsData PStakeDatum)
|
||||
|
||||
{- | Plutarch-level redeemer for Stake scripts.
|
||||
|
||||
|
|
@ -274,8 +263,8 @@ deriving via
|
|||
instance
|
||||
PTryFrom PData (PAsData PStakeRedeemer)
|
||||
|
||||
instance PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer
|
||||
deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (PConstantDecl StakeRedeemer)
|
||||
instance Plutarch.Lift.PUnsafeLiftDecl PStakeRedeemer where type PLifted PStakeRedeemer = StakeRedeemer
|
||||
deriving via (DerivePConstantViaData StakeRedeemer PStakeRedeemer) instance (Plutarch.Lift.PConstantDecl StakeRedeemer)
|
||||
|
||||
{- | Plutarch-level version of 'ProposalLock'.
|
||||
|
||||
|
|
@ -303,8 +292,8 @@ deriving via
|
|||
instance
|
||||
PTryFrom PData (PAsData PProposalLock)
|
||||
|
||||
instance PUnsafeLiftDecl PProposalLock where type PLifted PProposalLock = ProposalLock
|
||||
deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (PConstantDecl ProposalLock)
|
||||
instance Plutarch.Lift.PUnsafeLiftDecl PProposalLock where type PLifted PProposalLock = ProposalLock
|
||||
deriving via (DerivePConstantViaData ProposalLock PProposalLock) instance (Plutarch.Lift.PConstantDecl ProposalLock)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue