fix aave tokens validator

input-output-hk · Jun 8, 2021 · 2de9931 · 2de9931
1 parent 59313b6
commit 2de9931
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 23 deletions.
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/AToken.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/AToken.hs
@@ -49,40 +49,43 @@ import           PlutusTx.Prelude                 hiding (Semigroup (..))
 import qualified PlutusTx.Semigroup               as Semigroup
 import           Prelude                          (Semigroup (..))
 import qualified Prelude
+import Ext.Plutus.Ledger.Contexts (scriptInputsAt)
 
 {-# INLINABLE validator #-}
--- TODO Check amounts are > 0
-validator :: AssetClass -> TokenName -> ScriptContext -> Bool
-validator underlyingAsset aTokenName ctx = hasEnoughUnderlyingAsset
+validator :: ValidatorHash -> AssetClass -> TokenName -> ScriptContext -> Bool
+validator aaveScript underlyingAsset aTokenName ctx =
+    traceIfFalse "Aave tokens mint forbidden" $ amountMinted /= 0 && amountScriptAsset == amountMinted
     where
         txInfo :: TxInfo
         txInfo = scriptContextTxInfo ctx
-
         aTokenCurrency :: AssetClass
         aTokenCurrency = assetClass (ownCurrencySymbol ctx) aTokenName
+        amountAsset :: Value -> Integer
+        amountAsset = flip assetClassValueOf underlyingAsset
 
         amountMinted :: Integer
         amountMinted = assetClassValueOf (txInfoForge txInfo) aTokenCurrency
 
-        -- TODO how to check if value spent comes from pub key when aTokens are minted and comes from aave script when aTokens are burned?
-        amountAsset :: Integer
-        amountAsset = assetClassValueOf (valueSpent txInfo) underlyingAsset
-
-        hasEnoughUnderlyingAsset :: Bool
-        hasEnoughUnderlyingAsset =  amountMinted <= amountAsset
+        amountScriptAsset :: Integer
+        amountScriptAsset =
+          let outputValue = foldMap snd $ scriptOutputsAt aaveScript txInfo
+              inputValue = foldMap snd $ scriptInputsAt aaveScript txInfo
+           in amountAsset outputValue - amountAsset inputValue
 
-makeLiquidityPolicy :: AssetClass -> MonetaryPolicy
-makeLiquidityPolicy asset = Scripts.mkMonetaryPolicyScript $
-  $$(PlutusTx.compile [|| \a t -> Scripts.wrapMonetaryPolicy $ validator a t||])
+makeLiquidityPolicy :: ValidatorHash -> AssetClass -> MonetaryPolicy
+makeLiquidityPolicy aaveScript asset = Scripts.mkMonetaryPolicyScript $
+  $$(PlutusTx.compile [|| \s a t -> Scripts.wrapMonetaryPolicy $ validator s a t||])
+    `PlutusTx.applyCode`
+        PlutusTx.liftCode aaveScript
     `PlutusTx.applyCode`
         PlutusTx.liftCode asset
     `PlutusTx.applyCode`
         PlutusTx.liftCode aToken
         where
             aToken = aTokenName asset
 
-makeAToken :: AssetClass -> AssetClass
-makeAToken asset = assetClass (scriptCurrencySymbol . makeLiquidityPolicy $ asset) (aTokenName asset)
+makeAToken :: ValidatorHash -> AssetClass -> AssetClass
+makeAToken aaveScript asset = assetClass (scriptCurrencySymbol $ makeLiquidityPolicy aaveScript asset) (aTokenName asset)
 
 {-# INLINABLE aTokenName #-}
 aTokenName :: AssetClass -> TokenName
@@ -91,7 +94,7 @@ aTokenName asset = TokenName $ "a" Semigroup.<> case asset of
 
 forgeATokensFrom :: forall w s. (HasBlockchainActions s) => Aave -> Reserve -> PubKeyHash -> Integer -> Contract w s Text (TxUtils.TxPair AaveScript)
 forgeATokensFrom aave reserve pkh amount = do
-    let policy = makeLiquidityPolicy (rCurrency reserve)
+    let policy = makeLiquidityPolicy (Core.aaveHash aave) (rCurrency reserve)
         aTokenAmount = amount -- / rLiquidityIndex reserve -- TODO: how should we divide?
         forgeValue = assetClassValue (rAToken reserve) aTokenAmount
     let payment = assetClassValue (rCurrency reserve) amount
@@ -110,7 +113,7 @@ burnATokensFrom aave reserve pkh amount = do
     let balance = mconcat . fmap (txOutValue . txOutTxOut) . map snd . Map.toList $ utxos
         aTokenAmount = amount
         remainder = assetClassValueOf balance asset - aTokenAmount
-        policy = makeLiquidityPolicy asset
+        policy = makeLiquidityPolicy (Core.aaveHash aave) asset
         burnValue = negate $ assetClassValue (rAToken reserve) aTokenAmount
         spendInputs = (\(ref, tx) -> OutputValue ref tx (Core.WithdrawRedeemer userConfigId)) <$> Map.toList utxos
     pure $

diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs
@@ -65,12 +65,12 @@ newtype CreateParams =
 
 PlutusTx.makeLift ''CreateParams
 
-createReserve :: CreateParams -> Reserve
-createReserve CreateParams {..} =
+createReserve :: Aave -> CreateParams -> Reserve
+createReserve aave CreateParams {..} =
     Reserve
         { rCurrency = cpAsset,
           rAmount = 0,
-          rAToken = AToken.makeAToken cpAsset,
+          rAToken = AToken.makeAToken (Core.aaveHash aave) cpAsset,
           rLiquidityIndex = 1,
           rCurrentStableBorrowRate = 11 % 10 -- TODO configure borrow rate when lending core will be ready
            }
@@ -88,7 +88,7 @@ start params = do
     ledgerTx <- TxUtils.submitTxPair aaveTokenTx
     void $ awaitTxConfirmed $ txId ledgerTx
 
-    let reserveMap = AssocMap.fromList $ fmap (\params -> (cpAsset params, createReserve params)) params
+    let reserveMap = AssocMap.fromList $ fmap (\params -> (cpAsset params, createReserve aave params)) params
     reservesTx <- State.putReserves aave Core.StartRedeemer reserveMap
     ledgerTx <- TxUtils.submitTxPair reservesTx
     void $ awaitTxConfirmed $ txId ledgerTx

diff --git a/MetaLamp/lending-pool/src/Plutus/State/Update.hs b/MetaLamp/lending-pool/src/Plutus/State/Update.hs
@@ -45,17 +45,19 @@ import Ext.Plutus.Ledger.Contexts (scriptInputsAt)
 
 type OwnerToken = AssetClass
 
--- State token can be only be forged when there is an input and outpu containing an owner token belonging to a script
+-- State token can be only be forged when there is an input and output containing an owner token belonging to a script
 {-# INLINABLE validateStateForging #-}
 validateStateForging :: ValidatorHash -> OwnerToken -> TokenName -> ScriptContext -> Bool
 validateStateForging ownerScript ownerToken tokenName ctx = traceIfFalse "State forging not authorized" $
     hasOneOwnerToken outputValues && hasOneOwnerToken inputValues && hasOneStateToken forgedValue && hasOneStateToken (mconcat outputValues)
   where
     txInfo = scriptContextTxInfo ctx
+    stateToken = assetClass (ownCurrencySymbol ctx) tokenName
+
     outputValues = snd <$> scriptOutputsAt ownerScript txInfo
     inputValues = snd <$> scriptInputsAt ownerScript txInfo
     forgedValue = txInfoForge txInfo
-    stateToken = assetClass (ownCurrencySymbol ctx) tokenName
+
     hasOneOwnerToken values = assetClassValueOf (mconcat values) ownerToken == 1
     hasOneStateToken value = assetClassValueOf value stateToken == 1