From c1f2c93c9320df2f1bd386b5b25de70c106fd6cd Mon Sep 17 00:00:00 2001 From: megakaban Date: Mon, 5 Jul 2021 17:52:46 +0700 Subject: [PATCH] Add map checks for reserves and configs --- .../Contracts/LendingPool/OffChain/Owner.hs | 1 - .../LendingPool/OnChain/Core/Logic.hs | 21 +++++++++++++----- .../LendingPool/OnChain/Core/Script.hs | 13 +++++++++++ .../LendingPool/OnChain/Core/Validator.hs | 22 ++++++++++++------- 4 files changed, 42 insertions(+), 15 deletions(-) diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs index ca2cb309f..7a4907cf4 100644 --- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs +++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs @@ -102,7 +102,6 @@ start' getAaveToken params = do let aave = Core.aave aaveToken payment = assetClassValue (Core.aaveProtocolInst aave) 1 let aaveTokenTx = TxUtils.mustPayToScript (Core.aaveInstance aave) pkh (Core.LendingPoolDatum pkh) payment - -- TODO how to ensure that newly minted owner token is paid to the script before someone else spends it? ledgerTx <- TxUtils.submitTxPair aaveTokenTx void $ awaitTxConfirmed $ txId ledgerTx diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Logic.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Logic.hs index 895c5e09c..438e7fdc0 100644 --- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Logic.hs +++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Logic.hs @@ -53,6 +53,13 @@ import PlutusTx.Prelude hiding import Prelude (Semigroup (..)) import qualified Prelude +assertMapChange :: (Eq k, Eq a) => ((k, a) -> Bool) -> AssocMap.Map k a -> AssocMap.Map k a -> Bool +assertMapChange filterChanged old new = traceIfFalse "Unexpected datum change" $ f old == f new + where f = filter filterChanged . AssocMap.toList + +assertInsertAt :: (Eq k, Eq a) => k -> AssocMap.Map k a -> AssocMap.Map k a -> Bool +assertInsertAt key = assertMapChange $ (/= key) . fst + {-# INLINABLE pickUserConfigs #-} pickUserConfigs :: AaveDatum -> Maybe (AssetClass, AssocMap.Map UserConfigId UserConfig) pickUserConfigs (UserConfigsDatum stateToken configs) = Just (stateToken, configs) @@ -134,7 +141,7 @@ checkNegativeReservesTransformation :: AssetClass -> UserConfigId -> Bool checkNegativeReservesTransformation stateToken reserves ctx (reserveId, _) = - maybe False checkreserves reservesOutputDatum + maybe False (checkReserves reserves) reservesOutputDatum where txInfo = scriptContextTxInfo ctx (scriptsHash, scriptsDatumHash) = ownHashes ctx @@ -150,9 +157,10 @@ checkNegativeReservesTransformation stateToken reserves ctx (reserveId, _) = remainderDatumHash = findDatumHash (Datum $ PlutusTx.toData ReserveFundsDatum) txInfo remainderValue = (`findValueByDatumHash` scriptOutputs) <$> remainderDatumHash - checkreserves :: (AssetClass, AssocMap.Map AssetClass Reserve) -> Bool - checkreserves (newStateToken, newReserves) = + checkReserves :: AssocMap.Map AssetClass Reserve -> (AssetClass, AssocMap.Map AssetClass Reserve) -> Bool + checkReserves reserves (newStateToken, newReserves) = newStateToken == stateToken && + assertInsertAt reserveId reserves newReserves && maybe False checkReserveState @@ -168,7 +176,7 @@ checkPositiveReservesTransformation :: AssetClass -> ScriptContext -> UserConfigId -> Bool -checkPositiveReservesTransformation stateToken reserves ctx (reserveId, _) = maybe False checkreserves reservesOutputDatum +checkPositiveReservesTransformation stateToken reserves ctx (reserveId, _) = maybe False (checkReserves reserves) reservesOutputDatum where txInfo = scriptContextTxInfo ctx (scriptsHash, scriptsDatumHash) = ownHashes ctx @@ -184,9 +192,10 @@ checkPositiveReservesTransformation stateToken reserves ctx (reserveId, _) = may investmentDatumHash = findDatumHash (Datum $ PlutusTx.toData ReserveFundsDatum) txInfo investmentValue = (`findValueByDatumHash` scriptOutputs) <$> investmentDatumHash - checkreserves :: (AssetClass, AssocMap.Map AssetClass Reserve) -> Bool - checkreserves (newStateToken, newReserves) = + checkReserves :: AssocMap.Map AssetClass Reserve -> (AssetClass, AssocMap.Map AssetClass Reserve) -> Bool + checkReserves reserves (newStateToken, newReserves) = newStateToken == stateToken && + assertInsertAt reserveId reserves newReserves && maybe False checkReserveState diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Script.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Script.hs index 4cca7c6db..32255588e 100644 --- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Script.hs +++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Script.hs @@ -63,6 +63,16 @@ data Reserve = Reserve deriving stock (Prelude.Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) +-- seems like the only way to define PlutusTx's Eq for data that doesn't break validators +instance Eq Reserve where + a == b = + rCurrency a == rCurrency b && rAToken a == rAToken b && + rAmount a == rAmount b && rLiquidityIndex a == rLiquidityIndex b + && rCurrentStableBorrowRate a == rCurrentStableBorrowRate b && rTrustedOracle a == rTrustedOracle b + +instance Eq (CurrencySymbol, PubKeyHash, Integer, AssetClass) where + (a1, b1, c1, d1) == (a2, b2, c2, d2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 + PlutusTx.unstableMakeIsData ''Reserve PlutusTx.makeLift ''Reserve Lens.makeClassy_ ''Reserve @@ -86,6 +96,9 @@ data UserConfig = UserConfig deriving stock (Prelude.Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, ToSchema) +instance Eq UserConfig where + a == b = ucDebt a == ucDebt b && ucCollateralizedInvestment a == ucCollateralizedInvestment b + PlutusTx.unstableMakeIsData ''UserConfig PlutusTx.makeLift ''UserConfig Lens.makeClassy_ ''UserConfig diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Validator.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Validator.hs index 626a1cf46..f83f2b541 100644 --- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Validator.hs +++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core/Validator.hs @@ -50,7 +50,8 @@ import Plutus.Contracts.LendingPool.OnChain.Core.Logic (areOraclesTru doesCollateralCoverDebt, pickReserves, pickUserCollateralFunds, - pickUserConfigs) + pickUserConfigs, + assertInsertAt) import Plutus.Contracts.LendingPool.OnChain.Core.Script (AaveDatum (..), AaveRedeemer (..), AaveScript, @@ -92,10 +93,6 @@ makeAaveValidator :: Aave -> ScriptContext -> Bool makeAaveValidator aave datum StartRedeemer ctx = trace "StartRedeemer" $ validateStart aave datum ctx --- TODO ? further validators should check that ReservesDatum & UserConfigsDatum transormation happens one time --- & ReserveFundsDatum transormation happens at least one time --- TODO ? check that reedeemers contain the same data during transformation --- TODO validate that userConfigId and reserveId are the only datum changed in trasformation and other users datum is not modified makeAaveValidator aave datum (DepositRedeemer userConfigId) ctx = trace "DepositRedeemer" $ validateDeposit aave datum ctx userConfigId makeAaveValidator aave datum (WithdrawRedeemer userConfigId) ctx = trace "WithdrawRedeemer" $ validateWithdraw aave datum ctx userConfigId makeAaveValidator aave datum (BorrowRedeemer userConfigId oracles) ctx = trace "BorrowRedeemer" $ validateBorrow aave datum ctx userConfigId oracles @@ -117,6 +114,7 @@ validateStart aave (LendingPoolDatum operator) ctx = outs -> isJust $ AssocMap.lookup scriptsDatumHash $ AssocMap.fromList outs validateStart aave _ ctx = trace "validateStart: Lending Pool Datum management is not allowed" False + {-# INLINABLE validateDeposit #-} validateDeposit :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Bool validateDeposit aave (UserConfigsDatum stateToken userConfigs) ctx userConfigId = @@ -137,6 +135,7 @@ validateDeposit aave (UserConfigsDatum stateToken userConfigs) ctx userConfigId checkUserConfigs :: (AssetClass, AssocMap.Map UserConfigId UserConfig) -> Bool checkUserConfigs (newStateToken, newUserConfigs) = newStateToken == stateToken && + assertInsertAt userConfigId userConfigs newUserConfigs && maybe False (checkRedeemerConfig (AssocMap.lookup userConfigId userConfigs)) @@ -194,7 +193,9 @@ validateBorrow aave (UserConfigsDatum stateToken userConfigs) ctx userConfigId@( checkUserConfigs :: (AssetClass, AssocMap.Map UserConfigId UserConfig) -> Bool checkUserConfigs (newStateToken, newUserConfigs) = - newStateToken == stateToken && doesCollateralCoverDebt actor oracleValues newUserConfigs && + newStateToken == stateToken && + assertInsertAt userConfigId userConfigs newUserConfigs && + doesCollateralCoverDebt actor oracleValues newUserConfigs && maybe False (checkRedeemerConfig $ AssocMap.lookup userConfigId userConfigs) (AssocMap.lookup userConfigId newUserConfigs) checkRedeemerConfig :: Maybe UserConfig -> UserConfig -> Bool checkRedeemerConfig oldState newState = @@ -235,6 +236,7 @@ validateRepay aave (UserConfigsDatum stateToken userConfigs) ctx userConfigId@(r checkUserConfigs :: (AssetClass, AssocMap.Map UserConfigId UserConfig) -> Bool checkUserConfigs (newStateToken, newUserConfigs) = newStateToken == stateToken && + assertInsertAt userConfigId userConfigs newUserConfigs && (Just True == (checkRedeemerConfig <$> AssocMap.lookup userConfigId userConfigs <*> AssocMap.lookup userConfigId newUserConfigs)) checkRedeemerConfig :: UserConfig -> UserConfig -> Bool @@ -282,7 +284,9 @@ validateProvideCollateral aave (UserConfigsDatum stateToken userConfigs) ctx us checkUserConfigs :: (AssetClass, AssocMap.Map UserConfigId UserConfig) -> (PubKeyHash, AssetClass) -> Bool checkUserConfigs (newStateToken, newUserConfigs) (user, aTokenAsset) = - newStateToken == stateToken && user == actor && + newStateToken == stateToken && + assertInsertAt userConfigId userConfigs newUserConfigs && + user == actor && maybe False (checkRedeemerConfig aTokenAsset $ AssocMap.lookup userConfigId userConfigs) (AssocMap.lookup userConfigId newUserConfigs) checkRedeemerConfig :: AssetClass -> Maybe UserConfig -> UserConfig -> Bool checkRedeemerConfig asset oldState newState = @@ -323,7 +327,9 @@ validateRevokeCollateral aave (UserConfigsDatum stateToken userConfigs) ctx use checkUserConfigs :: (AssetClass, AssocMap.Map UserConfigId UserConfig) -> Bool checkUserConfigs (newStateToken, newUserConfigs) = - newStateToken == stateToken && doesCollateralCoverDebt actor oracleValues newUserConfigs && + newStateToken == stateToken && + assertInsertAt userConfigId userConfigs newUserConfigs && + doesCollateralCoverDebt actor oracleValues newUserConfigs && fromMaybe False (checkRedeemerConfig <$> (AssocMap.lookup userConfigId userConfigs) <*> (AssocMap.lookup userConfigId newUserConfigs)) checkRedeemerConfig :: UserConfig -> UserConfig -> Bool checkRedeemerConfig oldState newState =