Skip to content

Commit

Permalink
Add risk parameters
Browse files Browse the repository at this point in the history
  • Loading branch information
performanceArtist committed Sep 6, 2021
1 parent 95b5e4d commit 145f8da
Show file tree
Hide file tree
Showing 18 changed files with 797 additions and 306 deletions.
7 changes: 5 additions & 2 deletions MetaLamp/lending-pool/client/src/Component/MainPage.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down
20 changes: 16 additions & 4 deletions MetaLamp/lending-pool/client/src/View/ReserveInfo.purs
Original file line number Diff line number Diff line change
@@ -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)
1 change: 1 addition & 0 deletions MetaLamp/lending-pool/generate-purs/AaveTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions MetaLamp/lending-pool/plutus-starter.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down
3 changes: 1 addition & 2 deletions MetaLamp/lending-pool/src/Ext/Plutus/Ledger/Contexts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 6 additions & 1 deletion MetaLamp/lending-pool/src/Plutus/Abstract/OutputValue.hs
Original file line number Diff line number Diff line change
@@ -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 =
Expand All @@ -17,3 +19,6 @@ data OutputValue a =
} deriving (Prelude.Show, Prelude.Functor)

makeClassy_ ''OutputValue

getOutputValue :: OutputValue a -> Value
getOutputValue OutputValue {..} = txOutValue . txOutTxOut $ ovOutTx
6 changes: 3 additions & 3 deletions MetaLamp/lending-pool/src/Plutus/Abstract/State/Select.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
134 changes: 134 additions & 0 deletions MetaLamp/lending-pool/src/Plutus/Contracts/LendingPool/InterestRate.hs
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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 $
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down
Loading

0 comments on commit 145f8da

Please sign in to comment.