Added changes to address comments
This commit is contained in:
parent
de6e186ec1
commit
aa6626c913
2 changed files with 56 additions and 30 deletions
|
|
@ -16,10 +16,6 @@ import Agora.AuthorityToken (
|
||||||
AuthorityToken (AuthorityToken),
|
AuthorityToken (AuthorityToken),
|
||||||
authorityTokenPolicy,
|
authorityTokenPolicy,
|
||||||
)
|
)
|
||||||
import Agora.MultiSig (
|
|
||||||
MultiSig (..),
|
|
||||||
multiSigValidator,
|
|
||||||
)
|
|
||||||
import Agora.SafeMoney (LQ)
|
import Agora.SafeMoney (LQ)
|
||||||
import Agora.Stake (
|
import Agora.Stake (
|
||||||
Stake (Stake),
|
Stake (Stake),
|
||||||
|
|
@ -38,16 +34,9 @@ benchmarks =
|
||||||
benchGroup
|
benchGroup
|
||||||
"full_scripts"
|
"full_scripts"
|
||||||
[ bench "authorityTokenPolicy" $ authorityTokenPolicy authorityToken
|
[ bench "authorityTokenPolicy" $ authorityTokenPolicy authorityToken
|
||||||
, bench "multiSigValidator" $ multiSigValidator multiSig
|
|
||||||
, bench "stakePolicy" $ stakePolicy (Stake @LQ)
|
, bench "stakePolicy" $ stakePolicy (Stake @LQ)
|
||||||
, bench "stakeValidator" $ stakeValidator (Stake @LQ)
|
, bench "stakeValidator" $ stakeValidator (Stake @LQ)
|
||||||
]
|
]
|
||||||
|
|
||||||
authorityToken :: AuthorityToken
|
authorityToken :: AuthorityToken
|
||||||
authorityToken = AuthorityToken (Value.assetClass "" "")
|
authorityToken = AuthorityToken (Value.assetClass "" "")
|
||||||
|
|
||||||
multiSig :: MultiSig (s :: S)
|
|
||||||
multiSig = MultiSig
|
|
||||||
{ keys = PSNil
|
|
||||||
, minSigs = 0
|
|
||||||
}
|
|
||||||
|
|
@ -1,10 +1,11 @@
|
||||||
{- |
|
{- |
|
||||||
Module : Agora.MultiSig
|
Module : Agora.MultiSig
|
||||||
Maintainer : riley_kilgore@outlook.com
|
Maintainer : riley_kilgore@outlook.com
|
||||||
Description: A basic N of M multisignature validator.
|
Description: A basic N of M multisignature validation function.
|
||||||
-}
|
-}
|
||||||
module Agora.MultiSig (
|
module Agora.MultiSig (
|
||||||
multiSigValidator,
|
validatedByMultisig,
|
||||||
|
pvalidatedByMultisig,
|
||||||
MultiSig (..),
|
MultiSig (..),
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
@ -12,16 +13,18 @@ import Plutarch.Api.V1 (
|
||||||
PPubKeyHash,
|
PPubKeyHash,
|
||||||
PScriptContext (..),
|
PScriptContext (..),
|
||||||
)
|
)
|
||||||
|
import Plutarch.DataRepr (
|
||||||
|
PDataFields,
|
||||||
|
PIsDataReprInstances (PIsDataReprInstances),
|
||||||
|
)
|
||||||
import Plutarch.Monadic qualified as P
|
import Plutarch.Monadic qualified as P
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
import Plutus.V1.Ledger.Crypto (PubKeyHash)
|
||||||
|
|
||||||
import Agora.Utils (passert)
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import GHC.Generics qualified as GHC
|
import GHC.Generics qualified as GHC
|
||||||
import Generics.SOP (Generic)
|
import Generics.SOP (Generic, I (I))
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
@ -29,24 +32,58 @@ import Prelude
|
||||||
{- | A MultiSig represents a proof that a particular set of signatures
|
{- | A MultiSig represents a proof that a particular set of signatures
|
||||||
are present on a transaction.
|
are present on a transaction.
|
||||||
-}
|
-}
|
||||||
data MultiSig (s :: S) = MultiSig
|
data MultiSig = MultiSig
|
||||||
{ keys :: PList PPubKeyHash s
|
{ keys :: [PubKeyHash]
|
||||||
-- ^ List of PubKeyHashes that must be present in the list of signatories.
|
-- ^ List of PubKeyHashes that must be present in the list of signatories.
|
||||||
, minSigs :: Integer
|
, minSigs :: Integer
|
||||||
} deriving stock (GHC.Generic)
|
} deriving stock (GHC.Generic)
|
||||||
deriving anyclass (Generic)
|
deriving anyclass (Generic)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
newtype PMultiSig (s :: S) = PMultiSig
|
||||||
|
{ getMultiSig ::
|
||||||
|
Term s (PDataRecord '[ "pkeys" ':= PBuiltinList (PAsData PPubKeyHash)
|
||||||
|
, "pminSigs" ':= PInteger])
|
||||||
|
}
|
||||||
|
deriving stock (GHC.Generic)
|
||||||
|
deriving anyclass (Generic)
|
||||||
|
deriving anyclass (PIsDataRepr)
|
||||||
|
deriving
|
||||||
|
(PlutusType, PIsData, PDataFields)
|
||||||
|
via (PIsDataReprInstances PMultiSig)
|
||||||
|
|
||||||
-- | Validator given 'MultiSig' params.
|
--------------------------------------------------------------------------------
|
||||||
multiSigValidator :: MultiSig s -> Term s (PData :--> PData :--> PScriptContext :--> PUnit)
|
pubKeysToPPubKeys ::
|
||||||
multiSigValidator params =
|
forall s. [PubKeyHash] -> PBuiltinList (PAsData PPubKeyHash) s
|
||||||
plam $ \_datum _redeemer ctx' -> P.do
|
pubKeysToPPubKeys xs = case xs of
|
||||||
|
x:xs' ->
|
||||||
|
let x' :: Term s (PAsData PPubKeyHash)
|
||||||
|
x' = pconstantData x
|
||||||
|
in
|
||||||
|
PCons x' (pcon $ pubKeysToPPubKeys xs')
|
||||||
|
[] ->
|
||||||
|
PNil
|
||||||
|
|
||||||
|
multisigToPMultisig :: forall s. MultiSig -> Term s PMultiSig
|
||||||
|
multisigToPMultisig m =
|
||||||
|
pcon $ PMultiSig (pdcons @"pkeys" @(PBuiltinList (PAsData PPubKeyHash))
|
||||||
|
# (pdata $ pcon (pubKeysToPPubKeys m.keys))
|
||||||
|
#$ pdcons @"pminSigs" @PInteger # (pdata $ fromInteger m.minSigs) # pdnil)
|
||||||
|
|
||||||
|
validatedByMultisig :: MultiSig -> Term s (PScriptContext :--> PBool)
|
||||||
|
validatedByMultisig params =
|
||||||
|
plam $ \ctx' -> P.do
|
||||||
|
pvalidatedByMultisig # (multisigToPMultisig params) # ctx'
|
||||||
|
|
||||||
|
pvalidatedByMultisig :: Term s (PMultiSig :--> PScriptContext :--> PBool)
|
||||||
|
pvalidatedByMultisig =
|
||||||
|
plam $ \multi' ctx' -> P.do
|
||||||
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
ctx <- pletFields @'["txInfo", "purpose"] ctx'
|
||||||
|
multi <- pletFields @'["pkeys", "pminSigs"] multi'
|
||||||
let signatories = pfield @"signatories" # ctx.txInfo
|
let signatories = pfield @"signatories" # ctx.txInfo
|
||||||
passert "The amount of required signatures is not met."
|
pif
|
||||||
((fromInteger params.minSigs) #<= (plength #$ pfilter
|
((pfromData multi.pminSigs) #<= (plength #$ pfilter
|
||||||
# (plam $ \a ->
|
# (plam $ \a ->
|
||||||
(pelem # pdata a # pfromData signatories))
|
(pelem # a # pfromData signatories))
|
||||||
# pcon params.keys))
|
# multi.pkeys))
|
||||||
(pconstant ())
|
(pcon PTrue)
|
||||||
|
perror
|
||||||
Loading…
Add table
Add a link
Reference in a new issue