From 145f8daf75b622d656ec2ddd0cfa0e47f6c6d496 Mon Sep 17 00:00:00 2001 From: megakaban Date: Mon, 6 Sep 2021 13:00:39 +0700 Subject: [PATCH] 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 | 216 ++++++++++++++- 18 files changed, 797 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..4866a3626 100644 --- a/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs +++ b/MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/Shared.hs @@ -15,17 +15,221 @@ {-# 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{..} = +{- +scenario: + +1. Deposit 500 MOGUS. This does not cause any changes. +2. Provide 500 MOGUS. + +updateReserveOnLiquidityChange: + +updateCumulativeIndices does nothing, since there are no borrows yet. +updateReserveInterestRates: +rLiquidityRate = 0 (since there are no borrows, there is no income) +rCurrentStableBorrowRate is the same, since utilization rate is less than optimal + +3. Borrow 200 MOGUS. + +updateCumulativeIndices does nothing, since it is run before borrow update - current borrow does not count yet. +updateReserveOnBorrow: averageStableBorrowRate changes, rLiquidityRate and rCurrentStableBorrowRate are updated. + +averageStableBorrowRate = (weightedLastBorrow + weightedPreviousTotalBorrows) `InterestRate.divideRatio` totalBorrows + = 4.5 + +utilizationRate = rpTotalBorrows `divideRatio` (rpTotalBorrows + rpAvailableLiquidity) = 200 / (200 + 500) +rLiquidityRate = averageStableBorrowRate / utilizationRate = +stableBorrowRate = irmMarketBorrowRate + irmStableRateSlope1 * utilizationRate `divideRatio` irmOptimalUtilizationRate + = 0.04 + 0.04 * 0.2857 / 0.8 = 0.054285 +where + defaultRateModel = InterestRateModel { + irmOptimalUtilizationRate = 8 % 10, + irmExcessUtilizationRate = 2 % 10, + irmStableRateSlope1 = 4 % 100, + irmStableRateSlope2 = 1 % 1, + irmMarketBorrowRate = 4 % 100 + } + +4. Provide 100 MOGUS to receive interest. + + + +-} + +-- 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 + +{- + { rCurrency :: AssetClass, -- reserve id + rAToken :: AssetClass, + rAmount :: Integer, + 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), + rLastUpdated :: Slot, + rLastLiquidityCumulativeIndex :: Rational, + rInterestRateModel :: InterestRateModel + +The main metrics are rLiquidityRate and rCurrentStableBorrowRate. + +-} + +{- +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. + +Regarding user updates: + +1. Uses getNormalizedIncome to calculate newly accrued collateral(should be correct), + +-} +