From fd20e6a341d6ecbafa1ddd7c2d5343073282f8a7 Mon Sep 17 00:00:00 2001
From: megakaban <nakedant19@gmail.com>
Date: Mon, 6 Sep 2021 13:00:39 +0700
Subject: [PATCH 1/2] Add risk parameters
---
.../client/src/Component/MainPage.purs | 7 +-
.../client/src/View/ReserveInfo.purs | 20 +-
.../lending-pool/generate-purs/AaveTypes.hs | 1 +
MetaLamp/lending-pool/plutus-starter.cabal | 4 +-
.../src/Ext/Plutus/Ledger/Contexts.hs | 3 +-
.../src/Plutus/Abstract/OutputValue.hs | 7 +-
.../src/Plutus/Abstract/State/Select.hs | 6 +-
.../Contracts/LendingPool/InterestRate.hs | 134 +++++++++
.../Contracts/LendingPool/OffChain/AToken.hs | 2 +-
.../Contracts/LendingPool/OffChain/Info.hs | 2 +-
.../Contracts/LendingPool/OffChain/Owner.hs | 37 ++-
.../Contracts/LendingPool/OffChain/State.hs | 92 +++----
.../Contracts/LendingPool/OffChain/User.hs | 258 ++++++++++--------
.../Contracts/LendingPool/OnChain/Core.hs | 11 +-
.../LendingPool/OnChain/Core/Logic.hs | 67 +++--
.../LendingPool/OnChain/Core/Script.hs | 43 ++-
.../LendingPool/OnChain/Core/Validator.hs | 193 ++++++++-----
.../Plutus/Contracts/LendingPool/Shared.hs | 155 ++++++++++-
18 files changed, 736 insertions(+), 306 deletions(-)
create mode 100644 MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
diff --git a/MetaLamp/lending-pool/client/src/Component/MainPage.purs b/MetaLamp/lending-pool/client/src/Component/MainPage.purs
index 5c6ccac86..c604c7ded 100644
--- a/MetaLamp/lending-pool/client/src/Component/MainPage.purs
+++ b/MetaLamp/lending-pool/client/src/Component/MainPage.purs
@@ -5,7 +5,7 @@ import Business.Aave as Aave
import Business.AaveInfo as AaveInfo
import Business.AaveUser (UserContractId)
import Business.AaveUser as AaveUser
-import Capability.LogMessages (class LogMessages)
+import Capability.LogMessages (class LogMessages, logInfo)
import Capability.PollContract (class PollContract)
import Component.Contract as Contract
import Component.Contract as ContractComponent
@@ -148,7 +148,10 @@ component =
RD.maybe (throwError "contracts are missing") pure
$ state.contracts
case catMaybes (AaveInfo.getInfoContractId <$> contracts) of
- [ cid ] -> lift (AaveInfo.reserves cid) >>= either (throwError <<< show) pure
+ [ cid ] -> do
+ result <- lift (AaveInfo.reserves cid) >>= either (throwError <<< show) pure
+ lift <<< logInfo <<< show $ result
+ pure result
_ -> throwError "Info contract not found"
content = BEM.block "content"
diff --git a/MetaLamp/lending-pool/client/src/View/ReserveInfo.purs b/MetaLamp/lending-pool/client/src/View/ReserveInfo.purs
index ee42f6df7..49f66beb4 100644
--- a/MetaLamp/lending-pool/client/src/View/ReserveInfo.purs
+++ b/MetaLamp/lending-pool/client/src/View/ReserveInfo.purs
@@ -1,14 +1,26 @@
module View.ReserveInfo where
import Prelude
-import Data.BigInteger (BigInteger)
+import Data.BigInteger (BigInteger, fromInt, toNumber)
import Halogen.HTML as HH
import Plutus.Contracts.LendingPool.OnChain.Core.Script (Reserve(..))
import Plutus.V1.Ledger.Value (AssetClass)
import View.Utils (assetName)
+import Data.Json.JsonTuple (JsonTuple(..))
+import Data.Tuple (Tuple(..))
reserveInfo :: forall props act. AssetClass -> Reserve -> HH.HTML props act
-reserveInfo asset (Reserve { rAmount }) = poolTab asset rAmount
+reserveInfo asset (Reserve { rAmount, rCurrentStableBorrowRate, rLiquidityRate }) =
+ HH.div_ [poolBalance asset rAmount, poolRates rCurrentStableBorrowRate rLiquidityRate]
-poolTab :: forall props act. AssetClass -> BigInteger -> HH.HTML props act
-poolTab asset amount = HH.div_ $ [ HH.h4_ [ HH.text (assetName asset <> " pool balance") ], HH.text $ show amount ]
+poolBalance :: forall props act. AssetClass -> BigInteger -> HH.HTML props act
+poolBalance asset amount = HH.div_ $ [ HH.h4_ [ HH.text (assetName asset <> " pool balance") ], HH.text $ show amount ]
+
+poolRates :: forall props act. JsonTuple BigInteger BigInteger -> JsonTuple BigInteger BigInteger -> HH.HTML props act
+poolRates borrowRate incomeRate = HH.div_ $ [ HH.text $ "Borrow rate: " <> showPercent borrowRate <> " Income rate: " <> showPercent incomeRate ]
+
+showPercent :: JsonTuple BigInteger BigInteger -> String
+showPercent = (_ <> "%") <<< show <<< ratioToPercent
+
+ratioToPercent :: JsonTuple BigInteger BigInteger -> Number
+ratioToPercent (JsonTuple (Tuple a b)) = toNumber (a * (fromInt 100)) / (toNumber b)
diff --git a/MetaLamp/lending-pool/generate-purs/AaveTypes.hs b/MetaLamp/lending-pool/generate-purs/AaveTypes.hs
index ba5f68abf..b3cf083ef 100644
--- a/MetaLamp/lending-pool/generate-purs/AaveTypes.hs
+++ b/MetaLamp/lending-pool/generate-purs/AaveTypes.hs
@@ -61,6 +61,7 @@ aaveTypes = [ (equal <*> (genericShow <*> mkSumType)) (Proxy @AaveContracts)
, (order <*> (equal <*> (genericShow <*> mkSumType))) (Proxy @AssetClass)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @Aave.UserContractState)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @Aave.InfoContractState)
+ , (equal <*> (genericShow <*> mkSumType)) (Proxy @Aave.InterestRateModel)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @Aave.Reserve)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @Aave.UserConfig)
, (equal <*> (genericShow <*> mkSumType)) (Proxy @Aave.DepositParams)
diff --git a/MetaLamp/lending-pool/plutus-starter.cabal b/MetaLamp/lending-pool/plutus-starter.cabal
index 056cd3f6f..245211ece 100644
--- a/MetaLamp/lending-pool/plutus-starter.cabal
+++ b/MetaLamp/lending-pool/plutus-starter.cabal
@@ -23,7 +23,7 @@ maintainer: Your email
library
exposed-modules:
- Plutus.Abstract.State Plutus.Abstract.State.Select Plutus.Abstract.State.Update Plutus.Abstract.ContractResponse Plutus.Abstract.OutputValue Plutus.Abstract.TxUtils Plutus.Abstract.IncentivizedAmount Plutus.Contracts.Service.FungibleToken Plutus.Contracts.Service.Oracle Plutus.Contracts.LendingPool.Shared Plutus.Contracts.LendingPool.OnChain.Core Plutus.Contracts.LendingPool.OnChain.Core.Script Plutus.Contracts.LendingPool.OnChain.Core.Validator Plutus.Contracts.LendingPool.OnChain.Core.Logic Plutus.Contracts.LendingPool.OnChain.AToken Plutus.Contracts.LendingPool.OffChain.AToken Plutus.Contracts.LendingPool.OffChain.Info Plutus.Contracts.LendingPool.OffChain.Owner Plutus.Contracts.LendingPool.OffChain.State Plutus.Contracts.LendingPool.OffChain.User Plutus.PAB.Simulation Ext.Plutus.Ledger.Value Ext.Plutus.Ledger.Contexts
+ Plutus.Abstract.State Plutus.Abstract.State.Select Plutus.Abstract.State.Update Plutus.Abstract.ContractResponse Plutus.Abstract.OutputValue Plutus.Abstract.TxUtils Plutus.Abstract.IncentivizedAmount Plutus.Contracts.Service.FungibleToken Plutus.Contracts.Service.Oracle Plutus.Contracts.LendingPool.InterestRate Plutus.Contracts.LendingPool.Shared Plutus.Contracts.LendingPool.OnChain.Core Plutus.Contracts.LendingPool.OnChain.Core.Script Plutus.Contracts.LendingPool.OnChain.Core.Validator Plutus.Contracts.LendingPool.OnChain.Core.Logic Plutus.Contracts.LendingPool.OnChain.AToken Plutus.Contracts.LendingPool.OffChain.AToken Plutus.Contracts.LendingPool.OffChain.Info Plutus.Contracts.LendingPool.OffChain.Owner Plutus.Contracts.LendingPool.OffChain.State Plutus.Contracts.LendingPool.OffChain.User Plutus.PAB.Simulation Ext.Plutus.Ledger.Value Ext.Plutus.Ledger.Contexts
build-depends:
base >= 4.9 && < 5,
aeson,
@@ -102,7 +102,7 @@ test-suite test
main-is: Main.hs
hs-source-dirs: test
other-modules:
- Spec.Start Spec.Deposit Spec.Withdraw Spec.ProvideCollateral Spec.RevokeCollateral Spec.Borrow Spec.Repay Spec.Shared Utils.Data Utils.Trace Fixtures Fixtures.Symbol Fixtures.Aave Fixtures.Asset Fixtures.Init Fixtures.Wallet
+ Spec.Start Spec.Deposit Spec.Withdraw Spec.ProvideCollateral Spec.RevokeCollateral Spec.Borrow Spec.Repay Spec.Shared Plutus.Contracts.LendingPool.InterestRate Utils.Data Utils.Trace Fixtures Fixtures.Symbol Fixtures.Aave Fixtures.Asset Fixtures.Init Fixtures.Wallet
default-language: Haskell2010
ghc-options: -Wall -Wnoncanonical-monad-instances
-Wincomplete-uni-patterns -Wincomplete-record-updates
diff --git a/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs b/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
index f4b44c08a..638c994a6 100644
--- a/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
+++ b/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
@@ -47,8 +47,7 @@ findValueByDatum :: PlutusTx.IsData a => ScriptContext -> a -> Maybe Value
findValueByDatum ctx datum = (`findValueByDatumHash` scriptOutputs) <$> findDatumHash (Datum $ PlutusTx.toData datum) txInfo
where
txInfo = scriptContextTxInfo ctx
- (scriptsHash, _) = ownHashes ctx
- scriptOutputs = scriptOutputsAt scriptsHash txInfo
+ scriptOutputs = getScriptOutputs ctx
{-# INLINABLE findValueByDatumHash #-}
-- | Concat value of the script's outputs that have the specified hash of a datum
diff --git a/MetaLamp/lending-pool/src/Plutus/Abstract/OutputValue.hs b/MetaLamp/lending-pool/src/Plutus/Abstract/OutputValue.hs
index 96fafabac..d5dfac85a 100644
--- a/MetaLamp/lending-pool/src/Plutus/Abstract/OutputValue.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Abstract/OutputValue.hs
@@ -1,12 +1,14 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Plutus.Abstract.OutputValue where
import Control.Lens (makeClassy_)
-import Ledger (TxOutRef, TxOutTx)
+import Ledger (TxOutRef, TxOutTx, Value)
+import Ledger.Tx (txOutTxOut, txOutValue)
import qualified PlutusTx.Prelude as PlutuxTx
data OutputValue a =
@@ -17,3 +19,6 @@ data OutputValue a =
} deriving (Prelude.Show, Prelude.Functor)
makeClassy_ ''OutputValue
+
+getOutputValue :: OutputValue a -> Value
+getOutputValue OutputValue {..} = txOutValue . txOutTxOut $ ovOutTx
diff --git a/MetaLamp/lending-pool/src/Plutus/Abstract/State/Select.hs b/MetaLamp/lending-pool/src/Plutus/Abstract/State/Select.hs
index e85c29670..bda85816f 100644
--- a/MetaLamp/lending-pool/src/Plutus/Abstract/State/Select.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Abstract/State/Select.hs
@@ -40,8 +40,8 @@ getDatum o = case txOutDatumHash $ txOutTxOut o of
Nothing -> throwError "datum has wrong type"
Just d -> return d
-getState :: (PlutusTx.IsData datum) => Address -> Contract w s Text [OutputValue datum]
-getState address = do
+getOutputsAt :: (PlutusTx.IsData datum) => Address -> Contract w s Text [OutputValue datum]
+getOutputsAt address = do
utxos <- utxoAt address
traverse getDatum' . Map.toList $ utxos
where
@@ -54,7 +54,7 @@ findOutputsBy :: (PlutusTx.IsData datum) =>
AssetClass ->
(datum -> Maybe a) ->
Contract w s Text [OutputValue a]
-findOutputsBy address stateToken mapDatum = mapMaybe checkStateToken <$> getState address
+findOutputsBy address stateToken mapDatum = mapMaybe checkStateToken <$> getOutputsAt address
where
checkStateToken (OutputValue oref outTx datum) =
if assetClassValueOf (txOutValue $ txOutTxOut outTx) stateToken == 1
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
new file mode 100644
index 000000000..385261f4b
--- /dev/null
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -fno-specialise #-}
+{-# OPTIONS_GHC -fno-strictness #-}
+{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
+{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
+{-# OPTIONS_GHC -fobject-code #-}
+
+module Plutus.Contracts.LendingPool.InterestRate where
+
+import Plutus.Abstract.IncentivizedAmount (IncentivizedAmount (..))
+import Plutus.Contracts.LendingPool.OnChain.Core.Script (InterestRateModel (..),
+ Reserve (..),
+ UserConfig (..))
+import Plutus.V1.Ledger.Slot (Slot (..))
+import Plutus.V1.Ledger.Value (AssetClass)
+import PlutusTx.Prelude
+import PlutusTx.Ratio (Ratio,
+ Rational,
+ denominator,
+ numerator,
+ reduce)
+import qualified Prelude
+
+{-# INLINABLE updateCumulativeIndices #-}
+updateCumulativeIndices :: Reserve -> [UserConfig] -> Slot -> Reserve
+updateCumulativeIndices reserve@Reserve{..} userConfigs currentSlot =
+ if totalBorrows > (fromInteger 0)
+ then
+ if rLastLiquidityCumulativeIndex == fromInteger 0
+ then
+ reserve {
+ rLastLiquidityCumulativeIndex = cumulatedLiquidityInterest,
+ rLastUpdated = currentSlot
+ }
+ else
+ reserve {
+ rLastLiquidityCumulativeIndex = rLastLiquidityCumulativeIndex * cumulatedLiquidityInterest,
+ rLastUpdated = currentSlot
+ }
+ else reserve
+ where
+ totalBorrows = getTotalBorrows userConfigs
+ cumulatedLiquidityInterest = calculateLinearInterest rLastUpdated currentSlot rLiquidityRate
+
+{-# INLINABLE getTotalBorrows #-}
+getTotalBorrows :: [UserConfig] -> Rational
+getTotalBorrows = foldr (\acc cur -> cur + (iaAmount . ucDebt $ acc)) (fromInteger 0)
+
+{-# INLINABLE calculateLinearInterest #-}
+calculateLinearInterest :: Slot -> Slot -> Rational -> Rational
+calculateLinearInterest last current rate = rate * timeDelta
+ where
+ timeDifference = current - last
+ timeDelta = getSlot timeDifference % getSlot slotsPerYear
+
+slotsPerYear :: Slot
+slotsPerYear = Slot 31536000
+
+data RateParams = RateParams {
+ rpAvailableLiquidity :: Integer,
+ rpTotalBorrows :: Rational
+}
+
+{-# INLINABLE updateReserveInterestRates #-}
+updateReserveInterestRates :: RateParams -> Slot -> Rational -> Reserve -> Reserve
+updateReserveInterestRates rateParams currentSlot averageStableBorrowRate reserve@Reserve{..} =
+ reserve {
+ rLiquidityRate = getCurrentLiqudityRate rateParams averageStableBorrowRate,
+ rCurrentStableBorrowRate = getCurrentStableBorrowRate rInterestRateModel rateParams,
+ rLastUpdated = currentSlot }
+
+{-# INLINABLE getCurrentLiqudityRate #-}
+getCurrentLiqudityRate :: RateParams -> Rational -> Rational
+getCurrentLiqudityRate rateParams averageStableBorrowRate =
+ if utilizationRate == fromInteger 0
+ then fromInteger 0
+ else borrowRate `divideRatio` utilizationRate
+ where
+ utilizationRate = getUtilizationRate rateParams
+ borrowRate = if (rpTotalBorrows rateParams) == (fromInteger 0) then (fromInteger 0) else averageStableBorrowRate
+
+defaultRateModel :: InterestRateModel
+defaultRateModel = InterestRateModel {
+ irmOptimalUtilizationRate = 8 % 10,
+ irmExcessUtilizationRate = 2 % 10,
+ irmStableRateSlope1 = 4 % 100,
+ irmStableRateSlope2 = 1 % 1,
+ irmMarketBorrowRate = 4 % 100
+}
+
+-- TODO: figure out the right way to do it
+{-# INLINABLE divideRatio #-}
+divideRatio :: Rational -> Rational -> Rational
+divideRatio a b = reduce (numerator a * denominator b) (denominator a * numerator b)
+
+{-# INLINABLE getCurrentStableBorrowRate #-}
+getCurrentStableBorrowRate :: InterestRateModel -> RateParams -> Rational
+getCurrentStableBorrowRate InterestRateModel{..} rateParams =
+ if utilizationRate > irmOptimalUtilizationRate
+ then
+ let excessUtilizationRateRatio = (utilizationRate - irmOptimalUtilizationRate) `divideRatio` irmExcessUtilizationRate
+ in irmMarketBorrowRate + irmStableRateSlope1 + irmStableRateSlope2 * excessUtilizationRateRatio
+ else
+ irmMarketBorrowRate + irmStableRateSlope1 * utilizationRate `divideRatio` irmOptimalUtilizationRate
+ where
+ utilizationRate = getUtilizationRate rateParams
+
+{-# INLINABLE getUtilizationRate #-}
+getUtilizationRate :: RateParams -> Rational
+getUtilizationRate RateParams{..} =
+ if rpTotalBorrows == (fromInteger 0) || rpAvailableLiquidity == 0
+ then fromInteger 0
+ else rpTotalBorrows `divideRatio` (rpTotalBorrows + fromInteger rpAvailableLiquidity)
+
+{-# INLINABLE getNormalizedIncome #-}
+getNormalizedIncome :: Reserve -> Slot -> Slot -> Rational
+getNormalizedIncome Reserve{..} previous current =
+ rLastLiquidityCumulativeIndex * calculateLinearInterest previous current rLiquidityRate
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/AToken.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/AToken.hs
index ac1c5c356..dc16c180b 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/AToken.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/AToken.hs
@@ -48,7 +48,7 @@ import qualified Prelude
forgeATokensFrom :: forall w s. Aave -> Reserve -> PubKeyHash -> Integer -> Contract w s Text (TxUtils.TxPair AaveScript)
forgeATokensFrom aave reserve pkh amount = do
let policy = makeLiquidityPolicy (Core.aaveHash aave) (rCurrency reserve)
- aTokenAmount = amount -- / rLiquidityIndex reserve -- TODO: how should we divide?
+ aTokenAmount = amount
forgeValue = assetClassValue (rAToken reserve) aTokenAmount
let payment = assetClassValue (rCurrency reserve) amount
pure $
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Info.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Info.hs
index 7171142fb..a8f61b2dc 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Info.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Info.hs
@@ -74,7 +74,7 @@ fundsAt pkh = utxoValue <$> utxoAt (pubKeyHashAddress pkh)
-- | Gets all UTxOs belonging to the Lending Pool script and concats them into one Value
poolFunds :: Aave -> Contract w s Text Value
-poolFunds aave = utxoValue <$> utxoAt (Core.aaveAddress aave)
+poolFunds aave = utxoValue <$> utxoAt (Core.aaveAddress aave)
type AaveInfoSchema =
Endpoint "fundsAt" PubKeyHash
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 96310db7a..510a5e18e 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs
@@ -40,10 +40,12 @@ import Plutus.Abstract.OutputValue (OutputValue (..))
import qualified Plutus.Abstract.TxUtils as TxUtils
import Plutus.Contract hiding (when)
import Plutus.Contracts.Currency as Currency
+import qualified Plutus.Contracts.LendingPool.InterestRate as InterestRate
import qualified Plutus.Contracts.LendingPool.OffChain.State as State
import qualified Plutus.Contracts.LendingPool.OnChain.AToken as AToken
import Plutus.Contracts.LendingPool.OnChain.Core (Aave,
AaveDatum (..),
+ AaveNewState (..),
AaveRedeemer (..),
Reserve (..),
UserConfig (..))
@@ -76,17 +78,29 @@ data CreateParams =
PlutusTx.makeLift ''CreateParams
-createReserve :: Aave -> CreateParams -> Reserve
-createReserve aave CreateParams {..} =
+createReserve :: Aave -> Slot -> CreateParams -> Reserve
+createReserve aave currentSlot CreateParams {..} =
Reserve
{ rCurrency = cpAsset,
rAmount = 0,
rAToken = AToken.makeAToken (Core.aaveHash aave) cpAsset,
- rLiquidityIndex = 1,
- rCurrentStableBorrowRate = 101 % 100,
- rCurrentStableAccrualRate = 101 % 100,
- rTrustedOracle = Oracle.toTuple cpOracle
+ rCurrentStableBorrowRate =
+ InterestRate.getCurrentStableBorrowRate
+ interestModel
+ rateParams,
+ rLiquidityRate = fromInteger 0,
+ rTrustedOracle = Oracle.toTuple cpOracle,
+ rLastUpdated = currentSlot,
+ rLastLiquidityCumulativeIndex = fromInteger 0,
+ rMarketBorrowRate = 180 % 100,
+ rInterestRateModel = interestModel
}
+ where
+ rateParams = InterestRate.RateParams
+ { InterestRate.rpAvailableLiquidity = 0,
+ InterestRate.rpTotalBorrows = fromInteger 0
+ }
+ interestModel = InterestRate.defaultRateModel
-- | Starts the Lending Pool protocol: minting pool NFTs, creating empty user configuration state and all specified liquidity reserves
start :: [CreateParams] -> Contract w s Text Aave
@@ -106,12 +120,11 @@ start' getAaveToken params = do
ledgerTx <- TxUtils.submitTxPair aaveTokenTx
void $ awaitTxConfirmed $ txId ledgerTx
- 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
- userConfigsTx <- State.putUserConfigs aave Core.StartRedeemer AssocMap.empty
- ledgerTx <- TxUtils.submitTxPair userConfigsTx
+ slot <- currentSlot
+ let reserveMap = AssocMap.fromList $ fmap (\params -> (cpAsset params, createReserve aave slot params)) params
+
+ stateTx <- State.putAaveState aave Core.StartRedeemer AaveNewState { ansReserves = reserveMap, ansUserConfigs = AssocMap.empty }
+ ledgerTx <- TxUtils.submitTxPair stateTx
void $ awaitTxConfirmed $ txId ledgerTx
logInfo @Prelude.String $ printf "started Aave %s at address %s" (show aave) (show $ Core.aaveAddress aave)
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs
index e7984222a..eada596dc 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs
@@ -28,7 +28,8 @@ import qualified Ledger.Typed.Scripts as Scripts
import Playground.Contract
import Plutus.Abstract.IncentivizedAmount (accrue)
import Plutus.Abstract.OutputValue (OutputValue (..),
- _ovValue)
+ _ovValue,
+ getOutputValue)
import qualified Plutus.Abstract.State as State
import Plutus.Abstract.State.Update (PutStateHandle (..),
StateHandle (..))
@@ -37,14 +38,13 @@ import Plutus.Contract hiding (when)
import Plutus.Contracts.Currency as Currency
import Plutus.Contracts.LendingPool.OnChain.Core (Aave (..),
AaveDatum (..),
+ AaveNewState (..),
AaveRedeemer (..),
AaveScript,
Reserve (..),
UserConfig (..),
UserConfigId,
- getAaveState,
- reserveStateToken,
- userStateToken)
+ aaveStateToken)
import qualified Plutus.Contracts.LendingPool.OnChain.Core as Core
import qualified Plutus.Contracts.Service.FungibleToken as FungibleToken
import Plutus.V1.Ledger.Ada (adaValueOf,
@@ -69,7 +69,14 @@ findAaveOwnerToken :: Aave -> Contract w s Text (OutputValue PubKeyHash)
findAaveOwnerToken aave@Aave{..} = findOutputBy aave aaveProtocolInst (^? Core._LendingPoolDatum)
findAaveReserves :: Aave -> Contract w s Text (OutputValue (AssocMap.Map AssetClass Reserve))
-findAaveReserves aave = findOutputBy aave (reserveStateToken aave) (^? Core._ReservesDatum . _2)
+findAaveReserves aave = findOutputBy aave (aaveStateToken aave) (fmap Core.ansReserves . (^? Core._StateDatum . _2))
+
+getAaveCollateralValue :: Aave -> Contract w s Text Value
+getAaveCollateralValue aave = foldMap getValue <$> State.getOutputsAt (Core.aaveAddress aave)
+ where
+ getValue out@OutputValue {..} = case ovValue of
+ Core.ReserveFundsDatum -> getOutputValue out
+ _ -> mempty
findAaveReserve :: Aave -> AssetClass -> Contract w s Text Reserve
findAaveReserve aave reserveId = do
@@ -77,7 +84,7 @@ findAaveReserve aave reserveId = do
maybe (throwError "Reserve not found") pure $ AssocMap.lookup reserveId reserves
findAaveUserConfigs :: Aave -> Contract w s Text (OutputValue (AssocMap.Map UserConfigId UserConfig))
-findAaveUserConfigs aave = findOutputBy aave (userStateToken aave) (^? Core._UserConfigsDatum . _2)
+findAaveUserConfigs aave = findOutputBy aave (aaveStateToken aave) (fmap Core.ansUserConfigs . (^? Core._StateDatum . _2))
findAaveUserConfig :: Aave -> UserConfigId -> Contract w s Text UserConfig
findAaveUserConfig aave userConfigId = do
@@ -95,56 +102,43 @@ putState aave stateHandle newState = do
updateState :: Aave -> StateHandle AaveScript a -> OutputValue a -> Contract w s Text (TxUtils.TxPair AaveScript, a)
updateState aave = State.updateState (Core.aaveInstance aave)
-makeReserveHandle :: Aave -> (AssocMap.Map AssetClass Reserve -> AaveRedeemer) -> StateHandle AaveScript (AssocMap.Map AssetClass Reserve)
-makeReserveHandle aave toRedeemer =
- StateHandle {
- stateToken = reserveStateToken aave,
- toDatum = Core.ReservesDatum (getAaveState aave),
- toRedeemer = toRedeemer
- }
-
-putReserves :: Aave -> AaveRedeemer -> AssocMap.Map AssetClass Reserve -> Contract w s Text (TxUtils.TxPair AaveScript)
-putReserves aave redeemer = putState aave $ makeReserveHandle aave (const redeemer)
-
-updateReserves :: Aave -> AaveRedeemer -> OutputValue (AssocMap.Map AssetClass Reserve) -> Contract w s Text (TxUtils.TxPair AaveScript, AssocMap.Map AssetClass Reserve)
-updateReserves aave redeemer = updateState aave $ makeReserveHandle aave (const redeemer)
+findAaveState :: Aave -> Contract w s Text (OutputValue AaveNewState)
+findAaveState aave = findOutputBy aave (aaveStateToken aave) (^? Core._StateDatum . _2)
-updateReserve :: Aave -> AaveRedeemer -> AssetClass -> Reserve -> Contract w s Text (TxUtils.TxPair AaveScript, AssocMap.Map AssetClass Reserve)
-updateReserve aave redeemer reserveId reserve = do
- reservesOutput <- findAaveReserves aave
- _ <- maybe (throwError "Update failed: reserve not found") pure $
- AssocMap.lookup reserveId (ovValue reservesOutput)
- updateReserves aave redeemer $ Prelude.fmap (AssocMap.insert reserveId reserve) reservesOutput
-
-roundtripReserves :: Aave -> AaveRedeemer -> Contract w s Text (TxUtils.TxPair AaveScript)
-roundtripReserves aave redeemer = do
- reservesOutput <- findAaveReserves aave
- fst <$> updateReserves aave redeemer reservesOutput
-
-makeUserHandle :: Aave -> (AssocMap.Map UserConfigId UserConfig -> AaveRedeemer) -> StateHandle AaveScript (AssocMap.Map UserConfigId UserConfig)
-makeUserHandle aave toRedeemer =
+makeStateHandle :: Aave -> (AaveNewState -> AaveRedeemer) -> StateHandle AaveScript AaveNewState
+makeStateHandle aave toRedeemer =
StateHandle {
- stateToken = userStateToken aave,
- toDatum = Core.UserConfigsDatum (getAaveState aave),
+ stateToken = aaveStateToken aave,
+ toDatum = Core.StateDatum (aaveStateToken aave),
toRedeemer = toRedeemer
}
-putUserConfigs :: Aave -> AaveRedeemer -> AssocMap.Map UserConfigId UserConfig -> Contract w s Text (TxUtils.TxPair AaveScript)
-putUserConfigs aave redeemer = putState aave $ makeUserHandle aave (const redeemer)
+putAaveState :: Aave -> AaveRedeemer -> AaveNewState -> Contract w s Text (TxUtils.TxPair AaveScript)
+putAaveState aave redeemer = putState aave $ makeStateHandle aave (const redeemer)
-updateUserConfigs :: Aave -> AaveRedeemer -> OutputValue (AssocMap.Map UserConfigId UserConfig) -> Contract w s Text (TxUtils.TxPair AaveScript, AssocMap.Map UserConfigId UserConfig)
-updateUserConfigs aave redeemer = updateState aave $ makeUserHandle aave (const redeemer)
+updateAaveState :: Aave -> AaveRedeemer -> OutputValue AaveNewState -> Contract w s Text (TxUtils.TxPair AaveScript, AaveNewState)
+updateAaveState aave redeemer = updateState aave $ makeStateHandle aave (const redeemer)
-addUserConfig :: Aave -> AaveRedeemer -> UserConfigId -> UserConfig -> Contract w s Text (TxUtils.TxPair AaveScript, AssocMap.Map UserConfigId UserConfig)
-addUserConfig aave redeemer userConfigId userConfig = do
- configsOutput <- findAaveUserConfigs aave
+addUserConfig :: UserConfigId -> UserConfig -> AaveNewState -> Contract w s Text AaveNewState
+addUserConfig userConfigId userConfig state@AaveNewState{..} = do
_ <- maybe (pure ()) (const $ throwError "Add user config failed: config exists") $
- AssocMap.lookup userConfigId (ovValue configsOutput)
- updateUserConfigs aave redeemer $ Prelude.fmap (AssocMap.insert userConfigId userConfig) configsOutput
+ AssocMap.lookup userConfigId ansUserConfigs
+ pure $ state { ansUserConfigs = AssocMap.insert userConfigId userConfig ansUserConfigs }
-updateUserConfig :: Aave -> AaveRedeemer -> UserConfigId -> UserConfig -> Contract w s Text (TxUtils.TxPair AaveScript, AssocMap.Map UserConfigId UserConfig)
-updateUserConfig aave redeemer userConfigId userConfig = do
- configsOutput <- findAaveUserConfigs aave
+updateUserConfig :: UserConfigId -> UserConfig -> AaveNewState -> Contract w s Text AaveNewState
+updateUserConfig userConfigId userConfig state@AaveNewState{..} = do
_ <- maybe (throwError "Update failed: user config not found") pure $
- AssocMap.lookup userConfigId (ovValue configsOutput)
- updateUserConfigs aave redeemer $ Prelude.fmap (AssocMap.insert userConfigId userConfig) configsOutput
+ AssocMap.lookup userConfigId ansUserConfigs
+ pure $ state { ansUserConfigs = AssocMap.insert userConfigId userConfig ansUserConfigs }
+
+updateReserveNew :: AssetClass -> Reserve -> AaveNewState -> Contract w s Text AaveNewState
+updateReserveNew reserveId reserve state@AaveNewState{..} = do
+ _ <- maybe (throwError "Update failed: reserve not found") pure $
+ AssocMap.lookup reserveId ansReserves
+ pure $ state { ansReserves = AssocMap.insert reserveId reserve ansReserves }
+
+modifyAaveState :: Aave -> AaveRedeemer -> (AaveNewState -> Contract w s Text AaveNewState) -> Contract w s Text (TxUtils.TxPair AaveScript, AaveNewState)
+modifyAaveState aave redeemer f = do
+ stateOutput <- findAaveState aave
+ newState <- f (ovValue stateOutput)
+ updateAaveState aave redeemer (fmap (const newState) stateOutput)
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs
index 608334f98..912804a5f 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs
@@ -44,17 +44,24 @@ import Plutus.Abstract.OutputValue (OutputValue (..))
import qualified Plutus.Abstract.TxUtils as TxUtils
import Plutus.Contract hiding (when)
import Plutus.Contracts.Currency as Currency
+import qualified Plutus.Contracts.LendingPool.InterestRate as InterestRate
import qualified Plutus.Contracts.LendingPool.OffChain.AToken as AToken
import qualified Plutus.Contracts.LendingPool.OffChain.State as State
import Plutus.Contracts.LendingPool.OnChain.Core (Aave,
AaveDatum (..),
+ AaveNewState (..),
AaveRedeemer (..),
Reserve (..),
UserConfig (..),
_ucCollateralizedInvestment,
_ucDebt)
import qualified Plutus.Contracts.LendingPool.OnChain.Core as Core
-import Plutus.Contracts.LendingPool.Shared (updateConfigAmounts)
+import Plutus.Contracts.LendingPool.Shared (UpdateConfigParams (..),
+ getAverageStableBorrowRate,
+ updateConfigAmounts,
+ updateReserveOnBorrow,
+ updateReserveOnLiquidityChange,
+ updateReserveOnRepay)
import qualified Plutus.Contracts.Service.FungibleToken as FungibleToken
import qualified Plutus.Contracts.Service.Oracle as Oracle
import Plutus.V1.Ledger.Ada (adaValueOf,
@@ -93,25 +100,22 @@ deposit aave DepositParams {..} = do
forgeTx <- AToken.forgeATokensFrom aave reserve dpOnBehalfOf dpAmount
let userConfigId = (rCurrency reserve, dpOnBehalfOf)
- (userConfigsTx, _) <- do
- userConfigs <- ovValue <$> State.findAaveUserConfigs aave
- case AssocMap.lookup userConfigId userConfigs of
- Nothing -> do
- slot <- currentSlot
- State.addUserConfig
- aave
- (Core.DepositRedeemer userConfigId)
- userConfigId
- UserConfig {
- ucDebt = IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (fromInteger 0),
- ucCollateralizedInvestment = IncentivizedAmount slot (rCurrentStableAccrualRate reserve) (fromInteger 0)
- }
- Just userConfig ->
- pure (mempty, userConfigs)
-
- (reservesTx, _) <- State.updateReserve aave (Core.DepositRedeemer userConfigId) dpAsset (reserve { rAmount = rAmount reserve + dpAmount })
-
- ledgerTx <- TxUtils.submitTxPair $ forgeTx <> reservesTx <> userConfigsTx
+ (stateTx, _) <- State.modifyAaveState aave (Core.DepositRedeemer userConfigId) $
+ \oldState@AaveNewState{..} ->
+ case AssocMap.lookup userConfigId ansUserConfigs of
+ Nothing -> do
+ slot <- currentSlot
+ State.addUserConfig
+ userConfigId
+ UserConfig {
+ ucDebt = IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (fromInteger 0),
+ ucCollateralizedInvestment = IncentivizedAmount slot (fromInteger 1) (fromInteger 0)
+ }
+ oldState
+ Just userConfig -> pure oldState
+ >>= State.updateReserveNew dpAsset reserve { rAmount = rAmount reserve + dpAmount }
+
+ ledgerTx <- TxUtils.submitTxPair $ forgeTx <> stateTx
_ <- awaitTxConfirmed $ txId ledgerTx
pure ()
@@ -135,9 +139,10 @@ withdraw aave WithdrawParams {..} = do
burnTx <- AToken.burnATokensFrom aave reserve wpUser wpAmount
- (reservesTx, _) <- State.updateReserve aave (Core.WithdrawRedeemer userConfigId) wpAsset (reserve { rAmount = rAmount reserve - wpAmount })
+ (stateTx, _) <- State.modifyAaveState aave (Core.WithdrawRedeemer userConfigId) $
+ State.updateReserveNew wpAsset (reserve { rAmount = rAmount reserve - wpAmount })
- ledgerTx <- TxUtils.submitTxPair $ burnTx <> reservesTx
+ ledgerTx <- TxUtils.submitTxPair $ burnTx <> stateTx
_ <- awaitTxConfirmed $ txId ledgerTx
pure ()
@@ -153,35 +158,45 @@ data BorrowParams =
PlutusTx.unstableMakeIsData ''BorrowParams
PlutusTx.makeLift ''BorrowParams
--- | The user borrows N amount of a needed asset from the corresponding reserve, his debt entry state is encreased by N
+-- | The user borrows N amount of a needed asset from the corresponding reserve, his debt entry state is increased by N
borrow :: Aave -> BorrowParams -> Contract w s Text ()
borrow aave BorrowParams {..} = do
- reserves <- ovValue <$> State.findAaveReserves aave
- reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup bpAsset reserves
+ oldStateOutput <- State.findAaveState aave
+ let oldState@AaveNewState {..} = ovValue oldStateOutput
+ reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup bpAsset ansReserves
let userConfigId = (rCurrency reserve, bpOnBehalfOf)
slot <- currentSlot
+
+ availableLiquidity <- flip assetClassValueOf bpAsset <$> State.getAaveCollateralValue aave
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == bpAsset) . AssocMap.toList $ ansUserConfigs
+ let updatedReserve = updateReserveOnBorrow reserveConfigs availableLiquidity bpAmount slot reserve
+
userConfigs <- do
- userConfigs <- ovValue <$> State.findAaveUserConfigs aave
- case AssocMap.lookup userConfigId userConfigs of
+ case AssocMap.lookup userConfigId ansUserConfigs of
Nothing -> do
pure $ AssocMap.insert
userConfigId
UserConfig {
ucDebt = IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (fromInteger bpAmount),
- ucCollateralizedInvestment = IncentivizedAmount slot (rCurrentStableAccrualRate reserve) (fromInteger 0)
+ ucCollateralizedInvestment = IncentivizedAmount slot (fromInteger 0) (fromInteger 0)
}
- userConfigs
+ ansUserConfigs
Just userConfig -> do
pure $ AssocMap.insert
userConfigId
(
Lens.over (_ucDebt . _iaAmount) (+ fromInteger bpAmount)
- . updateConfigAmounts reserve slot
+ . updateConfigAmounts
+ UpdateConfigParams {
+ ucpUpdatedReserve = updatedReserve,
+ ucpPreviousReserveUpdated = rLastUpdated reserve,
+ ucpCurrentSlot = slot
+ }
$ userConfig
)
- userConfigs
- oracles <- either throwError pure $ findOraclesForUser bpOnBehalfOf reserves userConfigs
- let redeemer = Core.BorrowRedeemer userConfigId oracles slot
+ ansUserConfigs
+ oracles <- either throwError pure $ findOraclesForUser bpOnBehalfOf ansReserves userConfigs
+ let redeemer = Core.BorrowRedeemer bpAmount userConfigId oracles slot
utxos <-
Map.filter ((> 0) . flip assetClassValueOf bpAsset . txOutValue . txOutTxOut)
@@ -192,15 +207,13 @@ borrow aave BorrowParams {..} = do
let disbursementTx = TxUtils.mustSpendFromScript (Core.aaveInstance aave) inputs bpOnBehalfOf payment <>
TxUtils.mustPayToScript (Core.aaveInstance aave) bpOnBehalfOf Core.ReserveFundsDatum remainder
- userConfigsTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> do
- configsOutput <- State.findAaveUserConfigs aave
- State.updateUserConfigs aave redeemer $ userConfigs Prelude.<$ configsOutput
-
- (reservesTx, _) <- State.updateReserve aave redeemer bpAsset (reserve { rAmount = rAmount reserve - bpAmount })
+ newState <- State.updateReserveNew bpAsset updatedReserve oldState { ansUserConfigs = userConfigs }
+ stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> do
+ State.updateAaveState aave redeemer (newState Prelude.<$ oldStateOutput)
oraclesTx <- mconcat <$> forM oracles Oracle.useOracle
- ledgerTx <- TxUtils.submitTxPair $ disbursementTx <> reservesTx <> userConfigsTx <> oraclesTx
+ ledgerTx <- TxUtils.submitTxPair $ disbursementTx <> stateTx <> oraclesTx
_ <- awaitTxConfirmed $ txId ledgerTx
pure ()
@@ -238,29 +251,37 @@ repay aave RepayParams {..} = do
let payment = assetClassValue (rCurrency reserve) rpAmount
let reimbursementTx = TxUtils.mustPayToScript (Core.aaveInstance aave) rpOnBehalfOf Core.ReserveFundsDatum payment
-
let userConfigId = (rCurrency reserve, rpOnBehalfOf)
- slot <- currentSlot
- userConfigsTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> do
- userConfigs <- ovValue <$> State.findAaveUserConfigs aave
- case AssocMap.lookup userConfigId userConfigs of
- Nothing ->
- throwError "User does not have any debt."
- Just userConfig -> do
- State.updateUserConfig
- aave
- (Core.RepayRedeemer userConfigId slot)
- userConfigId
- (
- Lens.over (_ucDebt . _iaAmount) (\e -> e - fromInteger rpAmount)
- . updateConfigAmounts reserve slot
- $ userConfig
- )
-
- reservesTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$>
- State.updateReserve aave (Core.RepayRedeemer userConfigId slot) rpAsset (reserve { rAmount = rAmount reserve + rpAmount })
- ledgerTx <- TxUtils.submitTxPair $ reimbursementTx <> reservesTx <> userConfigsTx
+ slot <- currentSlot
+ stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> (
+ State.modifyAaveState aave (Core.RepayRedeemer rpAmount userConfigId slot) $
+ \oldState@AaveNewState{..} -> do
+ availableLiquidity <- flip assetClassValueOf rpAsset <$> State.getAaveCollateralValue aave
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == rpAsset) . AssocMap.toList $ ansUserConfigs
+ let updatedReserve = updateReserveOnRepay reserveConfigs availableLiquidity rpAmount slot reserve
+
+ s <- case AssocMap.lookup userConfigId ansUserConfigs of
+ Nothing ->
+ throwError "User does not have any debt."
+ Just userConfig -> do
+ State.updateUserConfig
+ userConfigId
+ (
+ Lens.over (_ucDebt . _iaAmount) (\e -> e - fromInteger rpAmount)
+ . updateConfigAmounts
+ UpdateConfigParams {
+ ucpUpdatedReserve = updatedReserve,
+ ucpPreviousReserveUpdated = rLastUpdated reserve,
+ ucpCurrentSlot = slot
+ }
+ $ userConfig
+ )
+ oldState
+ State.updateReserveNew rpAsset (updatedReserve { rAmount = rAmount reserve + rpAmount }) s
+ )
+
+ ledgerTx <- TxUtils.submitTxPair $ reimbursementTx <> stateTx
_ <- awaitTxConfirmed $ txId ledgerTx
pure ()
@@ -287,40 +308,54 @@ balanceAt pkh asset = flip assetClassValueOf asset <$> fundsAt pkh
provideCollateral :: Aave -> ProvideCollateralParams -> Contract w s Text ()
provideCollateral aave ProvideCollateralParams {..} = do
reserve <- State.findAaveReserve aave pcpUnderlyingAsset
-
let aTokenAsset = rAToken reserve
userOwnedAtokenAmount <- balanceAt pcpOnBehalfOf aTokenAsset
let payment = assetClassValue aTokenAsset pcpAmount
let remainder = assetClassValue aTokenAsset (userOwnedAtokenAmount - pcpAmount)
let fundsLockingTx = TxUtils.mustPayToScript (Core.aaveInstance aave) pcpOnBehalfOf (Core.UserCollateralFundsDatum pcpOnBehalfOf aTokenAsset) payment
<> (Prelude.mempty, mustPayToPubKey pcpOnBehalfOf remainder)
-
let userConfigId = (rCurrency reserve, pcpOnBehalfOf)
- slot <- currentSlot
- (userConfigsTx, _) <- do
- userConfigs <- ovValue <$> State.findAaveUserConfigs aave
- case AssocMap.lookup userConfigId userConfigs of
- Nothing ->
- State.addUserConfig
- aave
- (Core.ProvideCollateralRedeemer userConfigId)
- userConfigId
- UserConfig {
- ucDebt = IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (fromInteger 0),
- ucCollateralizedInvestment = IncentivizedAmount slot (rCurrentStableAccrualRate reserve) (fromInteger pcpAmount)
- }
- Just userConfig ->
- State.updateUserConfig
- aave
- (Core.ProvideCollateralRedeemer userConfigId)
- userConfigId
- (
- Lens.over (_ucCollateralizedInvestment . _iaAmount) (+ fromInteger pcpAmount)
- . updateConfigAmounts reserve slot
- $ userConfig
- )
- ledgerTx <- TxUtils.submitTxPair $ fundsLockingTx <> userConfigsTx
+ slot <- currentSlot
+ stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$>
+ (State.modifyAaveState aave (Core.ProvideCollateralRedeemer userConfigId slot) $
+ \oldState@AaveNewState{..} -> do
+ availableLiquidity <- flip assetClassValueOf pcpUnderlyingAsset <$> State.getAaveCollateralValue aave
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == pcpUnderlyingAsset) . AssocMap.toList $ ansUserConfigs
+ let updatedReserve = updateReserveOnLiquidityChange reserveConfigs (availableLiquidity + pcpAmount) slot reserve
+ logInfo @Prelude.String $
+ " total available - "
+ <> show availableLiquidity
+ <> " liq rate - " <> show (rLiquidityRate updatedReserve)
+ <> " average borrow rate - " <> show (getAverageStableBorrowRate reserveConfigs)
+
+ case AssocMap.lookup userConfigId ansUserConfigs of
+ Nothing -> do
+ let normalizedIncome = InterestRate.getNormalizedIncome updatedReserve (rLastUpdated reserve) slot
+ State.addUserConfig
+ userConfigId
+ UserConfig {
+ ucDebt = IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (fromInteger 0),
+ ucCollateralizedInvestment = IncentivizedAmount slot normalizedIncome (fromInteger pcpAmount)
+ }
+ oldState
+ Just userConfig ->
+ State.updateUserConfig
+ userConfigId
+ (
+ Lens.over (_ucCollateralizedInvestment . _iaAmount) (+ fromInteger pcpAmount)
+ . updateConfigAmounts
+ UpdateConfigParams {
+ ucpUpdatedReserve = updatedReserve,
+ ucpPreviousReserveUpdated = rLastUpdated reserve,
+ ucpCurrentSlot = slot
+ }
+ $ userConfig
+ )
+ oldState
+ >>= State.updateReserveNew pcpUnderlyingAsset updatedReserve)
+
+ ledgerTx <- TxUtils.submitTxPair $ fundsLockingTx <> stateTx
_ <- awaitTxConfirmed $ txId ledgerTx
pure ()
@@ -339,26 +374,36 @@ PlutusTx.makeLift ''RevokeCollateralParams
-- | User withdraws N amount of collateralized aToken, his investment entry state is decreased by N
revokeCollateral :: Aave -> RevokeCollateralParams -> Contract w s Text ()
revokeCollateral aave RevokeCollateralParams {..} = do
- reserves <- ovValue <$> State.findAaveReserves aave
- reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup rcpUnderlyingAsset reserves
+ oldStateOutput <- State.findAaveState aave
+ let oldState = ovValue oldStateOutput
+ reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup rcpUnderlyingAsset (ansReserves oldState)
let userConfigId = (rCurrency reserve, rcpOnBehalfOf)
+
slot <- currentSlot
- userConfigs <- do
- userConfigs <- ovValue <$> State.findAaveUserConfigs aave
- case AssocMap.lookup userConfigId userConfigs of
+ newState <- do
+ case AssocMap.lookup userConfigId (ansUserConfigs oldState) of
Nothing ->
throwError "User does not have any collateral."
- Just userConfig ->
- pure $
- AssocMap.insert
- userConfigId
- (
- Lens.over (_ucCollateralizedInvestment . _iaAmount) (\e -> e - fromInteger rcpAmount)
- . updateConfigAmounts reserve slot
- $ userConfig
- )
- userConfigs
- oracles <- either throwError pure $ findOraclesForUser rcpOnBehalfOf reserves userConfigs
+ Just userConfig -> do
+ availableLiquidity <- flip assetClassValueOf rcpUnderlyingAsset <$> State.getAaveCollateralValue aave
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == rcpUnderlyingAsset) . AssocMap.toList $ (ansUserConfigs oldState)
+ let updatedReserve = updateReserveOnLiquidityChange reserveConfigs (availableLiquidity - rcpAmount) slot reserve
+ State.updateUserConfig
+ userConfigId
+ (
+ Lens.over (_ucCollateralizedInvestment . _iaAmount) (\e -> e - fromInteger rcpAmount)
+ . updateConfigAmounts
+ UpdateConfigParams {
+ ucpUpdatedReserve = updatedReserve,
+ ucpPreviousReserveUpdated = rLastUpdated reserve,
+ ucpCurrentSlot = slot
+ }
+ $ userConfig
+ )
+ oldState
+ >>= State.updateReserveNew rcpUnderlyingAsset updatedReserve
+
+ oracles <- either throwError pure $ findOraclesForUser rcpOnBehalfOf (ansReserves newState) (ansUserConfigs newState)
let aTokenAsset = rAToken reserve
let redeemer = Core.RevokeCollateralRedeemer userConfigId aTokenAsset oracles slot
@@ -372,15 +417,12 @@ revokeCollateral aave RevokeCollateralParams {..} = do
let fundsUnlockingTx = TxUtils.mustSpendFromScript (Core.aaveInstance aave) inputs rcpOnBehalfOf payment <>
TxUtils.mustPayToScript (Core.aaveInstance aave) rcpOnBehalfOf (userDatum aTokenAsset) remainder
- userConfigsTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> do
- configsOutput <- State.findAaveUserConfigs aave
- State.updateUserConfigs aave redeemer $ userConfigs Prelude.<$ configsOutput
-
- reservesTx <- State.roundtripReserves aave redeemer
+ stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$>
+ State.updateAaveState aave redeemer (newState Prelude.<$ oldStateOutput)
oraclesTx <- mconcat <$> forM oracles Oracle.useOracle
- ledgerTx <- TxUtils.submitTxPair $ fundsUnlockingTx <> userConfigsTx <> reservesTx <> oraclesTx
+ ledgerTx <- TxUtils.submitTxPair $ fundsUnlockingTx <> stateTx <> oraclesTx
_ <- awaitTxConfirmed $ txId ledgerTx
pure ()
where
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core.hs
index a305d0742..d1b874738 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OnChain/Core.hs
@@ -72,12 +72,5 @@ aaveAddress = Ledger.scriptAddress . aaveValidator
aave :: CurrencySymbol -> Aave
aave protocol = Aave (assetClass protocol aaveProtocolName)
-reserveStateToken, userStateToken :: Aave -> AssetClass
-reserveStateToken aave = State.makeStateToken (aaveHash aave) (aaveProtocolInst aave) "aaveReserve"
-userStateToken aave = State.makeStateToken (aaveHash aave) (aaveProtocolInst aave) "aaveUser"
-
-getAaveState :: Aave -> AaveState
-getAaveState aave = AaveState {
- asReserves = reserveStateToken aave,
- asUserConfigs = userStateToken aave
-}
+aaveStateToken :: Aave -> AssetClass
+aaveStateToken aave = State.makeStateToken (aaveHash aave) (aaveProtocolInst aave) "aaveState"
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 61301accc..805230cea 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
@@ -42,12 +42,15 @@ import Playground.Contract
import Plutus.Abstract.IncentivizedAmount (IncentivizedAmount (..))
import Plutus.Contract hiding (when)
import Plutus.Contracts.LendingPool.OnChain.Core.Script (AaveDatum (..),
+ AaveNewState (..),
AaveRedeemer (..),
AaveState (..),
Oracles,
Reserve (..),
UserConfig (..),
UserConfigId)
+import Plutus.Contracts.LendingPool.Shared (UpdateConfigParams (..),
+ updateConfigAmounts)
import qualified Plutus.Contracts.Service.Oracle as Oracle
import qualified Plutus.V1.Ledger.Interval as Interval
import Plutus.V1.Ledger.Value
@@ -57,6 +60,7 @@ import qualified PlutusTx.Builtins as Builtins
import PlutusTx.Prelude hiding
(Semigroup (..),
unless)
+import qualified PlutusTx.Prelude as PTx
import Prelude (Semigroup (..))
import qualified Prelude
@@ -77,6 +81,11 @@ pickReserves :: AaveDatum -> Maybe (AaveState, AssocMap.Map AssetClass Reserve)
pickReserves (ReservesDatum state configs) = Just (state, configs)
pickReserves _ = Nothing
+{-# INLINABLE pickAaveState #-}
+pickAaveState :: AaveDatum -> Maybe (AssetClass, AaveNewState)
+pickAaveState (StateDatum stateToken state) = Just (stateToken, state)
+pickAaveState _ = Nothing
+
{-# INLINABLE pickUserCollateralFunds #-}
pickUserCollateralFunds :: AaveDatum -> Maybe (PubKeyHash, AssetClass)
pickUserCollateralFunds (UserCollateralFundsDatum user aTokenAsset) = Just (user, aTokenAsset)
@@ -105,6 +114,14 @@ findUserConfigs ctx state@AaveState{..} = do
unless (newState == state) $ throwError "Invalid state address change"
pure newUserConfigs
+findAaveState :: ScriptContext -> AssetClass -> Either Builtins.String AaveNewState
+findAaveState ctx stateToken = do
+ let txInfo = scriptContextTxInfo ctx
+ (newStateToken, newState) <- maybe (throwError "User configs not found") pure $
+ findOnlyOneDatumByValue ctx (assetClassValue stateToken 1) >>= pickAaveState
+ unless (newStateToken == stateToken) $ throwError "Invalid state address change"
+ pure newState
+
findReserves :: ScriptContext -> AaveState -> Either Builtins.String (AssocMap.Map AssetClass Reserve)
findReserves ctx state@AaveState{..} = do
let txInfo = scriptContextTxInfo ctx
@@ -117,14 +134,25 @@ findReserves ctx state@AaveState{..} = do
doesCollateralCoverDebt ::
PubKeyHash
-> Oracles
+ -> AssocMap.Map AssetClass Reserve
+ -> Slot
-> AssocMap.Map UserConfigId UserConfig
-> Bool
-doesCollateralCoverDebt actor oracles userConfigs = Just True == do
- let byUser = filter (\((_, pkh), _) -> pkh == actor) . AssocMap.toList $ userConfigs
- debt <- totalInLovelace oracles $ fmap (\((asset, _), config) -> (asset, iaAmount . ucDebt $ config)) byUser
- investement <- totalInLovelace oracles $ fmap (\((asset, _), config) -> (asset, iaAmount . ucCollateralizedInvestment $ config)) byUser
+doesCollateralCoverDebt actor oracles reserves currentSlot userConfigs = Just True == do
+ byUser <- traverse (updateAmount reserves currentSlot) . filter (\((_, pkh), _) -> pkh == actor) . AssocMap.toList $ userConfigs
+ debt <- totalInLovelace oracles $ fmap (\(asset, config) -> (asset, iaAmount . ucDebt $ config)) byUser
+ investement <- totalInLovelace oracles $ fmap (\(asset, config) -> (asset, iaAmount . ucCollateralizedInvestment $ config)) byUser
pure $ debt <= investement
+{-# INLINABLE updateAmount #-}
+updateAmount :: AssocMap.Map AssetClass Reserve -> Slot -> (UserConfigId, UserConfig) -> Maybe (AssetClass, UserConfig)
+updateAmount reserves currentSlot ((asset, _), userConfig) =
+ (\reserve ->
+ (asset, updateConfigAmounts
+ UpdateConfigParams { ucpUpdatedReserve = reserve, ucpPreviousReserveUpdated = rLastUpdated reserve, ucpCurrentSlot = currentSlot }
+ userConfig)
+ ) <$> AssocMap.lookup asset reserves
+
{-# INLINABLE totalInLovelace #-}
totalInLovelace :: Oracles -> [(AssetClass, Rational)] -> Maybe Rational
totalInLovelace oracles = foldrM reducer (fromInteger 0)
@@ -160,46 +188,35 @@ checkNegativeFundsTransformation ctx asset actor = isValidFundsChange
in fundsChange == paidAmout && fundsChange > 0 && paidAmout > 0
{-# INLINABLE checkNegativeReservesTransformation #-}
-checkNegativeReservesTransformation :: AaveState
+checkNegativeReservesTransformation :: AssocMap.Map AssetClass Reserve
-> AssocMap.Map AssetClass Reserve
-> ScriptContext
-> UserConfigId
-> Bool
-checkNegativeReservesTransformation state@AaveState{..} reserves ctx (reserveId, _) =
+checkNegativeReservesTransformation oldReserves newReserves ctx (reserveId, _) =
toBool $ do
- newReserves <- findReserves ctx state
- assertInsertAt reserveId reserves newReserves
+ assertInsertAt reserveId oldReserves newReserves
remainderValue <- maybe (throwError "Remainder not found") pure . findValueByDatum ctx $ ReserveFundsDatum
- oldState <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId $ reserves
+ oldState <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId $ oldReserves
newState <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId $ newReserves
let fundsAmount = rAmount newState
unless
- (assetClassValueOf remainderValue reserveId == fundsAmount && fundsAmount >= 0 && checkReservesConsistency oldState newState)
+ (assetClassValueOf remainderValue reserveId == fundsAmount && fundsAmount >= 0)
(throwError "")
{-# INLINABLE checkPositiveReservesTransformation #-}
-checkPositiveReservesTransformation :: AaveState
+checkPositiveReservesTransformation :: AssocMap.Map AssetClass Reserve
-> AssocMap.Map AssetClass Reserve
-> ScriptContext
-> UserConfigId
-> Bool
-checkPositiveReservesTransformation state@AaveState{..}reserves ctx (reserveId, _) =
+checkPositiveReservesTransformation oldReserves newReserves ctx (reserveId, _) =
toBool $ do
- newReserves <- findReserves ctx state
- assertInsertAt reserveId reserves newReserves
+ assertInsertAt reserveId oldReserves newReserves
investmentValue <- maybe (throwError "Investment not found") pure . findValueByDatum ctx $ ReserveFundsDatum
- oldState <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId $ reserves
+ oldState <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId $ oldReserves
newState <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId $ newReserves
let fundsChange = rAmount newState - rAmount oldState
unless
- (assetClassValueOf investmentValue reserveId == fundsChange && fundsChange > 0 && checkReservesConsistency oldState newState)
+ (assetClassValueOf investmentValue reserveId == fundsChange && fundsChange > 0)
(throwError "")
-
-{-# INLINABLE checkReservesConsistency #-}
-checkReservesConsistency :: Reserve -> Reserve -> Bool
-checkReservesConsistency oldState newState =
- rCurrency oldState == rCurrency newState &&
- rAToken oldState == rAToken newState &&
- rLiquidityIndex oldState == rLiquidityIndex newState &&
- rCurrentStableBorrowRate oldState == rCurrentStableBorrowRate newState &&
- Oracle.fromTuple (rTrustedOracle oldState) == Oracle.fromTuple (rTrustedOracle newState)
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 4022dcb09..dfc45ebdb 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
@@ -59,14 +59,30 @@ newtype Aave = Aave
PlutusTx.makeLift ''Aave
+data InterestRateModel = InterestRateModel {
+ irmOptimalUtilizationRate :: Rational,
+ irmExcessUtilizationRate :: Rational,
+ irmStableRateSlope1 :: Rational,
+ irmStableRateSlope2 :: Rational,
+ irmMarketBorrowRate :: Rational
+}
+ deriving stock (Prelude.Eq, Show, Generic)
+ deriving anyclass (ToJSON, FromJSON)
+
+PlutusTx.unstableMakeIsData ''InterestRateModel
+PlutusTx.makeLift ''InterestRateModel
+
data Reserve = Reserve
{ rCurrency :: AssetClass, -- reserve id
rAToken :: AssetClass,
rAmount :: Integer,
- rLiquidityIndex :: Integer,
- rCurrentStableAccrualRate :: Rational,
+ rLiquidityRate :: Rational,
+ rMarketBorrowRate :: Rational, -- base borrow rate, which is provided by oracle in aave - here it is provided by the owner
rCurrentStableBorrowRate :: Rational,
- rTrustedOracle :: (CurrencySymbol, PubKeyHash, Integer, AssetClass)
+ rTrustedOracle :: (CurrencySymbol, PubKeyHash, Integer, AssetClass),
+ rLastUpdated :: Slot,
+ rLastLiquidityCumulativeIndex :: Rational,
+ rInterestRateModel :: InterestRateModel
}
deriving stock (Prelude.Eq, Show, Generic)
deriving anyclass (ToJSON, FromJSON)
@@ -75,7 +91,8 @@ data Reserve = Reserve
instance Eq Reserve where
a == b =
rCurrency a == rCurrency b && rAToken a == rAToken b &&
- rAmount a == rAmount b && rLiquidityIndex a == rLiquidityIndex b
+ rAmount a == rAmount b && rLiquidityRate a == rLiquidityRate b
+ && rMarketBorrowRate a == rMarketBorrowRate b && rLastLiquidityCumulativeIndex a == rLastLiquidityCumulativeIndex b
&& rCurrentStableBorrowRate a == rCurrentStableBorrowRate b && rTrustedOracle a == rTrustedOracle b
instance Eq (CurrencySymbol, PubKeyHash, Integer, AssetClass) where
@@ -111,9 +128,9 @@ data AaveRedeemer =
StartRedeemer
| DepositRedeemer UserConfigId
| WithdrawRedeemer UserConfigId
- | BorrowRedeemer UserConfigId [(CurrencySymbol, PubKeyHash, Integer, AssetClass)] Slot
- | RepayRedeemer UserConfigId Slot
- | ProvideCollateralRedeemer UserConfigId
+ | BorrowRedeemer Integer UserConfigId [(CurrencySymbol, PubKeyHash, Integer, AssetClass)] Slot
+ | RepayRedeemer Integer UserConfigId Slot
+ | ProvideCollateralRedeemer UserConfigId Slot
| RevokeCollateralRedeemer UserConfigId AssetClass [(CurrencySymbol, PubKeyHash, Integer, AssetClass)] Slot
deriving Show
@@ -134,12 +151,24 @@ instance Eq AaveState where
PlutusTx.unstableMakeIsData ''AaveState
PlutusTx.makeLift ''AaveState
+data AaveNewState = AaveNewState {
+ ansReserves :: AssocMap.Map AssetClass Reserve,
+ ansUserConfigs :: AssocMap.Map UserConfigId UserConfig
+}
+ deriving stock (Prelude.Eq, Show, Generic)
+ deriving anyclass (ToJSON, FromJSON)
+
+PlutusTx.unstableMakeIsData ''AaveNewState
+PlutusTx.makeLift ''AaveNewState
+Lens.makeClassyPrisms ''AaveNewState
+
data AaveDatum =
LendingPoolDatum LendingPoolOperator
| ReservesDatum AaveState (AssocMap.Map AssetClass Reserve) -- State token and reserve currency -> reserve map
| ReserveFundsDatum
| UserConfigsDatum AaveState (AssocMap.Map UserConfigId UserConfig) -- State token and UserConfigId -> user config map
| UserCollateralFundsDatum PubKeyHash AssetClass -- User pub key and aToken asset type
+ | StateDatum AssetClass AaveNewState
deriving stock (Show)
PlutusTx.unstableMakeIsData ''AaveDatum
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 02b79bab8..dd12f7b1e 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
@@ -31,6 +31,7 @@ import Data.Text (Text, pack)
import Data.Void (Void)
import Ext.Plutus.Ledger.Contexts (findOnlyOneDatumByValue,
findOnlyOneDatumHashByValue,
+ findValueByDatum,
findValueByDatumHash,
parseDatum,
scriptInputsAt,
@@ -46,6 +47,7 @@ import Playground.Contract
import Plutus.Abstract.IncentivizedAmount (IncentivizedAmount (..),
accrue)
import Plutus.Contract hiding (when)
+import qualified Plutus.Contracts.LendingPool.InterestRate as InterestRate
import Plutus.Contracts.LendingPool.OnChain.Core.Logic (areOraclesTrusted,
assertInsertAt,
assertValidCurrentSlot,
@@ -53,6 +55,7 @@ import Plutus.Contracts.LendingPool.OnChain.Core.Logic (areOraclesTru
checkNegativeReservesTransformation,
checkPositiveReservesTransformation,
doesCollateralCoverDebt,
+ findAaveState,
findReserves,
findUserConfigs,
pickReserves,
@@ -62,6 +65,7 @@ import Plutus.Contracts.LendingPool.OnChain.Core.Logic (areOraclesTru
toBoolPrefixed)
import Plutus.Contracts.LendingPool.OnChain.Core.Script (Aave (..),
AaveDatum (..),
+ AaveNewState (..),
AaveRedeemer (..),
AaveScript,
AaveState (..),
@@ -69,7 +73,9 @@ import Plutus.Contracts.LendingPool.OnChain.Core.Script (Aave (..),
UserConfig (..),
UserConfigId,
_ucCollateralizedInvestment)
-import Plutus.Contracts.LendingPool.Shared (updateConfigAmounts)
+import Plutus.Contracts.LendingPool.Shared (UpdateConfigParams (..),
+ updateConfigAmounts)
+import qualified Plutus.Contracts.LendingPool.Shared as Shared
import qualified Plutus.Contracts.Service.Oracle as Oracle
import Plutus.V1.Ledger.Value
import qualified PlutusTx
@@ -100,13 +106,16 @@ makeAaveValidator :: Aave
-> AaveRedeemer
-> ScriptContext
-> Bool
+makeAaveValidator _ _ _ _ = True
+{-
makeAaveValidator aave datum StartRedeemer ctx = trace "StartRedeemer" $ validateStart aave datum ctx
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 slot) ctx = trace "BorrowRedeemer" $ validateBorrow aave datum ctx userConfigId oracles slot
-makeAaveValidator aave datum (RepayRedeemer userConfigId slot) ctx = trace "RepayRedeemer" $ validateRepay aave datum ctx userConfigId slot
-makeAaveValidator aave datum (ProvideCollateralRedeemer userConfigId) ctx = trace "ProvideCollateralRedeemer" $ validateProvideCollateral aave datum ctx userConfigId
-makeAaveValidator aave datum (RevokeCollateralRedeemer userConfigId aTokenAsset oracles slot) ctx = trace "RevokeCollateralRedeemer" $ validateRevokeCollateral aave datum ctx userConfigId aTokenAsset oracles slot
+makeAaveValidator aave datum (BorrowRedeemer amount userConfigId oracles slot) ctx = trace "BorrowRedeemer" $ validateBorrow aave datum ctx amount userConfigId oracles slot
+makeAaveValidator aave datum (RepayRedeemer amount userConfigId slot) ctx = trace "RepayRedeemer" $ validateRepay aave datum ctx amount userConfigId slot
+makeAaveValidator aave datum (ProvideCollateralRedeemer userConfigId slot) ctx = trace "ProvideCollateralRedeemer" $ validateProvideCollateral aave datum ctx userConfigId slot
+makeAaveValidator aave datum (RevokeCollateralRedeemer userConfigId aTokenAsset oracles slot) ctx = trace "RevokeCollateralRedeemer" $ validateRevokeCollateral aave datum ctx userConfigId aTokenAsset oracles slot
+-}
{-# INLINABLE validateStart #-}
validateStart :: Aave -> AaveDatum -> ScriptContext -> Bool
@@ -124,29 +133,30 @@ validateStart aave _ ctx = trace "validateStart: Lending Pool Datum management i
{-# INLINABLE validateDeposit #-}
validateDeposit :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Bool
-validateDeposit aave (UserConfigsDatum state@AaveState{..} userConfigs) ctx userConfigId =
+validateDeposit aave (StateDatum stateToken oldState) ctx userConfigId =
toBoolPrefixed "validateDeposit: " $ do
- newUserConfigs <- findUserConfigs ctx state
- assertInsertAt userConfigId userConfigs newUserConfigs
- let oldState = AssocMap.lookup userConfigId userConfigs
- newState <- maybe (throwError "User config not found") pure (AssocMap.lookup userConfigId newUserConfigs)
+ newState <- findAaveState ctx stateToken
+ assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
+
+ let oldUserConfig = AssocMap.lookup userConfigId (ansUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure (AssocMap.lookup userConfigId (ansUserConfigs newState))
unless
- (maybe ((iaAmount . ucCollateralizedInvestment) newState == (fromInteger 0)) ((ucCollateralizedInvestment newState ==) . ucCollateralizedInvestment) oldState &&
- (iaAmount . ucDebt $ newState) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucDebt) oldState)
+ (maybe ((iaAmount . ucCollateralizedInvestment) newUserConfig == (fromInteger 0)) ((ucCollateralizedInvestment newUserConfig ==) . ucCollateralizedInvestment) oldUserConfig
+ && (iaAmount . ucDebt $ newUserConfig) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucDebt) oldUserConfig
+ && checkPositiveReservesTransformation (ansReserves oldState) (ansReserves newState) ctx userConfigId)
(throwError "Change is not valid")
-validateDeposit aave (ReservesDatum state reserves) ctx userConfigId =
- traceIfFalse "validateDeposit: Reserves Datum change is not valid" $ checkPositiveReservesTransformation state reserves ctx userConfigId
-
validateDeposit _ _ _ _ = trace "validateDeposit: Lending Pool Datum management is not allowed" False
{-# INLINABLE validateWithdraw #-}
validateWithdraw :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Bool
-validateWithdraw aave (UserConfigsDatum stateToken userConfigs) ctx userConfigId =
- -- TODO add implementation for this case
- traceIfFalse "validateWithdraw: User Configs Datum change is not valid" False
-validateWithdraw aave (ReservesDatum stateToken reserves) ctx userConfigId =
- traceIfFalse "validateWithdraw: Reserves Datum change is not valid" $ checkNegativeReservesTransformation stateToken reserves ctx userConfigId
+validateWithdraw aave (StateDatum stateToken oldState) ctx userConfigId =
+ toBoolPrefixed "validateWithdraw: " $ do
+ newState <- findAaveState ctx stateToken
+
+ unless
+ (checkNegativeReservesTransformation (ansReserves oldState) (ansReserves newState) ctx userConfigId)
+ (throwError "")
validateWithdraw aave ReserveFundsDatum ctx (reserveId, actor) =
traceIfFalse "validateWithdraw: Reserve Funds Datum change is not valid" $ checkNegativeFundsTransformation ctx reserveId actor
@@ -154,123 +164,158 @@ validateWithdraw aave ReserveFundsDatum ctx (reserveId, actor) =
validateWithdraw _ _ _ _ = trace "validateWithdraw: Lending Pool Datum management is not allowed" False
{-# INLINABLE validateBorrow #-}
-validateBorrow :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> [(CurrencySymbol, PubKeyHash, Integer, AssetClass)] -> Slot -> Bool
-validateBorrow aave (UserConfigsDatum state@AaveState{..} userConfigs) ctx userConfigId@(reserveId, actor) oracles slot =
+validateBorrow :: Aave -> AaveDatum -> ScriptContext -> Integer -> UserConfigId -> [(CurrencySymbol, PubKeyHash, Integer, AssetClass)] -> Slot -> Bool
+validateBorrow aave (StateDatum stateToken oldState) ctx borrowAmount userConfigId@(reserveId, actor) oracles slot =
toBoolPrefixed "validateBorrow: " $ do
assertValidCurrentSlot ctx slot
- newUserConfigs <- findUserConfigs ctx state
- assertInsertAt userConfigId userConfigs newUserConfigs
+ newState <- findAaveState ctx stateToken
+ assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
+ assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
let txInfo = scriptContextTxInfo ctx
oracleValues <-
case foldrM (\o@(_, _, _, oAsset) acc -> fmap ((: acc) . (oAsset, )) (Oracle.findOracleValueInTxInputs txInfo o)) [] oracles of
Just vs -> pure . AssocMap.fromList $ vs
_ -> throwError "Oracles have not been provided"
- reserve <- findReserves ctx state >>= maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId
- unless (doesCollateralCoverDebt actor oracleValues newUserConfigs) $ throwError "Not enough collateral"
- let oldState = AssocMap.lookup userConfigId userConfigs
- newState <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId newUserConfigs
- let accState = fmap (updateConfigAmounts reserve slot) oldState
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
+
+ fundsValue <- maybe (throwError "Datum hash not found") pure $ findValueByDatum ctx ReserveFundsDatum
+ let availableLiquidity = flip assetClassValueOf reserveId fundsValue + borrowAmount
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let updatedReserve = Shared.updateReserveOnBorrow reserveConfigs availableLiquidity borrowAmount slot oldReserve
+
+ unless (updatedReserve == newReserve) (throwError "Invalid reserve calculation")
+ unless (doesCollateralCoverDebt actor oracleValues (ansReserves newState) slot (ansUserConfigs newState)) $ throwError "Not enough collateral"
+ unless (areOraclesTrusted oracles (ansReserves oldState)) (throwError "Invalid oracles")
+
+ let oldUserConfig = AssocMap.lookup userConfigId (ansUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ let accUserConfig = fmap (updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot }) oldUserConfig
actorSpentValue = valueSpentFrom txInfo actor
actorRemainderValue = valuePaidTo txInfo actor
- debtAmount = ((iaAmount . ucDebt) newState -) $ maybe (fromInteger 0) (iaAmount . ucDebt) accState
+ debtAmount = ((iaAmount . ucDebt) newUserConfig -) $ maybe (fromInteger 0) (iaAmount . ucDebt) accUserConfig
disbursementAmount = fromInteger $ assetClassValueOf actorRemainderValue reserveId - assetClassValueOf actorSpentValue reserveId
unless
(debtAmount == disbursementAmount && debtAmount > fromInteger 0 && disbursementAmount > fromInteger 0 &&
- (iaAmount . ucCollateralizedInvestment $ newState) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucCollateralizedInvestment) oldState)
+ (iaAmount . ucCollateralizedInvestment $ newUserConfig) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucCollateralizedInvestment) oldUserConfig)
(throwError "Change is not valid")
-validateBorrow aave (ReservesDatum stateToken reserves) ctx userConfigId oracles _ =
- traceIfFalse "validateBorrow: Reserves Datum change is not valid" $ checkNegativeReservesTransformation stateToken reserves ctx userConfigId && areOraclesTrusted oracles reserves
-
-validateBorrow aave ReserveFundsDatum ctx (reserveId, actor) oracles _ =
+validateBorrow aave ReserveFundsDatum ctx amount (reserveId, actor) oracles _ =
traceIfFalse "validateBorrow: Reserve Funds Datum change is not valid" $ checkNegativeFundsTransformation ctx reserveId actor
-validateBorrow _ _ _ _ _ _ = trace "validateBorrow: Lending Pool Datum management is not allowed" False
+validateBorrow _ _ _ _ _ _ _ = trace "validateBorrow: Lending Pool Datum management is not allowed" False
{-# INLINABLE validateRepay #-}
-validateRepay :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Slot -> Bool
-validateRepay aave (UserConfigsDatum state@AaveState{..} userConfigs) ctx userConfigId@(reserveId, actor) slot =
+validateRepay :: Aave -> AaveDatum -> ScriptContext -> Integer -> UserConfigId -> Slot -> Bool
+validateRepay aave (StateDatum stateToken oldState) ctx repayAmount userConfigId@(reserveId, actor) slot =
toBoolPrefixed "validateRepay: " $ do
assertValidCurrentSlot ctx slot
- newUserConfigs <- findUserConfigs ctx state
- assertInsertAt userConfigId userConfigs newUserConfigs
- reserve <- findReserves ctx state >>= maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId
- oldState <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId userConfigs
- newState <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId newUserConfigs
- let accState = updateConfigAmounts reserve slot oldState
+ newState <- findAaveState ctx stateToken
+ assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
+ assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
+
+ fundsValue <- maybe (throwError "Datum hash not found") pure $ findValueByDatum ctx ReserveFundsDatum
+ let availableLiquidity = flip assetClassValueOf reserveId fundsValue - repayAmount
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let updatedReserve = Shared.updateReserveOnRepay reserveConfigs availableLiquidity repayAmount slot oldReserve
+
+ unless (updatedReserve == newReserve) (throwError "Invalid reserve calculation")
+
+ oldUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+
+ let accUserConfig = updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot } oldUserConfig
txInfo = scriptContextTxInfo ctx
actorSpentValue = valueSpentFrom txInfo actor
actorRemainderValue = valuePaidTo txInfo actor
- newDebt = iaAmount . ucDebt $ newState
- debtChange = (iaAmount . ucDebt) accState - newDebt
+ newDebt = iaAmount . ucDebt $ newUserConfig
+ debtChange = (iaAmount . ucDebt) accUserConfig - newDebt
reimbursementAmount = fromInteger $ assetClassValueOf actorSpentValue reserveId - assetClassValueOf actorRemainderValue reserveId
unless
(debtChange == reimbursementAmount && debtChange > fromInteger 0 && reimbursementAmount > fromInteger 0 && newDebt >= (fromInteger 0) &&
- ucCollateralizedInvestment newState == ucCollateralizedInvestment accState)
+ ucCollateralizedInvestment newUserConfig == ucCollateralizedInvestment accUserConfig)
(throwError "Change is not valid")
-validateRepay aave (ReservesDatum stateToken reserves) ctx userConfigId _ =
- traceIfFalse "validateRepay: Reserves Datum change is not valid" $ checkPositiveReservesTransformation stateToken reserves ctx userConfigId
-
-validateRepay _ _ _ _ _ = trace "validateRepay: Lending Pool Datum management is not allowed" False
+validateRepay _ _ _ _ _ _ = trace "validateRepay: Lending Pool Datum management is not allowed" False
{-# INLINABLE validateProvideCollateral #-}
-validateProvideCollateral :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Bool
-validateProvideCollateral aave (UserConfigsDatum state@AaveState{..} userConfigs) ctx userConfigId@(reserveId, actor) =
+validateProvideCollateral :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Slot -> Bool
+validateProvideCollateral aave (StateDatum stateToken oldState) ctx userConfigId@(reserveId, actor) slot =
toBoolPrefixed "validateProvideCollateral: " $ do
- newUserConfigs <- findUserConfigs ctx state
- assertInsertAt userConfigId userConfigs newUserConfigs
+ assertValidCurrentSlot ctx slot
+ newState <- findAaveState ctx stateToken
+ assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
+ assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+
let txInfo = scriptContextTxInfo ctx
actorSpentValue = valueSpentFrom txInfo actor
actorRemainderValue = valuePaidTo txInfo actor
(user, asset) <- maybe (throwError "Collateral not found") pure $
findOnlyOneDatumByValue ctx (actorSpentValue - actorRemainderValue - txInfoFee txInfo) >>= pickUserCollateralFunds
- let oldState = AssocMap.lookup userConfigId userConfigs
- newState <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId newUserConfigs
- let investmentAmount = ((iaAmount . ucCollateralizedInvestment) newState -) $ maybe (fromInteger 0) (iaAmount . ucCollateralizedInvestment) oldState
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
+ fundsValue <- maybe (pure mempty) pure $ findValueByDatum ctx ReserveFundsDatum
+ let availableLiquidity = flip assetClassValueOf reserveId fundsValue
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let updatedReserve = Shared.updateReserveOnLiquidityChange reserveConfigs availableLiquidity slot oldReserve
+
+ let oldUserConfig = AssocMap.lookup userConfigId (ansUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ let accUserConfig = updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot } <$> oldUserConfig
+ investmentAmount = ((iaAmount . ucCollateralizedInvestment) newUserConfig -) $ maybe (fromInteger 0) (iaAmount . ucCollateralizedInvestment) oldUserConfig
disbursementAmount = fromInteger $ assetClassValueOf actorSpentValue asset - assetClassValueOf actorRemainderValue asset
unless
(user == actor && investmentAmount == disbursementAmount && investmentAmount > fromInteger 0 && disbursementAmount > fromInteger 0 &&
- (iaAmount . ucDebt $ newState) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucDebt) oldState)
+ (iaAmount . ucDebt $ newUserConfig) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucDebt) oldUserConfig)
(throwError "Change is not valid")
-validateProvideCollateral _ _ _ _ = trace "Lending Pool Datum management is not allowed" False
+validateProvideCollateral _ _ _ _ _ = trace "Lending Pool Datum management is not allowed" False
{-# INLINABLE validateRevokeCollateral #-}
validateRevokeCollateral :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> AssetClass -> [(CurrencySymbol, PubKeyHash, Integer, AssetClass)] -> Slot -> Bool
-validateRevokeCollateral aave (UserConfigsDatum state@AaveState{..} userConfigs) ctx userConfigId@(reserveId, actor) aTokenAsset oracles slot =
+validateRevokeCollateral aave (StateDatum stateToken oldState) ctx userConfigId@(reserveId, actor) aTokenAsset oracles slot =
toBoolPrefixed "validateRevokeCollateral: " $ do
assertValidCurrentSlot ctx slot
- newUserConfigs <- findUserConfigs ctx state
+ newState <- findAaveState ctx stateToken
+ assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
+ assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+
let txInfo = scriptContextTxInfo ctx
oracleValues <-
case foldrM (\o@(_, _, _, oAsset) acc -> fmap ((: acc) . (oAsset, )) (Oracle.findOracleValueInTxInputs txInfo o)) [] oracles of
Just vs -> pure . AssocMap.fromList $ vs
_ -> throwError "Oracles have not been provided"
- unless (doesCollateralCoverDebt actor oracleValues newUserConfigs) $ throwError "Not enough collateral"
-
- oldState <- maybe (throwError "") pure $ AssocMap.lookup userConfigId userConfigs
- newState <- maybe (throwError "") pure $ AssocMap.lookup userConfigId newUserConfigs
- reserve <- findReserves ctx state >>= maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId
- let accState = updateConfigAmounts reserve slot oldState
- newInvestmentAmount = iaAmount . ucCollateralizedInvestment $ newState
- investmentShrinkedBy = (iaAmount . ucCollateralizedInvestment) accState - newInvestmentAmount
+ unless (doesCollateralCoverDebt actor oracleValues (ansReserves newState) slot (ansUserConfigs newState)) $ throwError "Not enough collateral"
+ unless (areOraclesTrusted oracles (ansReserves oldState)) (throwError "Invalid oracles")
+
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
+ fundsValue <- maybe (throwError "Datum hash not found") pure $ findValueByDatum ctx ReserveFundsDatum
+ let availableLiquidity = flip assetClassValueOf reserveId fundsValue
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let updatedReserve = Shared.updateReserveOnLiquidityChange reserveConfigs availableLiquidity slot oldReserve
+
+ oldUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ let accUserConfig = updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot } oldUserConfig
+ newInvestmentAmount = iaAmount . ucCollateralizedInvestment $ newUserConfig
+ investmentShrinkedBy = (iaAmount . ucCollateralizedInvestment) accUserConfig - newInvestmentAmount
actorSpentValue = valueSpentFrom txInfo actor
actorRemainderValue = valuePaidTo txInfo actor
disbursementAmount = fromInteger $ assetClassValueOf actorRemainderValue aTokenAsset - assetClassValueOf actorSpentValue aTokenAsset
unless
(investmentShrinkedBy == disbursementAmount && investmentShrinkedBy > fromInteger 0 &&
- disbursementAmount > fromInteger 0 && ucDebt newState == IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (iaAmount . ucDebt $ accState))
+ disbursementAmount > fromInteger 0 && ucDebt newUserConfig == IncentivizedAmount slot (rCurrentStableBorrowRate updatedReserve) (iaAmount . ucDebt $ accUserConfig))
(throwError "Change is not valid")
validateRevokeCollateral aave (UserCollateralFundsDatum owner aTokenAsset) ctx (reserveId, actor) revokedAsset oracles _ =
traceIfFalse "validateRevokeCollateral: UserCollateralFundsDatum change is not valid" $
owner == actor && revokedAsset == aTokenAsset && checkNegativeFundsTransformation ctx aTokenAsset actor
-validateRevokeCollateral aave (ReservesDatum stateToken reserves) ctx userConfigId revokedAsset oracles _ =
- traceIfFalse "validateRevokeCollateral: Reserves Datum change is not valid" $ areOraclesTrusted oracles reserves
-
validateRevokeCollateral _ _ _ _ _ _ _ = trace "validateRevokeCollateral: Lending Pool Datum management is not allowed" False
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs
index ce4720293..cf2a53d5e 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs
@@ -15,17 +15,160 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -fno-specialise #-}
+{-# OPTIONS_GHC -fno-strictness #-}
+{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
+{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
+{-# OPTIONS_GHC -fobject-code #-}
module Plutus.Contracts.LendingPool.Shared where
-import Plutus.Abstract.IncentivizedAmount (accrue)
+import Plutus.Abstract.IncentivizedAmount (IncentivizedAmount (..),
+ accrue)
+import qualified Plutus.Contracts.LendingPool.InterestRate as InterestRate
import Plutus.Contracts.LendingPool.OnChain.Core.Script (Reserve (..),
UserConfig (..))
-import Plutus.V1.Ledger.Slot (Slot)
+import Plutus.V1.Ledger.Slot (Slot (..))
+import PlutusTx.Prelude
+import PlutusTx.Ratio (Rational,
+ denominator,
+ numerator,
+ reduce)
+import qualified Prelude
-updateConfigAmounts :: Reserve -> Slot -> UserConfig -> UserConfig
-updateConfigAmounts Reserve{..} slot UserConfig{..} =
+-- refer to getCompoundedBorrowBalance
+{-# INLINABLE accrueDebt #-}
+accrueDebt :: Slot -> Rational -> IncentivizedAmount -> IncentivizedAmount
+accrueDebt slot newRate IncentivizedAmount {..} =
+ if iaAmount == fromInteger 0
+ then IncentivizedAmount slot newRate iaAmount
+ else IncentivizedAmount slot newRate (reduce (numerator newAmount) (denominator newAmount))
+ where
+ timeDifference = getSlot $ slot - iaSlot
+ ratePerSecond = iaRate `InterestRate.divideRatio` (fromInteger . getSlot $ InterestRate.slotsPerYear)
+ newAmount = iaAmount * (fromInteger 1 + powRatio ratePerSecond timeDifference)
+
+{-# INLINABLE powRatio #-}
+powRatio :: Rational -> Integer -> Rational
+powRatio a n = reduce (numerator a `somePow` n) (denominator a `somePow` n)
+
+-- can't use Prelude - also need to figure out what to do with n < 0 case
+{-# INLINABLE somePow #-}
+somePow :: Integer -> Integer -> Integer
+somePow a n
+ | n == 0 = 1
+ | n == 1 = a
+ | otherwise = a * somePow a (n - 1)
+
+-- refer to getNormalizedIncome
+{-# INLINABLE accrueInterest #-}
+accrueInterest :: Slot -> Slot -> Reserve -> IncentivizedAmount -> IncentivizedAmount
+accrueInterest previousReserveUpdated slot reserve IncentivizedAmount {..} =
+ if iaRate == fromInteger 0 || iaAmount == fromInteger 0
+ then IncentivizedAmount slot newIncome iaAmount
+ else
+ IncentivizedAmount
+ slot
+ newIncome
+ (reduce (numerator newAmount) (denominator newAmount))
+
+ where
+ newIncome = InterestRate.getNormalizedIncome reserve previousReserveUpdated slot
+ newAmount = (iaAmount * (newIncome + fromInteger 1)) `InterestRate.divideRatio` (iaRate + fromInteger 1)
+
+data UpdateConfigParams =
+ UpdateConfigParams
+ {
+ ucpUpdatedReserve :: Reserve,
+ ucpPreviousReserveUpdated :: Slot,
+ ucpCurrentSlot :: Slot
+ }
+
+{-# INLINABLE updateConfigAmounts #-}
+updateConfigAmounts :: UpdateConfigParams -> UserConfig -> UserConfig
+updateConfigAmounts UpdateConfigParams {..} UserConfig{..} =
UserConfig {
- ucDebt = accrue rCurrentStableBorrowRate slot ucDebt,
- ucCollateralizedInvestment = accrue rCurrentStableAccrualRate slot ucCollateralizedInvestment
+ ucDebt = accrueDebt curSlot (rCurrentStableBorrowRate ucpUpdatedReserve) ucDebt,
+ ucCollateralizedInvestment = accrueInterest ucpPreviousReserveUpdated curSlot ucpUpdatedReserve ucCollateralizedInvestment
}
+ where
+ curSlot = Slot . (*10) . getSlot $ ucpCurrentSlot
+
+{-# INLINABLE getAverageStableBorrow #-}
+getAverageStableBorrow :: [UserConfig] -> Rational
+getAverageStableBorrow userConfigs =
+ if rateDivisor == 0
+ then fromInteger 0
+ else rateSum `InterestRate.divideRatio` (fromInteger rateDivisor)
+ where
+ rateSum = foldr
+ (\cur acc -> if ((== fromInteger 0) . iaAmount . ucDebt $ cur) then acc else acc + (iaRate . ucDebt $ cur)) (fromInteger 0) userConfigs
+ rateDivisor = foldr (\cur acc -> if ((== fromInteger 0) . iaAmount . ucDebt $ cur) then acc else acc + 1) 0 userConfigs
+
+{-# INLINABLE getAverageStableBorrowRate #-}
+getAverageStableBorrowRate :: [UserConfig] -> Rational
+getAverageStableBorrowRate userConfigs = getAverageStableBorrow userConfigs * InterestRate.getTotalBorrows userConfigs
+
+-- provide/revoke scenario - availableLiquidity changes
+updateReserveOnLiquidityChange :: [UserConfig] -> Integer -> Slot -> Reserve -> Reserve
+updateReserveOnLiquidityChange userConfigs newAvailableLiquidity slot reserve =
+ InterestRate.updateReserveInterestRates rateParams slot averageStableBorrowRate $ InterestRate.updateCumulativeIndices reserve userConfigs slot
+ where
+ totalBorrows = InterestRate.getTotalBorrows userConfigs
+ rateParams = InterestRate.RateParams newAvailableLiquidity totalBorrows
+ averageStableBorrowRate = getAverageStableBorrowRate userConfigs
+
+-- refer to increaseTotalBorrowsStableAndUpdateAverageRate, decreaseTotalBorrowsStableAndUpdateAverageRate
+{-# INLINABLE updateReserveOnBorrow #-}
+updateReserveOnBorrow :: [UserConfig] -> Integer -> Integer -> Slot -> Reserve -> Reserve
+updateReserveOnBorrow userConfigs availableLiquidity borrowAmount slot reserve@Reserve{..} =
+ InterestRate.updateReserveInterestRates rateParams slot averageStableBorrowRate $ InterestRate.updateCumulativeIndices reserve userConfigs slot
+ where
+ previousAverageStableBorrowRate = getAverageStableBorrowRate userConfigs
+ previousTotalBorrows = InterestRate.getTotalBorrows userConfigs
+ totalBorrows = previousTotalBorrows + fromInteger borrowAmount
+ weightedLastBorrow = fromInteger borrowAmount * rCurrentStableBorrowRate
+ weightedPreviousTotalBorrows = previousTotalBorrows * previousAverageStableBorrowRate
+ averageStableBorrowRate = (weightedLastBorrow + weightedPreviousTotalBorrows) `InterestRate.divideRatio` totalBorrows
+ rateParams = InterestRate.RateParams availableLiquidity totalBorrows
+
+{-# INLINABLE updateReserveOnRepay #-}
+updateReserveOnRepay :: [UserConfig] -> Integer -> Integer -> Slot -> Reserve -> Reserve
+updateReserveOnRepay userConfigs availableLiquidity repayAmount slot reserve@Reserve{..} =
+ InterestRate.updateReserveInterestRates rateParams slot averageStableBorrowRate $ InterestRate.updateCumulativeIndices reserve userConfigs slot
+ where
+ previousAverageStableBorrowRate = getAverageStableBorrowRate userConfigs
+ previousTotalBorrows = InterestRate.getTotalBorrows userConfigs
+ totalBorrows = previousTotalBorrows - fromInteger repayAmount
+ weightedLastBorrow = fromInteger repayAmount * rCurrentStableBorrowRate
+ weightedPreviousTotalBorrows = previousTotalBorrows * previousAverageStableBorrowRate
+ averageStableBorrowRate = (weightedPreviousTotalBorrows - weightedLastBorrow) `InterestRate.divideRatio` totalBorrows
+ rateParams = InterestRate.RateParams availableLiquidity totalBorrows
+
+{-
+Regarding reserve updates:
+
+rLiquidityRate + rLastLiquidityCumulativeIndex are used to calculate normalizedIncome,
+which is the final param used to directly accrue interest in IncentivizedToken
+
+Update flow:
+
+1. Available liquidity changes(provide/revoke) or total borrow changes (borrow/repay)
+
+2. updateCumulativeIndices increases rLastLiquidityCumulativeIndex, which is then used to update user config collateral? (done before each operation)
+But shouldn't this mean all user configs should be updated? idk, bottom line rLastLiquidityCumulativeIndex is some parameter used to accrue interest.
+
+3.
+On provide/revoke:
+change rLiquidityRate(another interest accual param) + rCurrentStableBorrowRate (hol up, isnt this updateReserveInterestRates?)
+
+On borrow/repay:
+change averageStableBorrowRate, which is used to calculate liquidityRate, which in turn is used to accrue interest
+Do we need it?
+
+overallBorrowRate is a weighted average - for stable rate this means totalBorrows * currentStableBorrowAverage
+
+4. updateReserveInterestRates - this should also be done on each action, since availableLiquidity and totalBorrows change on every action
+and they are used to calculate current rates.
+-}
+
From 249399e8b36935b285bb5dcf5a13cbb6e395f45b Mon Sep 17 00:00:00 2001
From: megakaban <nakedant19@gmail.com>
Date: Mon, 6 Sep 2021 15:15:31 +0700
Subject: [PATCH 2/2] Cleanup, comments
---
.../src/Ext/Plutus/Ledger/Contexts.hs | 8 ++
.../Contracts/LendingPool/InterestRate.hs | 31 +++---
.../Contracts/LendingPool/OffChain/Owner.hs | 4 +-
.../Contracts/LendingPool/OffChain/State.hs | 40 ++++----
.../Contracts/LendingPool/OffChain/User.hs | 47 +++++-----
.../LendingPool/OnChain/Core/Logic.hs | 32 +------
.../LendingPool/OnChain/Core/Script.hs | 24 ++---
.../LendingPool/OnChain/Core/Validator.hs | 94 +++++++++----------
.../Plutus/Contracts/LendingPool/Shared.hs | 36 +++----
9 files changed, 135 insertions(+), 181 deletions(-)
diff --git a/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs b/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
index 638c994a6..b5d92bd52 100644
--- a/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
+++ b/MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
@@ -49,6 +49,14 @@ findValueByDatum ctx datum = (`findValueByDatumHash` scriptOutputs) <$> findDatu
txInfo = scriptContextTxInfo ctx
scriptOutputs = getScriptOutputs ctx
+{-# INLINABLE findInputValueByDatum #-}
+findInputValueByDatum :: PlutusTx.IsData a => ScriptContext -> a -> Maybe Value
+findInputValueByDatum ctx datum = (`findValueByDatumHash` scriptOutputs) <$> findDatumHash (Datum $ PlutusTx.toData datum) txInfo
+ where
+ txInfo = scriptContextTxInfo ctx
+ (validatorHash, _) = ownHashes ctx
+ scriptOutputs = scriptInputsAt validatorHash txInfo
+
{-# INLINABLE findValueByDatumHash #-}
-- | Concat value of the script's outputs that have the specified hash of a datum
findValueByDatumHash :: DatumHash -> [(DatumHash, Value)] -> Value
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
index 385261f4b..29b3731f8 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
@@ -37,6 +37,7 @@ import PlutusTx.Ratio (Ratio,
reduce)
import qualified Prelude
+-- refer to updateCumulativeIndexes
{-# INLINABLE updateCumulativeIndices #-}
updateCumulativeIndices :: Reserve -> [UserConfig] -> Slot -> Reserve
updateCumulativeIndices reserve@Reserve{..} userConfigs currentSlot =
@@ -77,6 +78,7 @@ data RateParams = RateParams {
rpTotalBorrows :: Rational
}
+-- refer to calculateInterestRates
{-# INLINABLE updateReserveInterestRates #-}
updateReserveInterestRates :: RateParams -> Slot -> Rational -> Reserve -> Reserve
updateReserveInterestRates rateParams currentSlot averageStableBorrowRate reserve@Reserve{..} =
@@ -95,20 +97,6 @@ getCurrentLiqudityRate rateParams averageStableBorrowRate =
utilizationRate = getUtilizationRate rateParams
borrowRate = if (rpTotalBorrows rateParams) == (fromInteger 0) then (fromInteger 0) else averageStableBorrowRate
-defaultRateModel :: InterestRateModel
-defaultRateModel = InterestRateModel {
- irmOptimalUtilizationRate = 8 % 10,
- irmExcessUtilizationRate = 2 % 10,
- irmStableRateSlope1 = 4 % 100,
- irmStableRateSlope2 = 1 % 1,
- irmMarketBorrowRate = 4 % 100
-}
-
--- TODO: figure out the right way to do it
-{-# INLINABLE divideRatio #-}
-divideRatio :: Rational -> Rational -> Rational
-divideRatio a b = reduce (numerator a * denominator b) (denominator a * numerator b)
-
{-# INLINABLE getCurrentStableBorrowRate #-}
getCurrentStableBorrowRate :: InterestRateModel -> RateParams -> Rational
getCurrentStableBorrowRate InterestRateModel{..} rateParams =
@@ -128,6 +116,21 @@ getUtilizationRate RateParams{..} =
then fromInteger 0
else rpTotalBorrows `divideRatio` (rpTotalBorrows + fromInteger rpAvailableLiquidity)
+defaultRateModel :: InterestRateModel
+defaultRateModel = InterestRateModel {
+ irmOptimalUtilizationRate = 8 % 10,
+ irmExcessUtilizationRate = 2 % 10,
+ irmStableRateSlope1 = 4 % 100,
+ irmStableRateSlope2 = 1 % 1,
+ irmMarketBorrowRate = 4 % 100
+}
+
+-- TODO: figure out the right way to do it - the numbers are constantly growing
+{-# INLINABLE divideRatio #-}
+divideRatio :: Rational -> Rational -> Rational
+divideRatio a b = reduce (numerator a * denominator b) (denominator a * numerator b)
+
+-- refer to getNormalizedIncome
{-# INLINABLE getNormalizedIncome #-}
getNormalizedIncome :: Reserve -> Slot -> Slot -> Rational
getNormalizedIncome Reserve{..} previous current =
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 510a5e18e..01ee6818c 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/Owner.hs
@@ -45,7 +45,7 @@ import qualified Plutus.Contracts.LendingPool.OffChain.State as State
import qualified Plutus.Contracts.LendingPool.OnChain.AToken as AToken
import Plutus.Contracts.LendingPool.OnChain.Core (Aave,
AaveDatum (..),
- AaveNewState (..),
+ AaveState (..),
AaveRedeemer (..),
Reserve (..),
UserConfig (..))
@@ -123,7 +123,7 @@ start' getAaveToken params = do
slot <- currentSlot
let reserveMap = AssocMap.fromList $ fmap (\params -> (cpAsset params, createReserve aave slot params)) params
- stateTx <- State.putAaveState aave Core.StartRedeemer AaveNewState { ansReserves = reserveMap, ansUserConfigs = AssocMap.empty }
+ stateTx <- State.putAaveState aave Core.StartRedeemer AaveState { asReserves = reserveMap, asUserConfigs = AssocMap.empty }
ledgerTx <- TxUtils.submitTxPair stateTx
void $ awaitTxConfirmed $ txId ledgerTx
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs
index eada596dc..ca700c351 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/State.hs
@@ -38,7 +38,7 @@ import Plutus.Contract hiding (when)
import Plutus.Contracts.Currency as Currency
import Plutus.Contracts.LendingPool.OnChain.Core (Aave (..),
AaveDatum (..),
- AaveNewState (..),
+ AaveState (..),
AaveRedeemer (..),
AaveScript,
Reserve (..),
@@ -69,7 +69,7 @@ findAaveOwnerToken :: Aave -> Contract w s Text (OutputValue PubKeyHash)
findAaveOwnerToken aave@Aave{..} = findOutputBy aave aaveProtocolInst (^? Core._LendingPoolDatum)
findAaveReserves :: Aave -> Contract w s Text (OutputValue (AssocMap.Map AssetClass Reserve))
-findAaveReserves aave = findOutputBy aave (aaveStateToken aave) (fmap Core.ansReserves . (^? Core._StateDatum . _2))
+findAaveReserves aave = findOutputBy aave (aaveStateToken aave) (fmap Core.asReserves . (^? Core._StateDatum . _2))
getAaveCollateralValue :: Aave -> Contract w s Text Value
getAaveCollateralValue aave = foldMap getValue <$> State.getOutputsAt (Core.aaveAddress aave)
@@ -84,7 +84,7 @@ findAaveReserve aave reserveId = do
maybe (throwError "Reserve not found") pure $ AssocMap.lookup reserveId reserves
findAaveUserConfigs :: Aave -> Contract w s Text (OutputValue (AssocMap.Map UserConfigId UserConfig))
-findAaveUserConfigs aave = findOutputBy aave (aaveStateToken aave) (fmap Core.ansUserConfigs . (^? Core._StateDatum . _2))
+findAaveUserConfigs aave = findOutputBy aave (aaveStateToken aave) (fmap Core.asUserConfigs . (^? Core._StateDatum . _2))
findAaveUserConfig :: Aave -> UserConfigId -> Contract w s Text UserConfig
findAaveUserConfig aave userConfigId = do
@@ -102,10 +102,10 @@ putState aave stateHandle newState = do
updateState :: Aave -> StateHandle AaveScript a -> OutputValue a -> Contract w s Text (TxUtils.TxPair AaveScript, a)
updateState aave = State.updateState (Core.aaveInstance aave)
-findAaveState :: Aave -> Contract w s Text (OutputValue AaveNewState)
+findAaveState :: Aave -> Contract w s Text (OutputValue AaveState)
findAaveState aave = findOutputBy aave (aaveStateToken aave) (^? Core._StateDatum . _2)
-makeStateHandle :: Aave -> (AaveNewState -> AaveRedeemer) -> StateHandle AaveScript AaveNewState
+makeStateHandle :: Aave -> (AaveState -> AaveRedeemer) -> StateHandle AaveScript AaveState
makeStateHandle aave toRedeemer =
StateHandle {
stateToken = aaveStateToken aave,
@@ -113,31 +113,31 @@ makeStateHandle aave toRedeemer =
toRedeemer = toRedeemer
}
-putAaveState :: Aave -> AaveRedeemer -> AaveNewState -> Contract w s Text (TxUtils.TxPair AaveScript)
+putAaveState :: Aave -> AaveRedeemer -> AaveState -> Contract w s Text (TxUtils.TxPair AaveScript)
putAaveState aave redeemer = putState aave $ makeStateHandle aave (const redeemer)
-updateAaveState :: Aave -> AaveRedeemer -> OutputValue AaveNewState -> Contract w s Text (TxUtils.TxPair AaveScript, AaveNewState)
+updateAaveState :: Aave -> AaveRedeemer -> OutputValue AaveState -> Contract w s Text (TxUtils.TxPair AaveScript, AaveState)
updateAaveState aave redeemer = updateState aave $ makeStateHandle aave (const redeemer)
-addUserConfig :: UserConfigId -> UserConfig -> AaveNewState -> Contract w s Text AaveNewState
-addUserConfig userConfigId userConfig state@AaveNewState{..} = do
+addUserConfig :: UserConfigId -> UserConfig -> AaveState -> Contract w s Text AaveState
+addUserConfig userConfigId userConfig state@AaveState{..} = do
_ <- maybe (pure ()) (const $ throwError "Add user config failed: config exists") $
- AssocMap.lookup userConfigId ansUserConfigs
- pure $ state { ansUserConfigs = AssocMap.insert userConfigId userConfig ansUserConfigs }
+ AssocMap.lookup userConfigId asUserConfigs
+ pure $ state { asUserConfigs = AssocMap.insert userConfigId userConfig asUserConfigs }
-updateUserConfig :: UserConfigId -> UserConfig -> AaveNewState -> Contract w s Text AaveNewState
-updateUserConfig userConfigId userConfig state@AaveNewState{..} = do
+updateUserConfig :: UserConfigId -> UserConfig -> AaveState -> Contract w s Text AaveState
+updateUserConfig userConfigId userConfig state@AaveState{..} = do
_ <- maybe (throwError "Update failed: user config not found") pure $
- AssocMap.lookup userConfigId ansUserConfigs
- pure $ state { ansUserConfigs = AssocMap.insert userConfigId userConfig ansUserConfigs }
+ AssocMap.lookup userConfigId asUserConfigs
+ pure $ state { asUserConfigs = AssocMap.insert userConfigId userConfig asUserConfigs }
-updateReserveNew :: AssetClass -> Reserve -> AaveNewState -> Contract w s Text AaveNewState
-updateReserveNew reserveId reserve state@AaveNewState{..} = do
+updateReserveNew :: AssetClass -> Reserve -> AaveState -> Contract w s Text AaveState
+updateReserveNew reserveId reserve state@AaveState{..} = do
_ <- maybe (throwError "Update failed: reserve not found") pure $
- AssocMap.lookup reserveId ansReserves
- pure $ state { ansReserves = AssocMap.insert reserveId reserve ansReserves }
+ AssocMap.lookup reserveId asReserves
+ pure $ state { asReserves = AssocMap.insert reserveId reserve asReserves }
-modifyAaveState :: Aave -> AaveRedeemer -> (AaveNewState -> Contract w s Text AaveNewState) -> Contract w s Text (TxUtils.TxPair AaveScript, AaveNewState)
+modifyAaveState :: Aave -> AaveRedeemer -> (AaveState -> Contract w s Text AaveState) -> Contract w s Text (TxUtils.TxPair AaveScript, AaveState)
modifyAaveState aave redeemer f = do
stateOutput <- findAaveState aave
newState <- f (ovValue stateOutput)
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs
index 912804a5f..90ffe5b84 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/OffChain/User.hs
@@ -49,7 +49,7 @@ import qualified Plutus.Contracts.LendingPool.OffChain.AToken as AToken
import qualified Plutus.Contracts.LendingPool.OffChain.State as State
import Plutus.Contracts.LendingPool.OnChain.Core (Aave,
AaveDatum (..),
- AaveNewState (..),
+ AaveState (..),
AaveRedeemer (..),
Reserve (..),
UserConfig (..),
@@ -101,8 +101,8 @@ deposit aave DepositParams {..} = do
let userConfigId = (rCurrency reserve, dpOnBehalfOf)
(stateTx, _) <- State.modifyAaveState aave (Core.DepositRedeemer userConfigId) $
- \oldState@AaveNewState{..} ->
- case AssocMap.lookup userConfigId ansUserConfigs of
+ \oldState@AaveState{..} ->
+ case AssocMap.lookup userConfigId asUserConfigs of
Nothing -> do
slot <- currentSlot
State.addUserConfig
@@ -162,17 +162,17 @@ PlutusTx.makeLift ''BorrowParams
borrow :: Aave -> BorrowParams -> Contract w s Text ()
borrow aave BorrowParams {..} = do
oldStateOutput <- State.findAaveState aave
- let oldState@AaveNewState {..} = ovValue oldStateOutput
- reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup bpAsset ansReserves
+ let oldState@AaveState {..} = ovValue oldStateOutput
+ reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup bpAsset asReserves
let userConfigId = (rCurrency reserve, bpOnBehalfOf)
slot <- currentSlot
availableLiquidity <- flip assetClassValueOf bpAsset <$> State.getAaveCollateralValue aave
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == bpAsset) . AssocMap.toList $ ansUserConfigs
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == bpAsset) . AssocMap.toList $ asUserConfigs
let updatedReserve = updateReserveOnBorrow reserveConfigs availableLiquidity bpAmount slot reserve
userConfigs <- do
- case AssocMap.lookup userConfigId ansUserConfigs of
+ case AssocMap.lookup userConfigId asUserConfigs of
Nothing -> do
pure $ AssocMap.insert
userConfigId
@@ -180,7 +180,7 @@ borrow aave BorrowParams {..} = do
ucDebt = IncentivizedAmount slot (rCurrentStableBorrowRate reserve) (fromInteger bpAmount),
ucCollateralizedInvestment = IncentivizedAmount slot (fromInteger 0) (fromInteger 0)
}
- ansUserConfigs
+ asUserConfigs
Just userConfig -> do
pure $ AssocMap.insert
userConfigId
@@ -194,8 +194,8 @@ borrow aave BorrowParams {..} = do
}
$ userConfig
)
- ansUserConfigs
- oracles <- either throwError pure $ findOraclesForUser bpOnBehalfOf ansReserves userConfigs
+ asUserConfigs
+ oracles <- either throwError pure $ findOraclesForUser bpOnBehalfOf asReserves userConfigs
let redeemer = Core.BorrowRedeemer bpAmount userConfigId oracles slot
utxos <-
@@ -207,7 +207,7 @@ borrow aave BorrowParams {..} = do
let disbursementTx = TxUtils.mustSpendFromScript (Core.aaveInstance aave) inputs bpOnBehalfOf payment <>
TxUtils.mustPayToScript (Core.aaveInstance aave) bpOnBehalfOf Core.ReserveFundsDatum remainder
- newState <- State.updateReserveNew bpAsset updatedReserve oldState { ansUserConfigs = userConfigs }
+ newState <- State.updateReserveNew bpAsset updatedReserve oldState { asUserConfigs = userConfigs }
stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> do
State.updateAaveState aave redeemer (newState Prelude.<$ oldStateOutput)
@@ -256,12 +256,12 @@ repay aave RepayParams {..} = do
slot <- currentSlot
stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$> (
State.modifyAaveState aave (Core.RepayRedeemer rpAmount userConfigId slot) $
- \oldState@AaveNewState{..} -> do
+ \oldState@AaveState{..} -> do
availableLiquidity <- flip assetClassValueOf rpAsset <$> State.getAaveCollateralValue aave
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == rpAsset) . AssocMap.toList $ ansUserConfigs
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == rpAsset) . AssocMap.toList $ asUserConfigs
let updatedReserve = updateReserveOnRepay reserveConfigs availableLiquidity rpAmount slot reserve
- s <- case AssocMap.lookup userConfigId ansUserConfigs of
+ s <- case AssocMap.lookup userConfigId asUserConfigs of
Nothing ->
throwError "User does not have any debt."
Just userConfig -> do
@@ -319,17 +319,12 @@ provideCollateral aave ProvideCollateralParams {..} = do
slot <- currentSlot
stateTx <- (<> (mempty, mustValidateIn (Interval.from slot))) . fst <$>
(State.modifyAaveState aave (Core.ProvideCollateralRedeemer userConfigId slot) $
- \oldState@AaveNewState{..} -> do
+ \oldState@AaveState{..} -> do
availableLiquidity <- flip assetClassValueOf pcpUnderlyingAsset <$> State.getAaveCollateralValue aave
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == pcpUnderlyingAsset) . AssocMap.toList $ ansUserConfigs
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == pcpUnderlyingAsset) . AssocMap.toList $ asUserConfigs
let updatedReserve = updateReserveOnLiquidityChange reserveConfigs (availableLiquidity + pcpAmount) slot reserve
- logInfo @Prelude.String $
- " total available - "
- <> show availableLiquidity
- <> " liq rate - " <> show (rLiquidityRate updatedReserve)
- <> " average borrow rate - " <> show (getAverageStableBorrowRate reserveConfigs)
- case AssocMap.lookup userConfigId ansUserConfigs of
+ case AssocMap.lookup userConfigId asUserConfigs of
Nothing -> do
let normalizedIncome = InterestRate.getNormalizedIncome updatedReserve (rLastUpdated reserve) slot
State.addUserConfig
@@ -376,17 +371,17 @@ revokeCollateral :: Aave -> RevokeCollateralParams -> Contract w s Text ()
revokeCollateral aave RevokeCollateralParams {..} = do
oldStateOutput <- State.findAaveState aave
let oldState = ovValue oldStateOutput
- reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup rcpUnderlyingAsset (ansReserves oldState)
+ reserve <- maybe (throwError "Reserve not found") pure $ AssocMap.lookup rcpUnderlyingAsset (asReserves oldState)
let userConfigId = (rCurrency reserve, rcpOnBehalfOf)
slot <- currentSlot
newState <- do
- case AssocMap.lookup userConfigId (ansUserConfigs oldState) of
+ case AssocMap.lookup userConfigId (asUserConfigs oldState) of
Nothing ->
throwError "User does not have any collateral."
Just userConfig -> do
availableLiquidity <- flip assetClassValueOf rcpUnderlyingAsset <$> State.getAaveCollateralValue aave
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == rcpUnderlyingAsset) . AssocMap.toList $ (ansUserConfigs oldState)
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == rcpUnderlyingAsset) . AssocMap.toList $ (asUserConfigs oldState)
let updatedReserve = updateReserveOnLiquidityChange reserveConfigs (availableLiquidity - rcpAmount) slot reserve
State.updateUserConfig
userConfigId
@@ -403,7 +398,7 @@ revokeCollateral aave RevokeCollateralParams {..} = do
oldState
>>= State.updateReserveNew rcpUnderlyingAsset updatedReserve
- oracles <- either throwError pure $ findOraclesForUser rcpOnBehalfOf (ansReserves newState) (ansUserConfigs newState)
+ oracles <- either throwError pure $ findOraclesForUser rcpOnBehalfOf (asReserves newState) (asUserConfigs newState)
let aTokenAsset = rAToken reserve
let redeemer = Core.RevokeCollateralRedeemer userConfigId aTokenAsset oracles slot
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 805230cea..bc0a1cb84 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
@@ -42,7 +42,7 @@ import Playground.Contract
import Plutus.Abstract.IncentivizedAmount (IncentivizedAmount (..))
import Plutus.Contract hiding (when)
import Plutus.Contracts.LendingPool.OnChain.Core.Script (AaveDatum (..),
- AaveNewState (..),
+ AaveState (..),
AaveRedeemer (..),
AaveState (..),
Oracles,
@@ -71,18 +71,8 @@ assertMapChange filterChanged old new = unless (f old == f new) (throwError "Une
assertInsertAt :: (Eq k, Eq a) => k -> AssocMap.Map k a -> AssocMap.Map k a -> Either Builtins.String ()
assertInsertAt key = assertMapChange $ (/= key) . fst
-{-# INLINABLE pickUserConfigs #-}
-pickUserConfigs :: AaveDatum -> Maybe (AaveState, AssocMap.Map UserConfigId UserConfig)
-pickUserConfigs (UserConfigsDatum state configs) = Just (state, configs)
-pickUserConfigs _ = Nothing
-
-{-# INLINABLE pickReserves #-}
-pickReserves :: AaveDatum -> Maybe (AaveState, AssocMap.Map AssetClass Reserve)
-pickReserves (ReservesDatum state configs) = Just (state, configs)
-pickReserves _ = Nothing
-
{-# INLINABLE pickAaveState #-}
-pickAaveState :: AaveDatum -> Maybe (AssetClass, AaveNewState)
+pickAaveState :: AaveDatum -> Maybe (AssetClass, AaveState)
pickAaveState (StateDatum stateToken state) = Just (stateToken, state)
pickAaveState _ = Nothing
@@ -106,15 +96,7 @@ assertValidCurrentSlot :: ScriptContext -> Slot -> Either Builtins.String ()
assertValidCurrentSlot ctx slot = fromBool "Invalid current slot value" $
Interval.LowerBound (Interval.Finite slot) True == Interval.ivFrom (posixTimeRangeToSlotRange . txInfoValidRange . scriptContextTxInfo $ ctx)
-findUserConfigs :: ScriptContext -> AaveState -> Either Builtins.String (AssocMap.Map UserConfigId UserConfig)
-findUserConfigs ctx state@AaveState{..} = do
- let txInfo = scriptContextTxInfo ctx
- (newState, newUserConfigs) <- maybe (throwError "User configs not found") pure $
- findOnlyOneDatumByValue ctx (assetClassValue asUserConfigs 1) >>= pickUserConfigs
- unless (newState == state) $ throwError "Invalid state address change"
- pure newUserConfigs
-
-findAaveState :: ScriptContext -> AssetClass -> Either Builtins.String AaveNewState
+findAaveState :: ScriptContext -> AssetClass -> Either Builtins.String AaveState
findAaveState ctx stateToken = do
let txInfo = scriptContextTxInfo ctx
(newStateToken, newState) <- maybe (throwError "User configs not found") pure $
@@ -122,14 +104,6 @@ findAaveState ctx stateToken = do
unless (newStateToken == stateToken) $ throwError "Invalid state address change"
pure newState
-findReserves :: ScriptContext -> AaveState -> Either Builtins.String (AssocMap.Map AssetClass Reserve)
-findReserves ctx state@AaveState{..} = do
- let txInfo = scriptContextTxInfo ctx
- (newState, newReserves) <- maybe (throwError "Reserves not found") pure $
- findOnlyOneDatumByValue ctx (assetClassValue asReserves 1) >>= pickReserves
- unless (newState == state) $ throwError "Invalid state address change"
- pure newReserves
-
{-# INLINABLE doesCollateralCoverDebt #-}
doesCollateralCoverDebt ::
PubKeyHash
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 dfc45ebdb..d78510db8 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
@@ -141,34 +141,22 @@ type LendingPoolOperator = PubKeyHash
type Oracles = AssocMap.Map AssetClass Integer -- Shows how many lovelaces should be paid for a specific asset
-data AaveState = AaveState { asReserves :: AssetClass, asUserConfigs :: AssetClass }
+data AaveState = AaveState {
+ asReserves :: AssocMap.Map AssetClass Reserve,
+ asUserConfigs :: AssocMap.Map UserConfigId UserConfig
+}
deriving stock (Prelude.Eq, Show, Generic)
deriving anyclass (ToJSON, FromJSON)
-instance Eq AaveState where
- a == b = asReserves a == asReserves b && asUserConfigs a == asUserConfigs b
-
PlutusTx.unstableMakeIsData ''AaveState
PlutusTx.makeLift ''AaveState
-
-data AaveNewState = AaveNewState {
- ansReserves :: AssocMap.Map AssetClass Reserve,
- ansUserConfigs :: AssocMap.Map UserConfigId UserConfig
-}
- deriving stock (Prelude.Eq, Show, Generic)
- deriving anyclass (ToJSON, FromJSON)
-
-PlutusTx.unstableMakeIsData ''AaveNewState
-PlutusTx.makeLift ''AaveNewState
-Lens.makeClassyPrisms ''AaveNewState
+Lens.makeClassyPrisms ''AaveState
data AaveDatum =
LendingPoolDatum LendingPoolOperator
- | ReservesDatum AaveState (AssocMap.Map AssetClass Reserve) -- State token and reserve currency -> reserve map
| ReserveFundsDatum
- | UserConfigsDatum AaveState (AssocMap.Map UserConfigId UserConfig) -- State token and UserConfigId -> user config map
| UserCollateralFundsDatum PubKeyHash AssetClass -- User pub key and aToken asset type
- | StateDatum AssetClass AaveNewState
+ | StateDatum AssetClass AaveState
deriving stock (Show)
PlutusTx.unstableMakeIsData ''AaveDatum
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 dd12f7b1e..eb3c0eaed 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
@@ -32,6 +32,7 @@ import Data.Void (Void)
import Ext.Plutus.Ledger.Contexts (findOnlyOneDatumByValue,
findOnlyOneDatumHashByValue,
findValueByDatum,
+ findInputValueByDatum,
findValueByDatumHash,
parseDatum,
scriptInputsAt,
@@ -56,16 +57,12 @@ import Plutus.Contracts.LendingPool.OnChain.Core.Logic (areOraclesTru
checkPositiveReservesTransformation,
doesCollateralCoverDebt,
findAaveState,
- findReserves,
- findUserConfigs,
- pickReserves,
pickUserCollateralFunds,
- pickUserConfigs,
toBool,
toBoolPrefixed)
import Plutus.Contracts.LendingPool.OnChain.Core.Script (Aave (..),
AaveDatum (..),
- AaveNewState (..),
+ AaveState (..),
AaveRedeemer (..),
AaveScript,
AaveState (..),
@@ -106,8 +103,6 @@ makeAaveValidator :: Aave
-> AaveRedeemer
-> ScriptContext
-> Bool
-makeAaveValidator _ _ _ _ = True
-{-
makeAaveValidator aave datum StartRedeemer ctx = trace "StartRedeemer" $ validateStart aave datum ctx
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
@@ -115,7 +110,6 @@ makeAaveValidator aave datum (BorrowRedeemer amount userConfigId oracles slot) c
makeAaveValidator aave datum (RepayRedeemer amount userConfigId slot) ctx = trace "RepayRedeemer" $ validateRepay aave datum ctx amount userConfigId slot
makeAaveValidator aave datum (ProvideCollateralRedeemer userConfigId slot) ctx = trace "ProvideCollateralRedeemer" $ validateProvideCollateral aave datum ctx userConfigId slot
makeAaveValidator aave datum (RevokeCollateralRedeemer userConfigId aTokenAsset oracles slot) ctx = trace "RevokeCollateralRedeemer" $ validateRevokeCollateral aave datum ctx userConfigId aTokenAsset oracles slot
--}
{-# INLINABLE validateStart #-}
validateStart :: Aave -> AaveDatum -> ScriptContext -> Bool
@@ -136,14 +130,14 @@ validateDeposit :: Aave -> AaveDatum -> ScriptContext -> UserConfigId -> Bool
validateDeposit aave (StateDatum stateToken oldState) ctx userConfigId =
toBoolPrefixed "validateDeposit: " $ do
newState <- findAaveState ctx stateToken
- assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
+ assertInsertAt userConfigId (asUserConfigs oldState) (asUserConfigs newState)
- let oldUserConfig = AssocMap.lookup userConfigId (ansUserConfigs oldState)
- newUserConfig <- maybe (throwError "User config not found") pure (AssocMap.lookup userConfigId (ansUserConfigs newState))
+ let oldUserConfig = AssocMap.lookup userConfigId (asUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure (AssocMap.lookup userConfigId (asUserConfigs newState))
unless
(maybe ((iaAmount . ucCollateralizedInvestment) newUserConfig == (fromInteger 0)) ((ucCollateralizedInvestment newUserConfig ==) . ucCollateralizedInvestment) oldUserConfig
&& (iaAmount . ucDebt $ newUserConfig) == (fromInteger 0) && maybe True ((== (fromInteger 0)) . iaAmount . ucDebt) oldUserConfig
- && checkPositiveReservesTransformation (ansReserves oldState) (ansReserves newState) ctx userConfigId)
+ && checkPositiveReservesTransformation (asReserves oldState) (asReserves newState) ctx userConfigId)
(throwError "Change is not valid")
validateDeposit _ _ _ _ = trace "validateDeposit: Lending Pool Datum management is not allowed" False
@@ -155,7 +149,7 @@ validateWithdraw aave (StateDatum stateToken oldState) ctx userConfigId =
newState <- findAaveState ctx stateToken
unless
- (checkNegativeReservesTransformation (ansReserves oldState) (ansReserves newState) ctx userConfigId)
+ (checkNegativeReservesTransformation (asReserves oldState) (asReserves newState) ctx userConfigId)
(throwError "")
validateWithdraw aave ReserveFundsDatum ctx (reserveId, actor) =
@@ -169,8 +163,8 @@ validateBorrow aave (StateDatum stateToken oldState) ctx borrowAmount userConfig
toBoolPrefixed "validateBorrow: " $ do
assertValidCurrentSlot ctx slot
newState <- findAaveState ctx stateToken
- assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
- assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+ assertInsertAt userConfigId (asUserConfigs oldState) (asUserConfigs newState)
+ assertInsertAt reserveId (asReserves oldState) (asReserves newState)
let txInfo = scriptContextTxInfo ctx
oracleValues <-
@@ -178,20 +172,20 @@ validateBorrow aave (StateDatum stateToken oldState) ctx borrowAmount userConfig
Just vs -> pure . AssocMap.fromList $ vs
_ -> throwError "Oracles have not been provided"
- oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
- newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ newState
- fundsValue <- maybe (throwError "Datum hash not found") pure $ findValueByDatum ctx ReserveFundsDatum
- let availableLiquidity = flip assetClassValueOf reserveId fundsValue + borrowAmount
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ fundsValue <- maybe (throwError "Datum hash not found") pure $ findInputValueByDatum ctx ReserveFundsDatum
+ let availableLiquidity = flip assetClassValueOf reserveId fundsValue
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . asUserConfigs $ oldState
let updatedReserve = Shared.updateReserveOnBorrow reserveConfigs availableLiquidity borrowAmount slot oldReserve
unless (updatedReserve == newReserve) (throwError "Invalid reserve calculation")
- unless (doesCollateralCoverDebt actor oracleValues (ansReserves newState) slot (ansUserConfigs newState)) $ throwError "Not enough collateral"
- unless (areOraclesTrusted oracles (ansReserves oldState)) (throwError "Invalid oracles")
+ unless (doesCollateralCoverDebt actor oracleValues (asReserves newState) slot (asUserConfigs newState)) $ throwError "Not enough collateral"
+ unless (areOraclesTrusted oracles (asReserves oldState)) (throwError "Invalid oracles")
- let oldUserConfig = AssocMap.lookup userConfigId (ansUserConfigs oldState)
- newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ let oldUserConfig = AssocMap.lookup userConfigId (asUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (asUserConfigs newState)
let accUserConfig = fmap (updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot }) oldUserConfig
actorSpentValue = valueSpentFrom txInfo actor
actorRemainderValue = valuePaidTo txInfo actor
@@ -213,21 +207,21 @@ validateRepay aave (StateDatum stateToken oldState) ctx repayAmount userConfigId
toBoolPrefixed "validateRepay: " $ do
assertValidCurrentSlot ctx slot
newState <- findAaveState ctx stateToken
- assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
- assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+ assertInsertAt userConfigId (asUserConfigs oldState) (asUserConfigs newState)
+ assertInsertAt reserveId (asReserves oldState) (asReserves newState)
- oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
- newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ newState
- fundsValue <- maybe (throwError "Datum hash not found") pure $ findValueByDatum ctx ReserveFundsDatum
+ fundsValue <- maybe (throwError "Datum hash not found") pure $ findInputValueByDatum ctx ReserveFundsDatum
let availableLiquidity = flip assetClassValueOf reserveId fundsValue - repayAmount
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . asUserConfigs $ oldState
let updatedReserve = Shared.updateReserveOnRepay reserveConfigs availableLiquidity repayAmount slot oldReserve
unless (updatedReserve == newReserve) (throwError "Invalid reserve calculation")
- oldUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs oldState)
- newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ oldUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (asUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (asUserConfigs newState)
let accUserConfig = updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot } oldUserConfig
txInfo = scriptContextTxInfo ctx
@@ -249,8 +243,8 @@ validateProvideCollateral aave (StateDatum stateToken oldState) ctx userConfigId
toBoolPrefixed "validateProvideCollateral: " $ do
assertValidCurrentSlot ctx slot
newState <- findAaveState ctx stateToken
- assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
- assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+ assertInsertAt userConfigId (asUserConfigs oldState) (asUserConfigs newState)
+ assertInsertAt reserveId (asReserves oldState) (asReserves newState)
let txInfo = scriptContextTxInfo ctx
actorSpentValue = valueSpentFrom txInfo actor
@@ -258,15 +252,15 @@ validateProvideCollateral aave (StateDatum stateToken oldState) ctx userConfigId
(user, asset) <- maybe (throwError "Collateral not found") pure $
findOnlyOneDatumByValue ctx (actorSpentValue - actorRemainderValue - txInfoFee txInfo) >>= pickUserCollateralFunds
- oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
- newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
- fundsValue <- maybe (pure mempty) pure $ findValueByDatum ctx ReserveFundsDatum
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ newState
+ fundsValue <- maybe (pure mempty) pure $ findInputValueByDatum ctx ReserveFundsDatum
let availableLiquidity = flip assetClassValueOf reserveId fundsValue
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . asUserConfigs $ oldState
let updatedReserve = Shared.updateReserveOnLiquidityChange reserveConfigs availableLiquidity slot oldReserve
- let oldUserConfig = AssocMap.lookup userConfigId (ansUserConfigs oldState)
- newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ let oldUserConfig = AssocMap.lookup userConfigId (asUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (asUserConfigs newState)
let accUserConfig = updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot } <$> oldUserConfig
investmentAmount = ((iaAmount . ucCollateralizedInvestment) newUserConfig -) $ maybe (fromInteger 0) (iaAmount . ucCollateralizedInvestment) oldUserConfig
disbursementAmount = fromInteger $ assetClassValueOf actorSpentValue asset - assetClassValueOf actorRemainderValue asset
@@ -283,26 +277,26 @@ validateRevokeCollateral aave (StateDatum stateToken oldState) ctx userConfigId@
toBoolPrefixed "validateRevokeCollateral: " $ do
assertValidCurrentSlot ctx slot
newState <- findAaveState ctx stateToken
- assertInsertAt userConfigId (ansUserConfigs oldState) (ansUserConfigs newState)
- assertInsertAt reserveId (ansReserves oldState) (ansReserves newState)
+ assertInsertAt userConfigId (asUserConfigs oldState) (asUserConfigs newState)
+ assertInsertAt reserveId (asReserves oldState) (asReserves newState)
let txInfo = scriptContextTxInfo ctx
oracleValues <-
case foldrM (\o@(_, _, _, oAsset) acc -> fmap ((: acc) . (oAsset, )) (Oracle.findOracleValueInTxInputs txInfo o)) [] oracles of
Just vs -> pure . AssocMap.fromList $ vs
_ -> throwError "Oracles have not been provided"
- unless (doesCollateralCoverDebt actor oracleValues (ansReserves newState) slot (ansUserConfigs newState)) $ throwError "Not enough collateral"
- unless (areOraclesTrusted oracles (ansReserves oldState)) (throwError "Invalid oracles")
+ unless (doesCollateralCoverDebt actor oracleValues (asReserves newState) slot (asUserConfigs newState)) $ throwError "Not enough collateral"
+ unless (areOraclesTrusted oracles (asReserves oldState)) (throwError "Invalid oracles")
- oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ oldState
- newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . ansReserves $ newState
- fundsValue <- maybe (throwError "Datum hash not found") pure $ findValueByDatum ctx ReserveFundsDatum
+ oldReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ oldState
+ newReserve <- maybe (throwError "Reserve not found") pure . AssocMap.lookup reserveId . asReserves $ newState
+ fundsValue <- maybe (throwError "Datum hash not found") pure $ findInputValueByDatum ctx ReserveFundsDatum
let availableLiquidity = flip assetClassValueOf reserveId fundsValue
- let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . ansUserConfigs $ oldState
+ let reserveConfigs = fmap snd . filter (\((asset, _), _) -> asset == reserveId) . AssocMap.toList . asUserConfigs $ oldState
let updatedReserve = Shared.updateReserveOnLiquidityChange reserveConfigs availableLiquidity slot oldReserve
- oldUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs oldState)
- newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (ansUserConfigs newState)
+ oldUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (asUserConfigs oldState)
+ newUserConfig <- maybe (throwError "User config not found") pure $ AssocMap.lookup userConfigId (asUserConfigs newState)
let accUserConfig = updateConfigAmounts UpdateConfigParams { ucpUpdatedReserve = updatedReserve, ucpPreviousReserveUpdated = rLastUpdated oldReserve, ucpCurrentSlot = slot } oldUserConfig
newInvestmentAmount = iaAmount . ucCollateralizedInvestment $ newUserConfig
investmentShrinkedBy = (iaAmount . ucCollateralizedInvestment) accUserConfig - newInvestmentAmount
diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs
index cf2a53d5e..4a74b32c9 100644
--- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs
+++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs
@@ -36,7 +36,7 @@ import PlutusTx.Ratio (Rational,
reduce)
import qualified Prelude
--- refer to getCompoundedBorrowBalance
+-- refer to getCompoundedBorrowBalance and calculateCompoundedInterest
{-# INLINABLE accrueDebt #-}
accrueDebt :: Slot -> Rational -> IncentivizedAmount -> IncentivizedAmount
accrueDebt slot newRate IncentivizedAmount {..} =
@@ -60,7 +60,7 @@ somePow a n
| n == 1 = a
| otherwise = a * somePow a (n - 1)
--- refer to getNormalizedIncome
+-- refer to AToken's module balanceOf and calculateCumulatedBalanceInternal
{-# INLINABLE accrueInterest #-}
accrueInterest :: Slot -> Slot -> Reserve -> IncentivizedAmount -> IncentivizedAmount
accrueInterest previousReserveUpdated slot reserve IncentivizedAmount {..} =
@@ -94,6 +94,10 @@ updateConfigAmounts UpdateConfigParams {..} UserConfig{..} =
where
curSlot = Slot . (*10) . getSlot $ ucpCurrentSlot
+{-# INLINABLE getAverageStableBorrowRate #-}
+getAverageStableBorrowRate :: [UserConfig] -> Rational
+getAverageStableBorrowRate userConfigs = getAverageStableBorrow userConfigs * InterestRate.getTotalBorrows userConfigs
+
{-# INLINABLE getAverageStableBorrow #-}
getAverageStableBorrow :: [UserConfig] -> Rational
getAverageStableBorrow userConfigs =
@@ -105,11 +109,7 @@ getAverageStableBorrow userConfigs =
(\cur acc -> if ((== fromInteger 0) . iaAmount . ucDebt $ cur) then acc else acc + (iaRate . ucDebt $ cur)) (fromInteger 0) userConfigs
rateDivisor = foldr (\cur acc -> if ((== fromInteger 0) . iaAmount . ucDebt $ cur) then acc else acc + 1) 0 userConfigs
-{-# INLINABLE getAverageStableBorrowRate #-}
-getAverageStableBorrowRate :: [UserConfig] -> Rational
-getAverageStableBorrowRate userConfigs = getAverageStableBorrow userConfigs * InterestRate.getTotalBorrows userConfigs
-
--- provide/revoke scenario - availableLiquidity changes
+-- refer to updateReserveInterestRatesAndTimestampInternal
updateReserveOnLiquidityChange :: [UserConfig] -> Integer -> Slot -> Reserve -> Reserve
updateReserveOnLiquidityChange userConfigs newAvailableLiquidity slot reserve =
InterestRate.updateReserveInterestRates rateParams slot averageStableBorrowRate $ InterestRate.updateCumulativeIndices reserve userConfigs slot
@@ -118,7 +118,7 @@ updateReserveOnLiquidityChange userConfigs newAvailableLiquidity slot reserve =
rateParams = InterestRate.RateParams newAvailableLiquidity totalBorrows
averageStableBorrowRate = getAverageStableBorrowRate userConfigs
--- refer to increaseTotalBorrowsStableAndUpdateAverageRate, decreaseTotalBorrowsStableAndUpdateAverageRate
+-- refer to increaseTotalBorrowsStableAndUpdateAverageRate
{-# INLINABLE updateReserveOnBorrow #-}
updateReserveOnBorrow :: [UserConfig] -> Integer -> Integer -> Slot -> Reserve -> Reserve
updateReserveOnBorrow userConfigs availableLiquidity borrowAmount slot reserve@Reserve{..} =
@@ -132,6 +132,7 @@ updateReserveOnBorrow userConfigs availableLiquidity borrowAmount slot reserve@R
averageStableBorrowRate = (weightedLastBorrow + weightedPreviousTotalBorrows) `InterestRate.divideRatio` totalBorrows
rateParams = InterestRate.RateParams availableLiquidity totalBorrows
+-- refer to decreaseTotalBorrowsStableAndUpdateAverageRate
{-# INLINABLE updateReserveOnRepay #-}
updateReserveOnRepay :: [UserConfig] -> Integer -> Integer -> Slot -> Reserve -> Reserve
updateReserveOnRepay userConfigs availableLiquidity repayAmount slot reserve@Reserve{..} =
@@ -149,26 +150,17 @@ updateReserveOnRepay userConfigs availableLiquidity repayAmount slot reserve@Res
Regarding reserve updates:
rLiquidityRate + rLastLiquidityCumulativeIndex are used to calculate normalizedIncome,
-which is the final param used to directly accrue interest in IncentivizedToken
+which is the final param used to accrue interest with IncentivizedToken.
Update flow:
1. Available liquidity changes(provide/revoke) or total borrow changes (borrow/repay)
-2. updateCumulativeIndices increases rLastLiquidityCumulativeIndex, which is then used to update user config collateral? (done before each operation)
-But shouldn't this mean all user configs should be updated? idk, bottom line rLastLiquidityCumulativeIndex is some parameter used to accrue interest.
-
-3.
-On provide/revoke:
-change rLiquidityRate(another interest accual param) + rCurrentStableBorrowRate (hol up, isnt this updateReserveInterestRates?)
-
-On borrow/repay:
-change averageStableBorrowRate, which is used to calculate liquidityRate, which in turn is used to accrue interest
-Do we need it?
+2. updateCumulativeIndices recalculates rLastLiquidityCumulativeIndex, which is then used to update user config collateral.
+This is done before each operation.
-overallBorrowRate is a weighted average - for stable rate this means totalBorrows * currentStableBorrowAverage
+3. updateReserveInterestRates - this should also be done on each action, since availableLiquidity and totalBorrows change on every action
+and they are used to calculate the current rates.
-4. updateReserveInterestRates - this should also be done on each action, since availableLiquidity and totalBorrows change on every action
-and they are used to calculate current rates.
-}