From de778c1e9a8e29db90dd453c5d49305dbdb42a58 Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Sun, 6 Feb 2022 15:37:30 +1100 Subject: [PATCH 1/7] Clean up CollectionMaker.hs --- src/CollectionMaker.hs | 30 ++++-------------------------- 1 file changed, 4 insertions(+), 26 deletions(-) diff --git a/src/CollectionMaker.hs b/src/CollectionMaker.hs index 0ec96cf..2377361 100644 --- a/src/CollectionMaker.hs +++ b/src/CollectionMaker.hs @@ -28,33 +28,11 @@ module CollectionMaker where -import Control.Monad hiding (fmap) -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Map as Map -import Data.String (IsString (..)) -import Data.Text (Text) -import Data.Void (Void) -import GHC.Generics (Generic) import Ledger hiding (singleton) -import Ledger.Ada as Ada -import Ledger.Constraints as Constraints -import qualified Ledger.Contexts as Validation -import Ledger.Index as Index import qualified Ledger.Typed.Scripts as Scripts import Ledger.Value as Value -import Playground.Contract (NonEmpty (..), ToSchema, - ensureKnownCurrencies, printJson, - printSchemas, stage) -import Playground.TH (ensureKnownCurrencies, mkKnownCurrencies, - mkSchemaDefinitions) -import Playground.Types (KnownCurrency (..)) -import Plutus.Contract as Contract import qualified PlutusTx -import PlutusTx.IsData -import PlutusTx.Maybe import PlutusTx.Prelude hiding (Semigroup (..), unless) -import Prelude (Semigroup (..), Show, String, show) -import Text.Printf (printf) {-# INLINABLE mkPolicy #-} mkPolicy :: AssetClass -> BuiltinData -> ScriptContext -> Bool @@ -64,18 +42,18 @@ mkPolicy asset _ ctx = where txInfo = scriptContextTxInfo ctx txInValues = [txOutValue $ txInInfoResolved txIn | txIn <- txInfoInputs $ scriptContextTxInfo ctx] - txOuts = txInfoOutputs txInfo nftValues = [assetClassValueOf val asset | val <- txInValues] nftSum = sum nftValues mintedAmount = case flattenValue (txInfoMint txInfo) of - [(cs, collectionTokenName, amt)] | cs == ownCurrencySymbol ctx -> amt - _ -> 0 + [(cs, _, amt)] | cs == ownCurrencySymbol ctx -> amt + _ -> 0 policy :: AssetClass -> Scripts.MintingPolicy policy asset = mkMintingPolicyScript $ $$(PlutusTx.compile [||Scripts.wrapMintingPolicy . mkPolicy||]) - `PlutusTx.applyCode` PlutusTx.liftCode asset + `PlutusTx.applyCode` + PlutusTx.liftCode asset curSymbol :: AssetClass -> CurrencySymbol curSymbol asset = scriptCurrencySymbol $ policy asset From 85d170785311508fe796f4f3f2e2b0e71800d084 Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Sun, 6 Feb 2022 15:37:46 +1100 Subject: [PATCH 2/7] Clean up Bounty.hs --- src/Bounty.hs | 77 ++++++++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 34 deletions(-) diff --git a/src/Bounty.hs b/src/Bounty.hs index 10af1a9..682dbce 100644 --- a/src/Bounty.hs +++ b/src/Bounty.hs @@ -142,20 +142,27 @@ potDatum txInfo o = do Datum d <- findDatum dh txInfo PlutusTx.fromBuiltinData d +{-# INLINEABLE getBountyDatum #-} +getBountyDatum :: TxInfo -> TxOut -> Maybe BountyDatum +getBountyDatum txInfo o = do + dh <- txOutDatum o + Datum d <- findDatum dh txInfo + PlutusTx.fromBuiltinData d + -- Asset Related Functions -{-# INLINABLE collectionMinted #-} +{-# INLINEABLE collectionMinted #-} collectionMinted :: ScriptContext -> AssetClass -> Integer collectionMinted ctx collectionAsset = let mintVal = txInfoMint $ scriptContextTxInfo ctx in assetClassValueOf mintVal collectionAsset -{-# INLINABLE assetContinues #-} +{-# INLINEABLE assetContinues #-} assetContinues :: ScriptContext -> [TxOut] -> AssetClass -> Bool assetContinues ctx continuingOutputs asset = sum [assetClassValueOf (txOutValue x) asset | x <- continuingOutputs] > 0 -- Voting Arithmetic Functions -{-# INLINABLE validateCollectionChange #-} +{-# INLINEABLE validateCollectionChange #-} validateCollectionChange :: TxInfo -> [PubKeyHash] -> BountyDatum -> Maybe BountyDatum -> Bool validateCollectionChange info voters before mafter = case mafter of Just (CollectionDatum c) -> case before of @@ -164,7 +171,7 @@ validateCollectionChange info voters before mafter = case mafter of _ -> False -- This need to reflect false when we don't have enough votes or if the votes are incorrect. -{-# INLINABLE solidCollection #-} +{-# INLINEABLE solidCollection #-} solidCollection :: Bounty -> Collection -> Bool solidCollection b c = let enoughVotes = (requiredVotes b) <= (length (votes c)) @@ -172,7 +179,7 @@ solidCollection b c = in length correctVotes == length (votes c) && enoughVotes -{-# INLINABLE correctCollection #-} +{-# INLINEABLE correctCollection #-} correctCollection :: TxOut -> Collection -> Bool correctCollection o c = case (destination c) of Person pkh -> case (addressCredential (txOutAddress o)) of @@ -183,7 +190,7 @@ correctCollection o c = case (destination c) of _ -> False -- We need to make sure that the spending path is correct for the PotDatum TxOut TODO -{-# INLINABLE validateUseOfPot #-} +{-# INLINEABLE validateUseOfPot #-} validateUseOfPot :: Bounty -> TxOut -> Maybe BountyDatum -> Maybe BountyDatum -> Bool validateUseOfPot bounty potTxOut mpot mcollection = case mpot of Just m -> case mcollection of @@ -196,7 +203,7 @@ validateUseOfPot bounty potTxOut mpot mcollection = case mpot of -- This needs to check that -- - Only valid voters are counted -- - All new voters have signed the tx. -{-# INLINABLE validateKeyChanges #-} +{-# INLINEABLE validateKeyChanges #-} validateKeyChanges :: TxInfo -> [PubKeyHash] -> [PubKeyHash] -> [PubKeyHash] -> Bool validateKeyChanges info voters before after = let newVotes = [a | a <- after, elem a voters] @@ -205,60 +212,62 @@ validateKeyChanges info voters before after = && all (txSignedBy info) newVotes -- High-Level Functions -- ehh lmao -{-# INLINABLE containsClass #-} +{-# INLINEABLE containsClass #-} containsClass :: TxOut -> AssetClass -> Bool containsClass o a = (assetClassValueOf (txOutValue o) a) > 0 -{-# INLINABLE getOutput #-} +{-# INLINEABLE getOutput #-} getOutput :: [TxOut] -> AssetClass -> TxOut -getOutput txOuts asset = - case [o | o <- txOuts, containsClass o asset] of - [x] -> x - _ -> traceError "Fail here." +getOutput txOuts asset = case [o | o <- txOuts, containsClass o asset] of + [x] -> x + _ -> traceError "Fail here." -{-# INLINABLE containsPot #-} +{-# INLINEABLE containsPot #-} containsPot :: TxInfo -> TxOut -> Bool containsPot info o = - let d = potDatum info o + let d = getBountyDatum info o in case d of Just PotDatum -> True _ -> False -{-# INLINABLE getOutputPDatum #-} +{-# INLINEABLE getOutputPDatum #-} getOutputPDatum :: TxInfo -> [TxOut] -> TxOut getOutputPDatum info txOuts = case [o | o <- txOuts, containsPot info o] of [x] -> x _ -> traceError "Fail here." -{-# INLINABLE startCollectionDatum #-} +{-# INLINEABLE startCollectionDatum #-} startCollectionDatum :: Maybe BountyDatum -> Bool startCollectionDatum md = case md of - Just (CollectionDatum c) -> length (votes c) == 0 - _ -> False + Just (CollectionDatum c) -> + length (votes c) == 0 + _ -> False -{-# INLINABLE validMakerDatum #-} +{-# INLINEABLE validMakerDatum #-} validMakerDatum :: Maybe BountyDatum -> Bool validMakerDatum md = case md of - Just CollectionMaker -> True - _ -> False + Just CollectionMaker -> + True + _ -> False -{-# INLINABLE validPotDatum #-} +{-# INLINEABLE validPotDatum #-} validPotDatum :: Maybe BountyDatum -> Bool validPotDatum md = case md of - Just PotDatum -> True - _ -> False + Just PotDatum -> + True + _ -> False -- - Collection maker class come and go -- - CollectionDatum value starts with an empty voter list. -- - -{-# INLINABLE checkCreateCollection #-} +{-# INLINEABLE checkCreateCollection #-} checkCreateCollection :: ScriptContext -> BountyDatum -> AssetClass -> AssetClass -> Bool checkCreateCollection ctx collection makerAsset collectionAsset = let txInfo = scriptContextTxInfo ctx outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumMaker = collectionMaker txInfo (getOutput outputs makerAsset) - datumBox = collectionDatum txInfo (getOutput outputs collectionAsset) + datumMaker = getBountyDatum txInfo (getOutput outputs makerAsset) + datumBox = getBountyDatum txInfo (getOutput outputs collectionAsset) in assetContinues ctx continuingOutputs makerAsset && assetContinues ctx continuingOutputs collectionAsset && (collectionMinted ctx collectionAsset) == 1 @@ -267,36 +276,36 @@ checkCreateCollection ctx collection makerAsset collectionAsset = -- - For each pubkeyhash being added to the application must have signed. -- - None of the pubkeyhashes added can be the same as eachother or the values in the list. -{-# INLINABLE checkVoteApplication #-} +{-# INLINEABLE checkVoteApplication #-} checkVoteApplication :: ScriptContext -> AssetClass -> BountyDatum -> [PubKeyHash] -> Bool checkVoteApplication ctx collectionAsset datum voters = let txInfo = scriptContextTxInfo ctx outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = collectionDatum txInfo (getOutput outputs collectionAsset) + datumBox = getBountyDatum txInfo (getOutput outputs collectionAsset) in assetContinues ctx continuingOutputs collectionAsset && validateCollectionChange txInfo voters datum datumBox -- - Are there enough voters in the list -- - There's only one collectionAsset present as input and it is attached to a valid datum value for usage. -- - The value attached to the PotDatum is sent to the -{-# INLINABLE checkSpending #-} +{-# INLINEABLE checkSpending #-} checkSpending :: ScriptContext -> Bounty -> Bool checkSpending ctx bounty = let txInfo = scriptContextTxInfo ctx txIns = txInfoInputs txInfo outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = collectionDatum txInfo (getOutput outputs (collectionToken bounty)) + datumBox = getBountyDatum txInfo (getOutput outputs (collectionToken bounty)) potTxOut = getOutputPDatum txInfo outputs - potBox = potDatum txInfo potTxOut + potBox = getBountyDatum txInfo potTxOut txInValues = [txOutValue $ txInInfoResolved txIn | txIn <- txIns] in validateUseOfPot bounty potTxOut potBox datumBox -- We only can have one CollectionDatum/Token - We need to implement these - definitely. -- We only can have one -{-# INLINABLE bountyScript #-} +{-# INLINEABLE bountyScript #-} bountyScript :: Bounty -> BountyDatum -> BountyAction -> ScriptContext -> Bool bountyScript bounty datum action ctx = case datum of CollectionMaker -> case action of From 8c895e5e72e9a0f7554842681ba4000abbddf52f Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Thu, 17 Feb 2022 18:10:25 +1100 Subject: [PATCH 3/7] Fix onchain logic so that it always evaluates --- src/Bounty.hs | 124 +++++++++++++++++++------------------------------- 1 file changed, 46 insertions(+), 78 deletions(-) diff --git a/src/Bounty.hs b/src/Bounty.hs index 682dbce..4c86e3a 100644 --- a/src/Bounty.hs +++ b/src/Bounty.hs @@ -121,48 +121,27 @@ instance Scripts.ValidatorTypes Bountying where -- Datum Related Functions: -{-# INLINABLE collectionDatum #-} -collectionDatum :: TxInfo -> TxOut -> Maybe BountyDatum -collectionDatum txInfo o = do - dh <- txOutDatum o - Datum d <- findDatum dh txInfo - PlutusTx.fromBuiltinData d - -{-# INLINABLE collectionMaker #-} -collectionMaker :: TxInfo -> TxOut -> Maybe BountyDatum -collectionMaker txInfo o = do - dh <- txOutDatum o - Datum d <- findDatum dh txInfo - PlutusTx.fromBuiltinData d - -{-# INLINABLE potDatum #-} -potDatum :: TxInfo -> TxOut -> Maybe BountyDatum -potDatum txInfo o = do - dh <- txOutDatum o - Datum d <- findDatum dh txInfo - PlutusTx.fromBuiltinData d - -{-# INLINEABLE getBountyDatum #-} +{-# INLINABLE getBountyDatum #-} getBountyDatum :: TxInfo -> TxOut -> Maybe BountyDatum getBountyDatum txInfo o = do - dh <- txOutDatum o - Datum d <- findDatum dh txInfo + datumHash <- txOutDatum o + Datum d <- findDatum datumHash txInfo PlutusTx.fromBuiltinData d -- Asset Related Functions -{-# INLINEABLE collectionMinted #-} +{-# INLINABLE collectionMinted #-} collectionMinted :: ScriptContext -> AssetClass -> Integer collectionMinted ctx collectionAsset = let mintVal = txInfoMint $ scriptContextTxInfo ctx in assetClassValueOf mintVal collectionAsset -{-# INLINEABLE assetContinues #-} +{-# INLINABLE assetContinues #-} assetContinues :: ScriptContext -> [TxOut] -> AssetClass -> Bool assetContinues ctx continuingOutputs asset = sum [assetClassValueOf (txOutValue x) asset | x <- continuingOutputs] > 0 -- Voting Arithmetic Functions -{-# INLINEABLE validateCollectionChange #-} +{-# INLINABLE validateCollectionChange #-} validateCollectionChange :: TxInfo -> [PubKeyHash] -> BountyDatum -> Maybe BountyDatum -> Bool validateCollectionChange info voters before mafter = case mafter of Just (CollectionDatum c) -> case before of @@ -171,7 +150,7 @@ validateCollectionChange info voters before mafter = case mafter of _ -> False -- This need to reflect false when we don't have enough votes or if the votes are incorrect. -{-# INLINEABLE solidCollection #-} +{-# INLINABLE solidCollection #-} solidCollection :: Bounty -> Collection -> Bool solidCollection b c = let enoughVotes = (requiredVotes b) <= (length (votes c)) @@ -179,7 +158,7 @@ solidCollection b c = in length correctVotes == length (votes c) && enoughVotes -{-# INLINEABLE correctCollection #-} +{-# INLINABLE correctCollection #-} correctCollection :: TxOut -> Collection -> Bool correctCollection o c = case (destination c) of Person pkh -> case (addressCredential (txOutAddress o)) of @@ -190,20 +169,17 @@ correctCollection o c = case (destination c) of _ -> False -- We need to make sure that the spending path is correct for the PotDatum TxOut TODO -{-# INLINEABLE validateUseOfPot #-} -validateUseOfPot :: Bounty -> TxOut -> Maybe BountyDatum -> Maybe BountyDatum -> Bool -validateUseOfPot bounty potTxOut mpot mcollection = case mpot of - Just m -> case mcollection of - Just (CollectionDatum c) -> - solidCollection bounty c - && correctCollection potTxOut c - _ -> False - _ -> False +{-# INLINABLE validateUseOfPot #-} +validateUseOfPot :: Bounty -> Maybe TxOut -> Maybe BountyDatum -> Maybe BountyDatum -> Bool +-- validateUseOfPot bounty mPotTxOut mpot mcollection = case mpot of +validateUseOfPot bounty (Just potTxOut) (Just _) (Just (CollectionDatum c)) = + solidCollection bounty c && correctCollection potTxOut c +validateUseOfPot _ _ _ _ = False -- This needs to check that -- - Only valid voters are counted -- - All new voters have signed the tx. -{-# INLINEABLE validateKeyChanges #-} +{-# INLINABLE validateKeyChanges #-} validateKeyChanges :: TxInfo -> [PubKeyHash] -> [PubKeyHash] -> [PubKeyHash] -> Bool validateKeyChanges info voters before after = let newVotes = [a | a <- after, elem a voters] @@ -212,62 +188,54 @@ validateKeyChanges info voters before after = && all (txSignedBy info) newVotes -- High-Level Functions -- ehh lmao -{-# INLINEABLE containsClass #-} +{-# INLINABLE containsClass #-} containsClass :: TxOut -> AssetClass -> Bool containsClass o a = (assetClassValueOf (txOutValue o) a) > 0 -{-# INLINEABLE getOutput #-} -getOutput :: [TxOut] -> AssetClass -> TxOut -getOutput txOuts asset = case [o | o <- txOuts, containsClass o asset] of - [x] -> x - _ -> traceError "Fail here." +{-# INLINABLE findOutputForClass #-} +findOutputForClass :: AssetClass -> [TxOut] -> Maybe TxOut +findOutputForClass asset = find $ \o -> containsClass o asset -{-# INLINEABLE containsPot #-} +{-# INLINABLE containsPot #-} containsPot :: TxInfo -> TxOut -> Bool containsPot info o = - let d = getBountyDatum info o - in case d of - Just PotDatum -> True - _ -> False - -{-# INLINEABLE getOutputPDatum #-} -getOutputPDatum :: TxInfo -> [TxOut] -> TxOut -getOutputPDatum info txOuts = case [o | o <- txOuts, containsPot info o] of - [x] -> x - _ -> traceError "Fail here." - -{-# INLINEABLE startCollectionDatum #-} + case getBountyDatum info o of + Just PotDatum -> True + _ -> False + +{-# INLINABLE getOutputPDatum #-} +getOutputPDatum :: TxInfo -> [TxOut] -> Maybe TxOut +getOutputPDatum info txOuts = find (containsPot info) txOuts + +{-# INLINABLE startCollectionDatum #-} startCollectionDatum :: Maybe BountyDatum -> Bool startCollectionDatum md = case md of - Just (CollectionDatum c) -> - length (votes c) == 0 - _ -> False + Just (CollectionDatum c) -> length (votes c) == 0 + _ -> False -{-# INLINEABLE validMakerDatum #-} +{-# INLINABLE validMakerDatum #-} validMakerDatum :: Maybe BountyDatum -> Bool validMakerDatum md = case md of - Just CollectionMaker -> - True - _ -> False + Just CollectionMaker -> True + _ -> False -{-# INLINEABLE validPotDatum #-} +{-# INLINABLE validPotDatum #-} validPotDatum :: Maybe BountyDatum -> Bool validPotDatum md = case md of - Just PotDatum -> - True - _ -> False + Just PotDatum -> True + _ -> False -- - Collection maker class come and go -- - CollectionDatum value starts with an empty voter list. -- - -{-# INLINEABLE checkCreateCollection #-} +{-# INLINABLE checkCreateCollection #-} checkCreateCollection :: ScriptContext -> BountyDatum -> AssetClass -> AssetClass -> Bool checkCreateCollection ctx collection makerAsset collectionAsset = let txInfo = scriptContextTxInfo ctx outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumMaker = getBountyDatum txInfo (getOutput outputs makerAsset) - datumBox = getBountyDatum txInfo (getOutput outputs collectionAsset) + datumMaker = findOutputForClass makerAsset outputs >>= getBountyDatum txInfo + datumBox = findOutputForClass collectionAsset outputs >>= getBountyDatum txInfo in assetContinues ctx continuingOutputs makerAsset && assetContinues ctx continuingOutputs collectionAsset && (collectionMinted ctx collectionAsset) == 1 @@ -276,36 +244,36 @@ checkCreateCollection ctx collection makerAsset collectionAsset = -- - For each pubkeyhash being added to the application must have signed. -- - None of the pubkeyhashes added can be the same as eachother or the values in the list. -{-# INLINEABLE checkVoteApplication #-} +{-# INLINABLE checkVoteApplication #-} checkVoteApplication :: ScriptContext -> AssetClass -> BountyDatum -> [PubKeyHash] -> Bool checkVoteApplication ctx collectionAsset datum voters = let txInfo = scriptContextTxInfo ctx outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = getBountyDatum txInfo (getOutput outputs collectionAsset) + datumBox = findOutputForClass collectionAsset outputs >>= getBountyDatum txInfo in assetContinues ctx continuingOutputs collectionAsset && validateCollectionChange txInfo voters datum datumBox -- - Are there enough voters in the list -- - There's only one collectionAsset present as input and it is attached to a valid datum value for usage. -- - The value attached to the PotDatum is sent to the -{-# INLINEABLE checkSpending #-} +{-# INLINABLE checkSpending #-} checkSpending :: ScriptContext -> Bounty -> Bool checkSpending ctx bounty = let txInfo = scriptContextTxInfo ctx txIns = txInfoInputs txInfo outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = getBountyDatum txInfo (getOutput outputs (collectionToken bounty)) + datumBox = findOutputForClass (collectionToken bounty) outputs >>= getBountyDatum txInfo potTxOut = getOutputPDatum txInfo outputs - potBox = getBountyDatum txInfo potTxOut + potBox = potTxOut >>= getBountyDatum txInfo txInValues = [txOutValue $ txInInfoResolved txIn | txIn <- txIns] in validateUseOfPot bounty potTxOut potBox datumBox -- We only can have one CollectionDatum/Token - We need to implement these - definitely. -- We only can have one -{-# INLINEABLE bountyScript #-} +{-# INLINABLE bountyScript #-} bountyScript :: Bounty -> BountyDatum -> BountyAction -> ScriptContext -> Bool bountyScript bounty datum action ctx = case datum of CollectionMaker -> case action of From ffe62913ea4a685fbce8e732f0be06d4159385ed Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Thu, 17 Feb 2022 19:55:26 +1100 Subject: [PATCH 4/7] Rename getBountyDatum to findBountyDatum --- src/Bounty.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Bounty.hs b/src/Bounty.hs index 4c86e3a..48003a0 100644 --- a/src/Bounty.hs +++ b/src/Bounty.hs @@ -121,9 +121,9 @@ instance Scripts.ValidatorTypes Bountying where -- Datum Related Functions: -{-# INLINABLE getBountyDatum #-} -getBountyDatum :: TxInfo -> TxOut -> Maybe BountyDatum -getBountyDatum txInfo o = do +{-# INLINABLE findBountyDatum #-} +findBountyDatum :: TxInfo -> TxOut -> Maybe BountyDatum +findBountyDatum txInfo o = do datumHash <- txOutDatum o Datum d <- findDatum datumHash txInfo PlutusTx.fromBuiltinData d @@ -199,7 +199,7 @@ findOutputForClass asset = find $ \o -> containsClass o asset {-# INLINABLE containsPot #-} containsPot :: TxInfo -> TxOut -> Bool containsPot info o = - case getBountyDatum info o of + case findBountyDatum info o of Just PotDatum -> True _ -> False @@ -234,8 +234,8 @@ checkCreateCollection ctx collection makerAsset collectionAsset = let txInfo = scriptContextTxInfo ctx outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumMaker = findOutputForClass makerAsset outputs >>= getBountyDatum txInfo - datumBox = findOutputForClass collectionAsset outputs >>= getBountyDatum txInfo + datumMaker = findOutputForClass makerAsset outputs >>= findBountyDatum txInfo + datumBox = findOutputForClass collectionAsset outputs >>= findBountyDatum txInfo in assetContinues ctx continuingOutputs makerAsset && assetContinues ctx continuingOutputs collectionAsset && (collectionMinted ctx collectionAsset) == 1 @@ -250,7 +250,7 @@ checkVoteApplication ctx collectionAsset datum voters = let txInfo = scriptContextTxInfo ctx outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = findOutputForClass collectionAsset outputs >>= getBountyDatum txInfo + datumBox = findOutputForClass collectionAsset outputs >>= findBountyDatum txInfo in assetContinues ctx continuingOutputs collectionAsset && validateCollectionChange txInfo voters datum datumBox @@ -264,9 +264,9 @@ checkSpending ctx bounty = txIns = txInfoInputs txInfo outputs = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = findOutputForClass (collectionToken bounty) outputs >>= getBountyDatum txInfo + datumBox = findOutputForClass (collectionToken bounty) outputs >>= findBountyDatum txInfo potTxOut = getOutputPDatum txInfo outputs - potBox = potTxOut >>= getBountyDatum txInfo + potBox = potTxOut >>= findBountyDatum txInfo txInValues = [txOutValue $ txInInfoResolved txIn | txIn <- txIns] in validateUseOfPot bounty potTxOut potBox datumBox From 196376b518cf0a648c1e227ca1462fdce95155a9 Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Thu, 17 Feb 2022 19:59:47 +1100 Subject: [PATCH 5/7] Remove unused imports --- src/Bounty.hs | 20 +------------------- 1 file changed, 1 insertion(+), 19 deletions(-) diff --git a/src/Bounty.hs b/src/Bounty.hs index 48003a0..1455d36 100644 --- a/src/Bounty.hs +++ b/src/Bounty.hs @@ -31,33 +31,15 @@ module Bounty where import Control.Monad hiding (fmap) import Data.Aeson (FromJSON, ToJSON) -import Data.List (intersect, union) -import qualified Data.Map as Map -import Data.String (IsString (..)) -import Data.Text (Text) -import Data.Void (Void) import GHC.Generics (Generic) import Ledger hiding (singleton) -import Ledger.Ada as Ada -import Ledger.Constraints as Constraints -import qualified Ledger.Contexts as Validation import Ledger.Credential -import Ledger.Index as Index import qualified Ledger.Typed.Scripts as Scripts import Ledger.Value as Value -import Playground.Contract (NonEmpty (..), ToSchema, - ensureKnownCurrencies, printJson, - printSchemas, stage) -import Playground.TH (ensureKnownCurrencies, mkKnownCurrencies, - mkSchemaDefinitions) -import Playground.Types (KnownCurrency (..)) -import Plutus.Contract as Contract import qualified PlutusTx -import PlutusTx.IsData import PlutusTx.Maybe import PlutusTx.Prelude hiding (Semigroup (..), unless) -import Prelude (Semigroup (..), Show, String, show) -import Text.Printf (printf) +import Prelude (Show) data Bounty = Bounty { expiration :: !POSIXTime, From f76f84d9ef28a6c925c0e88a903c18ef01a47d00 Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Thu, 17 Feb 2022 20:15:52 +1100 Subject: [PATCH 6/7] Remove unused variables and fix shadowed variables --- src/Bounty.hs | 81 +++++++++++++++++++++++++-------------------------- 1 file changed, 39 insertions(+), 42 deletions(-) diff --git a/src/Bounty.hs b/src/Bounty.hs index 1455d36..3d5b1fc 100644 --- a/src/Bounty.hs +++ b/src/Bounty.hs @@ -42,11 +42,11 @@ import PlutusTx.Prelude hiding (Semigroup (..), unless) import Prelude (Show) data Bounty = Bounty - { expiration :: !POSIXTime, - voters :: ![PubKeyHash], - requiredVotes :: !Integer, - collectionMakerClass :: !AssetClass, - collectionToken :: !AssetClass + { bExpiration :: !POSIXTime, + bVoters :: ![PubKeyHash], + bRequiredVotes :: !Integer, + bCollectionMakerClass :: !AssetClass, + bCollectionToken :: !AssetClass } deriving (Show, Generic, FromJSON, ToJSON) @@ -64,8 +64,8 @@ PlutusTx.makeIsDataIndexed PlutusTx.makeLift ''Destination data Collection = Collection - { votes :: ![PubKeyHash], - destination :: !Destination + { cVotes :: ![PubKeyHash], + cDestination :: !Destination } deriving (Show, Generic, FromJSON, ToJSON) @@ -106,8 +106,8 @@ instance Scripts.ValidatorTypes Bountying where {-# INLINABLE findBountyDatum #-} findBountyDatum :: TxInfo -> TxOut -> Maybe BountyDatum findBountyDatum txInfo o = do - datumHash <- txOutDatum o - Datum d <- findDatum datumHash txInfo + dh <- txOutDatum o + Datum d <- findDatum dh txInfo PlutusTx.fromBuiltinData d -- Asset Related Functions @@ -118,16 +118,16 @@ collectionMinted ctx collectionAsset = in assetClassValueOf mintVal collectionAsset {-# INLINABLE assetContinues #-} -assetContinues :: ScriptContext -> [TxOut] -> AssetClass -> Bool -assetContinues ctx continuingOutputs asset = +assetContinues :: [TxOut] -> AssetClass -> Bool +assetContinues continuingOutputs asset = sum [assetClassValueOf (txOutValue x) asset | x <- continuingOutputs] > 0 -- Voting Arithmetic Functions {-# INLINABLE validateCollectionChange #-} validateCollectionChange :: TxInfo -> [PubKeyHash] -> BountyDatum -> Maybe BountyDatum -> Bool -validateCollectionChange info voters before mafter = case mafter of - Just (CollectionDatum c) -> case before of - CollectionDatum k -> validateKeyChanges info voters (votes k) (votes c) +validateCollectionChange info voters votesBefore maybeDatumAfter = case maybeDatumAfter of + Just (CollectionDatum c) -> case votesBefore of + CollectionDatum k -> validateKeyChanges info voters (cVotes k) (cVotes c) _ -> False _ -> False @@ -135,14 +135,14 @@ validateCollectionChange info voters before mafter = case mafter of {-# INLINABLE solidCollection #-} solidCollection :: Bounty -> Collection -> Bool solidCollection b c = - let enoughVotes = (requiredVotes b) <= (length (votes c)) - correctVotes = [a | a <- (votes c), elem a (voters b)] -- filterVotes (voters b) (votes c) - in length correctVotes == length (votes c) + let enoughVotes = (bRequiredVotes b) <= (length (cVotes c)) + correctVotes = [a | a <- (cVotes c), elem a (bVoters b)] -- filterVotes (voters b) (votes c) + in length correctVotes == length (cVotes c) && enoughVotes {-# INLINABLE correctCollection #-} correctCollection :: TxOut -> Collection -> Bool -correctCollection o c = case (destination c) of +correctCollection o c = case (cDestination c) of Person pkh -> case (addressCredential (txOutAddress o)) of PubKeyCredential opkh -> pkh == opkh _ -> False @@ -163,10 +163,10 @@ validateUseOfPot _ _ _ _ = False -- - All new voters have signed the tx. {-# INLINABLE validateKeyChanges #-} validateKeyChanges :: TxInfo -> [PubKeyHash] -> [PubKeyHash] -> [PubKeyHash] -> Bool -validateKeyChanges info voters before after = - let newVotes = [a | a <- after, elem a voters] - compVal = [a | a <- after, elem a before] - in compVal == before +validateKeyChanges info voters votesBefore votesAfter = + let newVotes = [a | a <- votesAfter, elem a voters] + compVal = [a | a <- votesAfter, elem a votesBefore] + in compVal == votesBefore && all (txSignedBy info) newVotes -- High-Level Functions -- ehh lmao @@ -192,7 +192,7 @@ getOutputPDatum info txOuts = find (containsPot info) txOuts {-# INLINABLE startCollectionDatum #-} startCollectionDatum :: Maybe BountyDatum -> Bool startCollectionDatum md = case md of - Just (CollectionDatum c) -> length (votes c) == 0 + Just (CollectionDatum c) -> length (cVotes c) == 0 _ -> False {-# INLINABLE validMakerDatum #-} @@ -211,15 +211,15 @@ validPotDatum md = case md of -- - CollectionDatum value starts with an empty voter list. -- - {-# INLINABLE checkCreateCollection #-} -checkCreateCollection :: ScriptContext -> BountyDatum -> AssetClass -> AssetClass -> Bool -checkCreateCollection ctx collection makerAsset collectionAsset = +checkCreateCollection :: ScriptContext -> AssetClass -> AssetClass -> Bool +checkCreateCollection ctx makerAsset collectionAsset = let txInfo = scriptContextTxInfo ctx - outputs = txInfoOutputs txInfo + txOuts = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumMaker = findOutputForClass makerAsset outputs >>= findBountyDatum txInfo - datumBox = findOutputForClass collectionAsset outputs >>= findBountyDatum txInfo - in assetContinues ctx continuingOutputs makerAsset - && assetContinues ctx continuingOutputs collectionAsset + datumMaker = findOutputForClass makerAsset txOuts >>= findBountyDatum txInfo + datumBox = findOutputForClass collectionAsset txOuts >>= findBountyDatum txInfo + in assetContinues continuingOutputs makerAsset + && assetContinues continuingOutputs collectionAsset && (collectionMinted ctx collectionAsset) == 1 && startCollectionDatum datumBox && validMakerDatum datumMaker @@ -230,10 +230,10 @@ checkCreateCollection ctx collection makerAsset collectionAsset = checkVoteApplication :: ScriptContext -> AssetClass -> BountyDatum -> [PubKeyHash] -> Bool checkVoteApplication ctx collectionAsset datum voters = let txInfo = scriptContextTxInfo ctx - outputs = txInfoOutputs txInfo + txOuts = txInfoOutputs txInfo continuingOutputs = getContinuingOutputs ctx - datumBox = findOutputForClass collectionAsset outputs >>= findBountyDatum txInfo - in assetContinues ctx continuingOutputs collectionAsset + datumBox = findOutputForClass collectionAsset txOuts >>= findBountyDatum txInfo + in assetContinues continuingOutputs collectionAsset && validateCollectionChange txInfo voters datum datumBox -- - Are there enough voters in the list @@ -243,13 +243,10 @@ checkVoteApplication ctx collectionAsset datum voters = checkSpending :: ScriptContext -> Bounty -> Bool checkSpending ctx bounty = let txInfo = scriptContextTxInfo ctx - txIns = txInfoInputs txInfo - outputs = txInfoOutputs txInfo - continuingOutputs = getContinuingOutputs ctx - datumBox = findOutputForClass (collectionToken bounty) outputs >>= findBountyDatum txInfo - potTxOut = getOutputPDatum txInfo outputs + txOuts = txInfoOutputs txInfo + datumBox = findOutputForClass (bCollectionToken bounty) txOuts >>= findBountyDatum txInfo + potTxOut = getOutputPDatum txInfo txOuts potBox = potTxOut >>= findBountyDatum txInfo - txInValues = [txOutValue $ txInInfoResolved txIn | txIn <- txIns] in validateUseOfPot bounty potTxOut potBox datumBox -- We only can have one CollectionDatum/Token - We need to implement these - definitely. @@ -259,10 +256,10 @@ checkSpending ctx bounty = bountyScript :: Bounty -> BountyDatum -> BountyAction -> ScriptContext -> Bool bountyScript bounty datum action ctx = case datum of CollectionMaker -> case action of - CreateCollection c -> checkCreateCollection ctx datum (collectionMakerClass bounty) (collectionToken bounty) + CreateCollection _ -> checkCreateCollection ctx (bCollectionMakerClass bounty) (bCollectionToken bounty) _ -> False - CollectionDatum c -> case action of - ApplyVote -> checkVoteApplication ctx (collectionMakerClass bounty) datum (voters bounty) + CollectionDatum _ -> case action of + ApplyVote -> checkVoteApplication ctx (bCollectionMakerClass bounty) datum (bVoters bounty) SpendAction -> checkSpending ctx bounty _ -> False PotDatum -> case action of From 0118726c3badeefa5a3817ce149e7bedc8f06192 Mon Sep 17 00:00:00 2001 From: Brian Jing Date: Sat, 19 Feb 2022 14:17:21 +1100 Subject: [PATCH 7/7] Make function names consistent --- src/Bounty.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Bounty.hs b/src/Bounty.hs index 3d5b1fc..61aecf5 100644 --- a/src/Bounty.hs +++ b/src/Bounty.hs @@ -185,9 +185,9 @@ containsPot info o = Just PotDatum -> True _ -> False -{-# INLINABLE getOutputPDatum #-} -getOutputPDatum :: TxInfo -> [TxOut] -> Maybe TxOut -getOutputPDatum info txOuts = find (containsPot info) txOuts +{-# INLINABLE findOutputPDatum #-} +findOutputPDatum :: TxInfo -> [TxOut] -> Maybe TxOut +findOutputPDatum info = find (containsPot info) {-# INLINABLE startCollectionDatum #-} startCollectionDatum :: Maybe BountyDatum -> Bool @@ -245,7 +245,7 @@ checkSpending ctx bounty = let txInfo = scriptContextTxInfo ctx txOuts = txInfoOutputs txInfo datumBox = findOutputForClass (bCollectionToken bounty) txOuts >>= findBountyDatum txInfo - potTxOut = getOutputPDatum txInfo txOuts + potTxOut = findOutputPDatum txInfo txOuts potBox = potTxOut >>= findBountyDatum txInfo in validateUseOfPot bounty potTxOut potBox datumBox