remove Agora.MultiSig
This commit is contained in:
parent
01f055d923
commit
3af4a7438a
7 changed files with 1639 additions and 753 deletions
|
|
@ -15,7 +15,6 @@ import Agora.AuthorityToken qualified as AuthorityToken
|
||||||
import Agora.Effect.GovernorMutation qualified as GovernorMutation
|
import Agora.Effect.GovernorMutation qualified as GovernorMutation
|
||||||
import Agora.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawalEffect
|
import Agora.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawalEffect
|
||||||
import Agora.Governor qualified as Governor
|
import Agora.Governor qualified as Governor
|
||||||
import Agora.MultiSig qualified as MultiSig
|
|
||||||
import Agora.Proposal qualified as Proposal
|
import Agora.Proposal qualified as Proposal
|
||||||
import Agora.Stake qualified as Stake
|
import Agora.Stake qualified as Stake
|
||||||
import Agora.Treasury qualified as Treasury
|
import Agora.Treasury qualified as Treasury
|
||||||
|
|
@ -37,8 +36,6 @@ agoraTypes =
|
||||||
mkSumType (Proxy @Governor.GovernorDatum)
|
mkSumType (Proxy @Governor.GovernorDatum)
|
||||||
, mkSumType (Proxy @Governor.GovernorRedeemer)
|
, mkSumType (Proxy @Governor.GovernorRedeemer)
|
||||||
, mkSumType (Proxy @Governor.Governor)
|
, mkSumType (Proxy @Governor.Governor)
|
||||||
, -- MultiSig
|
|
||||||
mkSumType (Proxy @MultiSig.MultiSig)
|
|
||||||
, -- Stake
|
, -- Stake
|
||||||
mkSumType (Proxy @Stake.Stake)
|
mkSumType (Proxy @Stake.Stake)
|
||||||
, mkSumType (Proxy @Stake.ProposalLock)
|
, mkSumType (Proxy @Stake.ProposalLock)
|
||||||
|
|
|
||||||
|
|
@ -1,107 +0,0 @@
|
||||||
{- |
|
|
||||||
Module : Property.MultiSig
|
|
||||||
Maintainer : seungheon.ooh@gmail.com
|
|
||||||
Description: Property tests for 'MultiSig' functions
|
|
||||||
|
|
||||||
Property model and tests for 'MultiSig' functions
|
|
||||||
-}
|
|
||||||
module Property.MultiSig (props) where
|
|
||||||
|
|
||||||
import Agora.MultiSig (
|
|
||||||
MultiSig (MultiSig),
|
|
||||||
PMultiSig,
|
|
||||||
pvalidatedByMultisig,
|
|
||||||
)
|
|
||||||
import Data.Tagged (Tagged (Tagged))
|
|
||||||
import Data.Universe (Finite (..), Universe (..))
|
|
||||||
import Plutarch.Api.V1 (PScriptContext)
|
|
||||||
import Plutarch.Context
|
|
||||||
import Plutarch.Extra.TermCont (pletC)
|
|
||||||
import PlutusLedgerApi.V1 (
|
|
||||||
ScriptContext (..),
|
|
||||||
ScriptPurpose (..),
|
|
||||||
TxInfo (txInfoSignatories),
|
|
||||||
TxOutRef (..),
|
|
||||||
)
|
|
||||||
import Property.Generator (genPubKeyHash)
|
|
||||||
import Test.Tasty (TestTree)
|
|
||||||
import Test.Tasty.Plutarch.Property (classifiedPropertyNative)
|
|
||||||
import Test.Tasty.QuickCheck (
|
|
||||||
Gen,
|
|
||||||
Property,
|
|
||||||
chooseInt,
|
|
||||||
listOf,
|
|
||||||
testProperty,
|
|
||||||
vectorOf,
|
|
||||||
)
|
|
||||||
|
|
||||||
-- | Model for testing multisigs.
|
|
||||||
type MultiSigModel = (MultiSig, ScriptContext)
|
|
||||||
|
|
||||||
-- | Propositions that may hold true of a `MultiSigModel`.
|
|
||||||
data MultiSigProp
|
|
||||||
= -- | Sufficient number of signatories in the script context.
|
|
||||||
MeetsMinSigs
|
|
||||||
| -- | Insufficient number of signatories in the script context.
|
|
||||||
DoesNotMeetMinSigs
|
|
||||||
deriving stock (Eq, Show, Ord)
|
|
||||||
|
|
||||||
instance Universe MultiSigProp where
|
|
||||||
universe = [MeetsMinSigs, DoesNotMeetMinSigs]
|
|
||||||
|
|
||||||
instance Finite MultiSigProp where
|
|
||||||
universeF = universe
|
|
||||||
cardinality = Tagged 2
|
|
||||||
|
|
||||||
-- | Generate model with given proposition.
|
|
||||||
genMultiSigProp :: MultiSigProp -> Gen MultiSigModel
|
|
||||||
genMultiSigProp prop = do
|
|
||||||
size <- chooseInt (4, 20)
|
|
||||||
pkhs <- vectorOf size genPubKeyHash
|
|
||||||
minSig <- chooseInt (1, length pkhs)
|
|
||||||
othersigners <- take 20 <$> listOf genPubKeyHash
|
|
||||||
|
|
||||||
let ms = MultiSig pkhs (toInteger minSig)
|
|
||||||
|
|
||||||
n <- case prop of
|
|
||||||
MeetsMinSigs -> chooseInt (minSig, length pkhs)
|
|
||||||
DoesNotMeetMinSigs -> chooseInt (0, minSig - 1)
|
|
||||||
|
|
||||||
let builder :: BaseBuilder
|
|
||||||
builder = mconcat $ signedWith <$> take n pkhs <> othersigners
|
|
||||||
txinfo = buildTxInfoUnsafe builder
|
|
||||||
pure (ms, ScriptContext txinfo (Spending (TxOutRef "" 0)))
|
|
||||||
|
|
||||||
-- | Classify model into propositions.
|
|
||||||
classifyMultiSigProp :: MultiSigModel -> MultiSigProp
|
|
||||||
classifyMultiSigProp (MultiSig keys (fromIntegral -> minsig), ctx)
|
|
||||||
| minsig <= length signer = MeetsMinSigs
|
|
||||||
| otherwise = DoesNotMeetMinSigs
|
|
||||||
where
|
|
||||||
signer = filter (`elem` keys) $ txInfoSignatories . scriptContextTxInfo $ ctx
|
|
||||||
|
|
||||||
-- | Shrinker. Not used.
|
|
||||||
shrinkMultiSigProp :: MultiSigModel -> [MultiSigModel]
|
|
||||||
shrinkMultiSigProp = const []
|
|
||||||
|
|
||||||
-- | Expected behavior of @pvalidatedByMultisig@.
|
|
||||||
expectedHs :: MultiSigModel -> Maybe Bool
|
|
||||||
expectedHs model = case classifyMultiSigProp model of
|
|
||||||
MeetsMinSigs -> Just True
|
|
||||||
_ -> Just False
|
|
||||||
|
|
||||||
-- | Actual implementation of @pvalidatedByMultisig@.
|
|
||||||
actual :: Term s (PBuiltinPair PMultiSig PScriptContext :--> PBool)
|
|
||||||
actual = plam $ \x -> unTermCont $ do
|
|
||||||
ms <- pletC $ pfstBuiltin # x
|
|
||||||
sc <- pletC $ psndBuiltin # x
|
|
||||||
pure $ pvalidatedByMultisig # ms # (pfield @"txInfo" # sc)
|
|
||||||
|
|
||||||
-- | Proposed property.
|
|
||||||
prop :: Property
|
|
||||||
prop = classifiedPropertyNative genMultiSigProp shrinkMultiSigProp expectedHs classifyMultiSigProp actual
|
|
||||||
|
|
||||||
props :: [TestTree]
|
|
||||||
props =
|
|
||||||
[ testProperty "MultiSig property" prop
|
|
||||||
]
|
|
||||||
|
|
@ -8,7 +8,6 @@ import Test.Tasty (defaultMain, testGroup)
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import Property.Governor qualified as Governer
|
import Property.Governor qualified as Governer
|
||||||
import Property.MultiSig qualified as MultiSig
|
|
||||||
import Spec.AuthorityToken qualified as AuthorityToken
|
import Spec.AuthorityToken qualified as AuthorityToken
|
||||||
import Spec.Effect.GovernorMutation qualified as GovernorMutation
|
import Spec.Effect.GovernorMutation qualified as GovernorMutation
|
||||||
import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
|
import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
|
||||||
|
|
@ -42,7 +41,4 @@ main = do
|
||||||
, testGroup
|
, testGroup
|
||||||
"Utility tests"
|
"Utility tests"
|
||||||
Utils.tests
|
Utils.tests
|
||||||
, testGroup
|
|
||||||
"Multisig tests"
|
|
||||||
MultiSig.props
|
|
||||||
]
|
]
|
||||||
|
|
|
||||||
|
|
@ -149,7 +149,6 @@ library
|
||||||
Agora.Effect.TreasuryWithdrawal
|
Agora.Effect.TreasuryWithdrawal
|
||||||
Agora.Governor
|
Agora.Governor
|
||||||
Agora.Governor.Scripts
|
Agora.Governor.Scripts
|
||||||
Agora.MultiSig
|
|
||||||
Agora.Plutarch.Orphans
|
Agora.Plutarch.Orphans
|
||||||
Agora.Proposal
|
Agora.Proposal
|
||||||
Agora.Proposal.Scripts
|
Agora.Proposal.Scripts
|
||||||
|
|
@ -184,7 +183,6 @@ library agora-specs
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Property.Generator
|
Property.Generator
|
||||||
Property.Governor
|
Property.Governor
|
||||||
Property.MultiSig
|
|
||||||
Sample.Effect.GovernorMutation
|
Sample.Effect.GovernorMutation
|
||||||
Sample.Effect.TreasuryWithdrawal
|
Sample.Effect.TreasuryWithdrawal
|
||||||
Sample.Governor.Initialize
|
Sample.Governor.Initialize
|
||||||
|
|
|
||||||
|
|
@ -1,137 +0,0 @@
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
|
|
||||||
{- |
|
|
||||||
Module : Agora.MultiSig
|
|
||||||
Maintainer : riley_kilgore@outlook.com
|
|
||||||
Description: A basic N of M multisignature validation function.
|
|
||||||
|
|
||||||
A basic N of M multisignature validation function.
|
|
||||||
-}
|
|
||||||
module Agora.MultiSig (
|
|
||||||
validatedByMultisig,
|
|
||||||
pvalidatedByMultisig,
|
|
||||||
PMultiSig (..),
|
|
||||||
MultiSig (..),
|
|
||||||
) where
|
|
||||||
|
|
||||||
import GHC.Generics qualified as GHC
|
|
||||||
import Generics.SOP (Generic, I (I))
|
|
||||||
import Plutarch.Api.V1 (
|
|
||||||
PPubKeyHash,
|
|
||||||
PTxInfo (..),
|
|
||||||
)
|
|
||||||
import Plutarch.DataRepr (
|
|
||||||
DerivePConstantViaData (DerivePConstantViaData),
|
|
||||||
PDataFields,
|
|
||||||
PIsDataReprInstances (PIsDataReprInstances),
|
|
||||||
)
|
|
||||||
import Plutarch.Extra.TermCont (pletFieldsC)
|
|
||||||
import Plutarch.Lift (
|
|
||||||
PConstantDecl,
|
|
||||||
PLifted,
|
|
||||||
PUnsafeLiftDecl,
|
|
||||||
)
|
|
||||||
import PlutusLedgerApi.V1.Crypto (PubKeyHash)
|
|
||||||
import PlutusTx qualified
|
|
||||||
import Prelude
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
{- | A MultiSig represents a proof that a particular set of signatures
|
|
||||||
are present on a transaction.
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
data MultiSig = MultiSig
|
|
||||||
{ keys :: [PubKeyHash]
|
|
||||||
-- ^ List of PubKeyHashes that must be present in the list of signatories.
|
|
||||||
, minSigs :: Integer
|
|
||||||
}
|
|
||||||
deriving stock
|
|
||||||
( -- | @since 0.1.0
|
|
||||||
GHC.Generic
|
|
||||||
, -- | @since 0.1.0
|
|
||||||
Eq
|
|
||||||
, -- | @since 0.1.0
|
|
||||||
Show
|
|
||||||
)
|
|
||||||
deriving anyclass
|
|
||||||
( -- | @since 0.1.0
|
|
||||||
Generic
|
|
||||||
)
|
|
||||||
|
|
||||||
PlutusTx.makeLift ''MultiSig
|
|
||||||
PlutusTx.unstableMakeIsData ''MultiSig
|
|
||||||
|
|
||||||
{- | Plutarch-level MultiSig
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
newtype PMultiSig (s :: S) = PMultiSig
|
|
||||||
{ getMultiSig ::
|
|
||||||
Term
|
|
||||||
s
|
|
||||||
( PDataRecord
|
|
||||||
'[ "keys" ':= PBuiltinList (PAsData PPubKeyHash)
|
|
||||||
, "minSigs" ':= PInteger
|
|
||||||
]
|
|
||||||
)
|
|
||||||
}
|
|
||||||
deriving stock
|
|
||||||
( -- | @since 0.1.0
|
|
||||||
GHC.Generic
|
|
||||||
)
|
|
||||||
deriving anyclass
|
|
||||||
( -- | @since 0.1.0
|
|
||||||
Generic
|
|
||||||
)
|
|
||||||
deriving anyclass
|
|
||||||
( -- | @since 0.1.0
|
|
||||||
PIsDataRepr
|
|
||||||
)
|
|
||||||
deriving
|
|
||||||
( -- | @since 0.1.0
|
|
||||||
PlutusType
|
|
||||||
, -- | @since 0.1.0
|
|
||||||
PIsData
|
|
||||||
, -- | @since 0.1.0
|
|
||||||
PDataFields
|
|
||||||
)
|
|
||||||
via (PIsDataReprInstances PMultiSig)
|
|
||||||
|
|
||||||
-- | @since 0.1.0
|
|
||||||
instance PUnsafeLiftDecl PMultiSig where type PLifted PMultiSig = MultiSig
|
|
||||||
|
|
||||||
-- | @since 0.1.0
|
|
||||||
deriving via (DerivePConstantViaData MultiSig PMultiSig) instance (PConstantDecl MultiSig)
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
{- | Check if a Haskell-level MultiSig signs this transaction.
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
validatedByMultisig :: MultiSig -> Term s (PTxInfo :--> PBool)
|
|
||||||
validatedByMultisig params =
|
|
||||||
phoistAcyclic $
|
|
||||||
pvalidatedByMultisig # pconstant params
|
|
||||||
|
|
||||||
{- | Check if a Plutarch-level MultiSig signs this transaction.
|
|
||||||
|
|
||||||
@since 0.1.0
|
|
||||||
-}
|
|
||||||
pvalidatedByMultisig :: Term s (PMultiSig :--> PTxInfo :--> PBool)
|
|
||||||
pvalidatedByMultisig =
|
|
||||||
phoistAcyclic $
|
|
||||||
plam $ \multi' txInfo -> unTermCont $ do
|
|
||||||
multi <- pletFieldsC @'["keys", "minSigs"] multi'
|
|
||||||
let signatories = pfield @"signatories" # txInfo
|
|
||||||
pure $
|
|
||||||
pfromData multi.minSigs
|
|
||||||
#<= ( plength #$ pfilter
|
|
||||||
# plam
|
|
||||||
( \a ->
|
|
||||||
pelem # a # pfromData signatories
|
|
||||||
)
|
|
||||||
# multi.keys
|
|
||||||
)
|
|
||||||
2133
flake.lock
generated
2133
flake.lock
generated
File diff suppressed because it is too large
Load diff
|
|
@ -17,7 +17,7 @@
|
||||||
"plutarch/haskell-nix/nixpkgs-unstable";
|
"plutarch/haskell-nix/nixpkgs-unstable";
|
||||||
|
|
||||||
inputs.liqwid-plutarch-extra.url =
|
inputs.liqwid-plutarch-extra.url =
|
||||||
"github:Liqwid-Labs/liqwid-plutarch-extra?rev=a951b85d15e7cca1a03dd2a8e36b60fae561d74a";
|
"github:Liqwid-Labs/liqwid-plutarch-extra?ref=seungheonoh/agoraUtils";
|
||||||
inputs.plutarch-numeric.url =
|
inputs.plutarch-numeric.url =
|
||||||
"github:Liqwid-Labs/plutarch-numeric?ref=main";
|
"github:Liqwid-Labs/plutarch-numeric?ref=main";
|
||||||
inputs.plutarch-safe-money.url =
|
inputs.plutarch-safe-money.url =
|
||||||
|
|
@ -29,8 +29,10 @@
|
||||||
# Testing
|
# Testing
|
||||||
inputs.plutarch-quickcheck.url =
|
inputs.plutarch-quickcheck.url =
|
||||||
"github:liqwid-labs/plutarch-quickcheck?ref=staging";
|
"github:liqwid-labs/plutarch-quickcheck?ref=staging";
|
||||||
|
|
||||||
|
# PCB Rev is locked until Agora test have explicit Minting CS. Check PCB PR #12
|
||||||
inputs.plutarch-context-builder.url =
|
inputs.plutarch-context-builder.url =
|
||||||
"github:Liqwid-Labs/plutarch-context-builder?ref=staging";
|
"github:Liqwid-Labs/plutarch-context-builder?ref=62ab154fdcd8dd07a741e7955e078813aff4ed6a";
|
||||||
|
|
||||||
outputs = inputs@{ self, nixpkgs, nixpkgs-latest, haskell-nix, plutarch, ... }:
|
outputs = inputs@{ self, nixpkgs, nixpkgs-latest, haskell-nix, plutarch, ... }:
|
||||||
let
|
let
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue