fix a bug that makes using delegated and own stakes together unreliable

agora/Agora/Stake/Scripts.hs

@@ -226,6 +226,23 @@ stakePolicy =
 
 --------------------------------------------------------------------------------
 
+data PAuthCheckHelper (s :: S) = PAuthCheckHelper
+  { allHaveTheSameOwner :: Term s PBool
+  , allOwnByOrDelegatedToTheFirstOwner :: Term s PBool
+  , allOwnByOrDelegatedToTheFirstDelegatee :: Term s PBool
+  }
+  deriving stock
+    ( Generic
+    )
+  deriving anyclass
+    ( PlutusType
+    )
+
+instance DerivePlutusType PAuthCheckHelper where
+  type DPTStrat _ = PlutusTypeScott
+
+--------------------------------------------------------------------------------
+
 {- | Create a stake validator, given the implementation of stake redeemers.
 
      == Arguments
@@ -345,39 +362,61 @@ mkStakeValidator impl sstSymbol pstClass gtClass =
 
     authorizedBy <- pletC $ pauthorizedBy # authorizationContext txInfoF
 
-    PPair allHaveSameOwner allHaveSameOrOwnedByDelegatee <-
+    authCheckHelperF <-
       pmatchC $
         pfoldr
           # plam
-            ( \d p -> unTermCont $ do
+            ( \stake helper -> unTermCont $ do
-                dF <- pletFieldsC @'["owner", "delegatedTo"] d
+                stakeF <- pletFieldsC @'["owner", "delegatedTo"] stake
+                helperF <- pmatchC helper
 
-                pure $
+                haveTheSameOwnerAsTheFirstStake <-
-                  pmatch p $ \(PPair allHaveSameOwner allHaveSameDelegatee) ->
+                  pletC $
-                    let allHaveSameOwner' =
+                    stakeF.owner #== firstStakeInputDatumF.owner
-                          allHaveSameOwner
+
-                            #&& dF.owner
+                let ownerOfTheFirstStakeIsTheDelegatee =
-                            #== firstStakeInputDatumF.owner
+                      haveTheSameOwnerAsTheFirstStake
-                        allHaveSameOrOwnedByDelegatee' =
+                        #|| stakeF.delegatedTo
-                          let delegated =
+                        #== pdata (pdjust # firstStakeInputDatumF.owner)
-                                dF.delegatedTo #== firstStakeInputDatumF.delegatedTo
+
-                              ownedByDelegatee =
+                    delegateeOfTheFirstStakeIsTheDelegatee =
-                                pdata (pdjust # dF.owner)
+                      pdata (pdjust # stakeF.owner)
-                                  #== firstStakeInputDatumF.delegatedTo
+                        #== firstStakeInputDatumF.delegatedTo
-                           in allHaveSameDelegatee
+                        #|| stakeF.delegatedTo
-                                #&& (delegated #|| ownedByDelegatee)
+                        #== firstStakeInputDatumF.delegatedTo
-                     in pcon $ PPair allHaveSameOwner' allHaveSameOrOwnedByDelegatee'
+
+                    helper' =
+                      pcon $
+                        PAuthCheckHelper
+                          ( helperF.allHaveTheSameOwner
+                              #&& haveTheSameOwnerAsTheFirstStake
+                          )
+                          ( helperF.allOwnByOrDelegatedToTheFirstOwner
+                              #&& ownerOfTheFirstStakeIsTheDelegatee
+                          )
+                          ( helperF.allOwnByOrDelegatedToTheFirstDelegatee
+                              #&& delegateeOfTheFirstStakeIsTheDelegatee
+                          )
+
+                pure helper'
+            )
+          # pcon
+            ( PAuthCheckHelper
+                (pconstant True)
+                (pconstant True)
+                (pconstant True)
             )
-          # pcon (PPair (pconstant True) (pconstant True))
           # restOfStakeInputDatums
 
     let ownerSignsTransaction =
-          allHaveSameOwner
+          authCheckHelperF.allHaveTheSameOwner
             #&& authorizedBy
             # firstStakeInputDatumF.owner
 
         delegateSignsTransaction =
-          allHaveSameOrOwnedByDelegatee
+          ( authCheckHelperF.allOwnByOrDelegatedToTheFirstOwner
+              #|| authCheckHelperF.allOwnByOrDelegatedToTheFirstDelegatee
+          )
             #&& pmaybeData
             # pconstant False
             # plam ((authorizedBy #) . pfromData)