use Credential instead of PubKeyHash everywhere

agora/Agora/Credential.hs

@@ -0,0 +1,66 @@
+{- |
+Module     : Agora.Stake.Scripts
+Maintainer : emi@haskell.fyi
+Description: Functions for dealing with generalized credentials.
+
+Functions for dealing with generalized credentials.
+-}
+module Agora.Credential (PAuthorizationCredential, AuthorizationCredential, pauthorizedBy, authorizationContext) where
+
+import GHC.Records (HasField)
+import Plutarch.Api.V1 (PCredential (..), PPubKeyHash)
+import Plutarch.Api.V2 (PTxInInfo (..))
+import Plutarch.Extra.ScriptContext (ptxSignedBy)
+import Plutarch.Extra.TermCont (pmatchC)
+import PlutusLedgerApi.V2 (Credential)
+
+type AuthorizationCredential =
+  Credential
+
+type PAuthorizationCredential =
+  PCredential
+
+data PAuthorizationContext (s :: S) = PAuthorizationContext
+  { signatories :: Term s (PBuiltinList (PAsData PPubKeyHash))
+  , inputs :: Term s (PBuiltinList PTxInInfo)
+  }
+  deriving stock
+    ( -- | @since 0.2.0
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since 0.2.0
+      PlutusType
+    , -- | @since 0.2.0
+      PEq
+    )
+
+instance DerivePlutusType PAuthorizationContext where
+  type DPTStrat _ = PlutusTypeScott
+
+authorizationContext ::
+  forall {r} {s :: S}.
+  ( HasField "inputs" r (Term s (PBuiltinList PTxInInfo))
+  , HasField "signatories" r (Term s (PBuiltinList (PAsData PPubKeyHash)))
+  ) =>
+  r ->
+  Term s PAuthorizationContext
+authorizationContext f =
+  pcon (PAuthorizationContext f.signatories f.inputs)
+
+pauthorizedBy :: forall (s :: S). Term s (PAuthorizationContext :--> PAuthorizationCredential :--> PBool)
+pauthorizedBy = phoistAcyclic $
+  plam $ \ctx credential -> unTermCont $ do
+    ctxF <- pmatchC ctx
+    pure $
+      pmatch credential $ \case
+        PPubKeyCredential ((pfield @"_0" #) -> pk) ->
+          ptxSignedBy # ctxF.signatories # pk
+        PScriptCredential ((pfield @"_0" #) -> _) ->
+          pany
+            # plam
+              ( \input ->
+                  (pfield @"credential" #$ pfield @"address" #$ pfield @"resolved" # input)
+                    #== credential
+              )
+            # ctxF.inputs

agora/Agora/Proposal.hs

@@ -42,6 +42,7 @@ module Agora.Proposal (
   pisProposalThresholdsValid,
 ) where
 
+import Agora.Credential (AuthorizationCredential, PAuthorizationCredential)
 import Agora.Plutarch.Orphans ()
 import Agora.Proposal.Time (
   PProposalStartingTime,
@@ -58,7 +59,6 @@ import Plutarch.Api.V2 (
   KeyGuarantees (Unsorted),
   PDatumHash,
   PMaybeData,
-  PPubKeyHash,
   PScriptHash,
   PTuple,
  )
@@ -85,7 +85,7 @@ import Plutarch.Lift (
  )
 import Plutarch.SafeMoney (PDiscrete (..))
 import Plutarch.Show (PShow (..))
-import PlutusLedgerApi.V2 (DatumHash, PubKeyHash, ScriptHash, ValidatorHash)
+import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash)
 import PlutusTx qualified
 import PlutusTx.AssocMap qualified as AssocMap
 
@@ -299,7 +299,7 @@ data ProposalDatum = ProposalDatum
   -- ^ Effect lookup table. First by result, then by effect hash.
   , status :: ProposalStatus
   -- ^ The status the proposal is in.
-  , cosigners :: [PubKeyHash]
+  , cosigners :: [Credential]
   -- ^ Who created the proposal initially, and who cosigned it later.
   --
   -- This list should be sorted in **ascending** order.
@@ -347,7 +347,7 @@ data ProposalRedeemer
     --   provided enough GT is shared among them.
     --
     --   This list should be sorted in ascending order.
-    Cosign [PubKeyHash]
+    Cosign [AuthorizationCredential]
   | -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'.
     Unlock
   | -- | Advance the proposal, performing the required checks for whether that is legal.
@@ -617,7 +617,7 @@ newtype PProposalDatum (s :: S) = PProposalDatum
             '[ "proposalId" ':= PProposalId
              , "effects" ':= PMap 'Unsorted PResultTag PProposalEffectGroup
              , "status" ':= PProposalStatus
-             , "cosigners" ':= PBuiltinList (PAsData PPubKeyHash)
+             , "cosigners" ':= PBuiltinList (PAsData PAuthorizationCredential)
              , "thresholds" ':= PProposalThresholds
              , "votes" ':= PProposalVotes
              , "timingConfig" ':= PProposalTimingConfig
@@ -656,7 +656,7 @@ deriving via (DerivePConstantViaDataList ProposalDatum PProposalDatum) instance
 -}
 data PProposalRedeemer (s :: S)
   = PVote (Term s (PDataRecord '["resultTag" ':= PResultTag]))
-  | PCosign (Term s (PDataRecord '["newCosigners" ':= PBuiltinList (PAsData PPubKeyHash)]))
+  | PCosign (Term s (PDataRecord '["newCosigners" ':= PBuiltinList (PAsData PAuthorizationCredential)]))
   | PUnlock (Term s (PDataRecord '[]))
   | PAdvanceProposal (Term s (PDataRecord '[]))
   deriving stock

agora/Agora/Proposal/Scripts.hs

@@ -10,6 +10,7 @@ module Agora.Proposal.Scripts (
   proposalPolicy,
 ) where
 
+import Agora.Credential (PAuthorizationCredential, authorizationContext, pauthorizedBy)
 import Agora.Proposal (
   PProposalDatum (PProposalDatum),
   PProposalRedeemer (..),
@@ -45,7 +46,6 @@ import Agora.Utils (
 import Plutarch.Api.V2 (
   PDatumHash,
   PMintingPolicy,
-  PPubKeyHash,
   PScriptContext (PScriptContext),
   PScriptPurpose (PMinting, PSpending),
   PTxInfo (PTxInfo),
@@ -63,7 +63,6 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.ScriptContext (
   pfindTxInByTxOutRef,
   pisTokenSpent,
-  ptxSignedBy,
  )
 import Plutarch.Extra.TermCont (
   pguardC,
@@ -192,7 +191,7 @@ proposalValidator as maximumCosigners =
 
     let stCurrencySymbol = pconstant $ proposalSTSymbol as
 
-    signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
+    authorizedBy <- pletC $ pauthorizedBy # authorizationContext txInfoF
 
     currentTime <- pletC $ currentProposalTime # txInfoF.validRange
 
@@ -300,7 +299,7 @@ proposalValidator as maximumCosigners =
       Term
         _
         ( ( PInteger
-              :--> PBuiltinList (PAsData PPubKeyHash)
+              :--> PBuiltinList (PAsData PAuthorizationCredential)
               :--> PUnit
           )
             :--> PUnit
@@ -380,11 +379,11 @@ proposalValidator as maximumCosigners =
         pure $ validationLogic # stakeIn # stakeOut # stakeUnchanged
 
     let withMultipleStakes val =
-          withMultipleStakes' #$ plam $
-            \totalStakedAmount
-             sortedStakeOwner ->
-                unTermCont $
-                  val totalStakedAmount sortedStakeOwner
+          withMultipleStakes'
+            #$ plam
+            $ \totalStakedAmount sortedStakeOwner ->
+              unTermCont $
+                val totalStakedAmount sortedStakeOwner
 
         withSingleStake val =
           withSingleStake' #$ plam $ \stakeIn stakeOut stakeUnchange -> unTermCont $ do
@@ -402,7 +401,7 @@ proposalValidator as maximumCosigners =
             newSigs <- pletC $ pfield @"newCosigners" # r
 
             pguardC "Signed by all new cosigners" $
-              pall # signedBy # newSigs
+              pall # plam ((authorizedBy #) . pfromData) # newSigs
 
             updatedSigs <-
               pletC $

agora/Agora/Stake.hs

@@ -34,9 +34,9 @@ import Agora.Proposal (PProposalId, PResultTag, ProposalId (..), ResultTag (..))
 import Agora.SafeMoney (GTTag)
 import Data.Tagged (Tagged (..))
 import Generics.SOP qualified as SOP
+import Plutarch.Api.V1 (PCredential)
 import Plutarch.Api.V2 (
   PMaybeData,
-  PPubKeyHash,
  )
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
@@ -52,7 +52,7 @@ import Plutarch.Extra.Traversable (pfoldMap)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
 import Plutarch.SafeMoney (PDiscrete)
 import Plutarch.Show (PShow (..))
-import PlutusLedgerApi.V1 (PubKeyHash)
+import PlutusLedgerApi.V1 (Credential)
 import PlutusTx qualified
 import Prelude hiding (Num (..))
 
@@ -148,7 +148,7 @@ data StakeRedeemer
     WitnessStake
   | -- | The owner can delegate the stake to another user, allowing the
     --    delegate to vote on prooposals with the stake.
-    DelegateTo PubKeyHash
+    DelegateTo Credential
   | -- | Revoke the existing delegation.
     ClearDelegate
   deriving stock
@@ -177,12 +177,12 @@ data StakeDatum = StakeDatum
   { stakedAmount :: Tagged GTTag Integer
   -- ^ Tracks the amount of governance token staked in the datum.
   --   This also acts as the voting weight for 'Agora.Proposal.Proposal's.
-  , owner :: PubKeyHash
+  , owner :: Credential
   -- ^ The hash of the public key this stake belongs to.
   --
   -- TODO Support for MultiSig/Scripts is tracked here:
   --      https://github.com/Liqwid-Labs/agora/issues/45
-  , delegatedTo :: Maybe PubKeyHash
+  , delegatedTo :: Maybe Credential
   -- ^ To whom this stake has been delegated.
   , lockedBy :: [ProposalLock]
   -- ^ The current proposals locking this stake. This field must be empty
@@ -218,8 +218,8 @@ newtype PStakeDatum (s :: S) = PStakeDatum
         s
         ( PDataRecord
             '[ "stakedAmount" ':= PDiscrete GTTag
-             , "owner" ':= PPubKeyHash
-             , "delegatedTo" ':= PMaybeData (PAsData PPubKeyHash)
+             , "owner" ':= PCredential
+             , "delegatedTo" ':= PMaybeData (PAsData PCredential)
              , "lockedBy" ':= PBuiltinList (PAsData PProposalLock)
              ]
         )
@@ -265,7 +265,7 @@ data PStakeRedeemer (s :: S)
   | PPermitVote (Term s (PDataRecord '[]))
   | PRetractVotes (Term s (PDataRecord '[]))
   | PWitnessStake (Term s (PDataRecord '[]))
-  | PDelegateTo (Term s (PDataRecord '["pkh" ':= PPubKeyHash]))
+  | PDelegateTo (Term s (PDataRecord '["pkh" ':= PCredential]))
   | PClearDelegate (Term s (PDataRecord '[]))
   deriving stock
     ( -- | @since 0.1.0

agora/Agora/Stake/Scripts.hs

@@ -7,6 +7,7 @@ Plutus Scripts for Stakes.
 -}
 module Agora.Stake.Scripts (stakePolicy, stakeValidator) where
 
+import Agora.Credential (authorizationContext, pauthorizedBy)
 import Agora.SafeMoney (GTTag)
 import Agora.Scripts (AgoraScripts, proposalSTAssetClass, stakeSTSymbol)
 import Agora.Stake (
@@ -44,7 +45,7 @@ import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.List (pmapMaybe, pmsortBy)
 import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
-import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, ptxSignedBy, pvalueSpent)
+import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, pvalueSpent)
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
 import Plutarch.Extra.Value (
   pgeqByClass',
@@ -164,8 +165,8 @@ stakePolicy gtClassRef =
                       pvalueDiscrete' gtClassRef # outputF.value #== datumF.stakedAmount
               let ownerSignsTransaction =
                     ptraceIfFalse "Stake Owner should sign the transaction" $
-                      ptxSignedBy
-                        # txInfoF.signatories
+                      pauthorizedBy
+                        # authorizationContext txInfoF
                         # datumF.owner
 
               pure $ hasExpectedStake #&& ownerSignsTransaction
@@ -263,15 +264,16 @@ stakeValidator as gtClassRef =
     resolvedF <- pletFieldsC @'["address", "value", "datumHash"] resolved
 
     -- Whether the owner signs this transaction or not.
-    signedBy <- pletC $ ptxSignedBy # txInfoF.signatories
+    signedBy <- pletC $ pauthorizedBy # authorizationContext txInfoF
 
     ownerSignsTransaction <- pletC $ signedBy # stakeDatum.owner
 
     delegateSignsTransaction <-
       pletC $
-        pmaybeData # pconstant False
-          # signedBy
-          # stakeDatum.delegatedTo
+        pmaybeData
+          # pconstant False
+          # plam ((signedBy #) . pfromData)
+          # pfromData stakeDatum.delegatedTo
 
     stCurrencySymbol <- pletC $ pconstant $ stakeSTSymbol as
     mintedST <- pletC $ psymbolValueOf # stCurrencySymbol # txInfoF.mint