From 530da1c082a55306e9728d050a60062145aba220 Mon Sep 17 00:00:00 2001 From: Jann Mueller Date: Thu, 11 Oct 2018 15:06:33 +0200 Subject: [PATCH] use-cases: Fewer magic numbers --- .../Plutus/Coordination/Contracts/Vesting.hs | 3 +- plutus-use-cases/test/Spec/Crowdfunding.hs | 18 ++++++---- plutus-use-cases/test/Spec/TH.hs | 5 +-- plutus-use-cases/test/Spec/Vesting.hs | 35 ++++++++++++------- wallet-api/src/Wallet/UTXO.hs | 1 - 5 files changed, 39 insertions(+), 23 deletions(-) diff --git a/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Vesting.hs b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Vesting.hs index 5b11954403c..1e9217ffba2 100644 --- a/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Vesting.hs +++ b/plutus-use-cases/src/Language/Plutus/Coordination/Contracts/Vesting.hs @@ -11,7 +11,8 @@ module Language.Plutus.Coordination.Contracts.Vesting ( VestingData(..), vestFunds, retrieveFunds, - validatorScript + validatorScript, + totalAmount ) where import Control.Monad.Error.Class (MonadError (..)) diff --git a/plutus-use-cases/test/Spec/Crowdfunding.hs b/plutus-use-cases/test/Spec/Crowdfunding.hs index 6b1a8e8da06..17a73407f12 100644 --- a/plutus-use-cases/test/Spec/Crowdfunding.hs +++ b/plutus-use-cases/test/Spec/Crowdfunding.hs @@ -59,7 +59,7 @@ makeContribution :: Property makeContribution = checkCFTrace scenario1 $ do let w = Wallet 2 contribution = 600 - rest = fromIntegral $ 1000 - contribution + rest = startingBalance - fromIntegral contribution blockchainActions >>= walletNotifyBlock w contrib w (cfCampaign scenario1) contribution blockchainActions >>= walletNotifyBlock w @@ -78,7 +78,7 @@ successfulCampaign = checkCFTrace scenario1 $ do setValidationData $ ValidationData $(plutus [| $(pendingTxCrowdfunding) 11 600 (Just 800) |]) collect w1 c [(con2, w2, 600), (con3, w3, 800)] updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w3, 200), (w1, 1400)] + mapM_ (uncurry assertOwnFundsEq) [(w2, startingBalance - 600), (w3, startingBalance - 800), (w1, 600 + 800)] -- | Check that the campaign owner cannot collect the monies before the campaign deadline cantCollectEarly :: Property @@ -92,7 +92,7 @@ cantCollectEarly = checkCFTrace scenario1 $ do setValidationData $ ValidationData $(plutus [| $(pendingTxCrowdfunding) 8 600 (Just 800) |]) collect w1 c [(con2, w2, 600), (con3, w3, 800)] updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w3, 200), (w1, 0)] + mapM_ (uncurry assertOwnFundsEq) [(w2, startingBalance - 600), (w3, startingBalance - 800), (w1, 0)] -- | Check that the campaign owner cannot collect the monies after the @@ -108,7 +108,7 @@ cantCollectLate = checkCFTrace scenario1 $ do setValidationData $ ValidationData $(plutus [| $(pendingTxCrowdfunding) 17 600 (Just 800) |]) collect w1 c [(con2, w2, 600), (con3, w3, 800)] updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w3, 200), (w1, 0)] + mapM_ (uncurry assertOwnFundsEq) [(w2, startingBalance - 600), (w3, startingBalance - 800), (w1, 0)] -- | Run a successful campaign that ends with a refund @@ -124,7 +124,7 @@ canRefund = checkCFTrace scenario1 $ do walletAction w2 (refund c con2 600) walletAction w3 (refund c con3 800) updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 1000), (w3, 1000), (w1, 0)] + mapM_ (uncurry assertOwnFundsEq) [(w2, startingBalance), (w3, startingBalance), (w1, 0)] -- | Crowdfunding scenario with test parameters data CFScenario = CFScenario { @@ -144,8 +144,12 @@ scenario1 = CFScenario{..} where cfWallets = Wallet <$> [1..3] cfInitialBalances = Map.fromList [ (PubKey 1, 0), - (PubKey 2, 1000), - (PubKey 3, 1000)] + (PubKey 2, startingBalance), + (PubKey 3, startingBalance)] + +-- | Funds available to wallets `Wallet 2` and `Wallet 3` +startingBalance :: UTXO.Value +startingBalance = 1000 -- | Run a trace with the given scenario and check that the emulator finished -- successfully with an empty transaction pool. diff --git a/plutus-use-cases/test/Spec/TH.hs b/plutus-use-cases/test/Spec/TH.hs index 1fa98ae1261..05f1e3e6dc4 100644 --- a/plutus-use-cases/test/Spec/TH.hs +++ b/plutus-use-cases/test/Spec/TH.hs @@ -22,11 +22,12 @@ import Language.Plutus.Coordination.Contracts.Vesting (VestingDat pendingTxVesting :: Q Exp pendingTxVesting = [| \(h :: Height) (out :: Value) -> let total = 600 + hash = 1123 -- stand-in for a transaction hash rest = total - out in PendingTx { - pendingTxCurrentInput = (PendingTxIn (PendingTxOutRef 100 0) (), 600), + pendingTxCurrentInput = (PendingTxIn (PendingTxOutRef 100 0) (), total), pendingTxOtherInputs = []::[(PendingTxIn (), Value)], - pendingTxOutputs = (PendingTxOut out Nothing (PubKeyTxOut (PubKey 1))::(PendingTxOut VestingData)):(PendingTxOut rest (Just (VestingData 1123 out)) DataTxOut::(PendingTxOut VestingData)):([]::[PendingTxOut VestingData]), + pendingTxOutputs = (PendingTxOut out Nothing (PubKeyTxOut (PubKey 1))::(PendingTxOut VestingData)):(PendingTxOut rest (Just (VestingData hash out)) DataTxOut::(PendingTxOut VestingData)):([]::[PendingTxOut VestingData]), pendingTxForge = 0, pendingTxFee = 0, pendingTxBlockHeight = h diff --git a/plutus-use-cases/test/Spec/Vesting.hs b/plutus-use-cases/test/Spec/Vesting.hs index 77f169d8278..7a88eec10ba 100644 --- a/plutus-use-cases/test/Spec/Vesting.hs +++ b/plutus-use-cases/test/Spec/Vesting.hs @@ -16,7 +16,8 @@ import Test.Tasty import Test.Tasty.Hedgehog (testProperty) import Language.Plutus.Coordination.Contracts.Vesting (Vesting (..), VestingData (..), VestingPLC (..), - VestingTranche (..), retrieveFunds, vestFunds) + VestingTranche (..), retrieveFunds, totalAmount, + vestFunds) import qualified Language.Plutus.Runtime as Runtime import Language.Plutus.TH (plutus) import Wallet.API (PubKey (..)) @@ -44,32 +45,29 @@ commit w vv vplc vl = exScriptOut <$> walletAction w (void $ vestFunds vplc vv v secureFunds :: Property secureFunds = checkVestingTrace scen1 $ do let VestingScenario splc s [w1, w2] _ = scen1 - total = 600 updateAll' = updateAll scen1 updateAll' _ <- commit w2 s splc total updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w1, 1000)] - + mapM_ (uncurry assertOwnFundsEq) [(w2, w2Funds), (w1, startingBalance)] canRetrieveFunds :: Property canRetrieveFunds = checkVestingTrace scen1 $ do let VestingScenario splc s [w1, w2] _ = scen1 - total = 600 updateAll' = updateAll scen1 updateAll' ref <- commit w2 s splc total updateAll' setValidationData $ ValidationData $(plutus [| $(pendingTxVesting) 11 150 |]) let ds = DataScript $(plutus [| VestingData 1123 150 |]) + -- Take 150 out of the scheme walletAction w1 $ void (retrieveFunds s splc (VestingData 1123 0) ds ref 150) updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w1, 1150)] + mapM_ (uncurry assertOwnFundsEq) [(w2, w2Funds), (w1, startingBalance + 150)] cannotRetrieveTooMuch :: Property cannotRetrieveTooMuch = checkVestingTrace scen1 $ do let VestingScenario splc s [w1, w2] _ = scen1 - total = 600 updateAll' = updateAll scen1 updateAll' ref <- commit w2 s splc total @@ -79,12 +77,11 @@ cannotRetrieveTooMuch = checkVestingTrace scen1 $ do let ds = DataScript $(plutus [| VestingData 1123 250 |]) walletAction w1 $ void (retrieveFunds s splc (VestingData 1123 0) ds ref 250) updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w1, 1000)] + mapM_ (uncurry assertOwnFundsEq) [(w2, w2Funds), (w1, startingBalance)] canRetrieveFundsAtEnd :: Property canRetrieveFundsAtEnd = checkVestingTrace scen1 $ do let VestingScenario splc s [w1, w2] _ = scen1 - total = 600 updateAll' = updateAll scen1 updateAll' ref <- commit w2 s splc total @@ -94,7 +91,7 @@ canRetrieveFundsAtEnd = checkVestingTrace scen1 $ do let ds = DataScript $(plutus [| VestingData 1123 600 |]) walletAction w1 $ void (retrieveFunds s splc (VestingData 1123 0) ds ref 600) updateAll' - mapM_ (uncurry assertOwnFundsEq) [(w2, 400), (w1, 1600)] + mapM_ (uncurry assertOwnFundsEq) [(w2, w2Funds), (w1, startingBalance + fromIntegral total)] -- | Vesting scenario with test parameters data VestingScenario = VestingScenario { @@ -117,8 +114,22 @@ scen1 = VestingScenario{..} where vestingOwner = PubKey 1 } vsWallets = Wallet <$> [1..2] vsInitialBalances = Map.fromList [ - (PubKey 1, 1000), - (PubKey 2, 1000)] + (PubKey 1, startingBalance), + (PubKey 2, startingBalance)] + +-- | Funds available to each wallet after the initial transaction on the +-- mockchain +startingBalance :: UTXO.Value +startingBalance = 1000 + +-- | Amount of money left in wallet `Wallet 2` after committing funds to the +-- vesting scheme +w2Funds :: UTXO.Value +w2Funds = startingBalance - fromIntegral total + +-- | Total amount of money vested in the scheme `scen1` +total :: Runtime.Value +total = totalAmount $ vsVestingScheme scen1 -- | Run a trace with the given scenario and check that the emulator finished -- successfully with an empty transaction pool. diff --git a/wallet-api/src/Wallet/UTXO.hs b/wallet-api/src/Wallet/UTXO.hs index a089d99789a..6e27ee4eb43 100644 --- a/wallet-api/src/Wallet/UTXO.hs +++ b/wallet-api/src/Wallet/UTXO.hs @@ -612,7 +612,6 @@ runScript (ValidationData (getAst -> valData)) (Validator (getAst -> validator)) -- TODO: Enable type checking of the program -- void typecheck - -- | () as a data script unitData :: DataScript unitData = DataScript $(plutus [| () |])