|  | 
|  | 1 | +{-# LANGUAGE DataKinds                  #-} | 
|  | 2 | +{-# LANGUAGE DeriveAnyClass             #-} | 
|  | 3 | +{-# LANGUAGE DeriveGeneric              #-} | 
|  | 4 | +{-# LANGUAGE DerivingStrategies         #-} | 
|  | 5 | +{-# LANGUAGE FlexibleContexts           #-} | 
|  | 6 | +{-# LANGUAGE GeneralizedNewtypeDeriving #-} | 
|  | 7 | +{-# LANGUAGE LambdaCase                 #-} | 
|  | 8 | +{-# LANGUAGE MultiParamTypeClasses      #-} | 
|  | 9 | +{-# LANGUAGE NoImplicitPrelude          #-} | 
|  | 10 | +{-# LANGUAGE OverloadedStrings          #-} | 
|  | 11 | +{-# LANGUAGE RecordWildCards            #-} | 
|  | 12 | +{-# LANGUAGE ScopedTypeVariables        #-} | 
|  | 13 | +{-# LANGUAGE StandaloneDeriving         #-} | 
|  | 14 | +{-# LANGUAGE TemplateHaskell            #-} | 
|  | 15 | +{-# LANGUAGE TypeApplications           #-} | 
|  | 16 | +{-# LANGUAGE TypeFamilies               #-} | 
|  | 17 | +{-# LANGUAGE TypeOperators              #-} | 
|  | 18 | +{-# OPTIONS_GHC -fno-specialise #-} | 
|  | 19 | +{-# OPTIONS_GHC -fno-strictness #-} | 
|  | 20 | +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} | 
|  | 21 | +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} | 
|  | 22 | +{-# OPTIONS_GHC -fobject-code #-} | 
|  | 23 | + | 
|  | 24 | +module Plutus.Contracts.LendingPool.InterestRate where | 
|  | 25 | + | 
|  | 26 | +import           Plutus.Abstract.IncentivizedAmount               (IncentivizedAmount (..)) | 
|  | 27 | +import           Plutus.Contracts.LendingPool.OnChain.Core.Script (InterestRateModel (..), | 
|  | 28 | +                                                                   Reserve (..), | 
|  | 29 | +                                                                   UserConfig (..)) | 
|  | 30 | +import           Plutus.V1.Ledger.Slot                            (Slot (..)) | 
|  | 31 | +import           Plutus.V1.Ledger.Value                           (AssetClass) | 
|  | 32 | +import           PlutusTx.Prelude | 
|  | 33 | +import           PlutusTx.Ratio                                   (Ratio, | 
|  | 34 | +                                                                   Rational, | 
|  | 35 | +                                                                   denominator, | 
|  | 36 | +                                                                   numerator, | 
|  | 37 | +                                                                   reduce) | 
|  | 38 | +import qualified Prelude | 
|  | 39 | + | 
|  | 40 | +{-# INLINABLE updateCumulativeIndices #-} | 
|  | 41 | +updateCumulativeIndices :: Reserve -> [UserConfig] -> Slot -> Reserve | 
|  | 42 | +updateCumulativeIndices reserve@Reserve{..} userConfigs currentSlot = | 
|  | 43 | +    if totalBorrows > (fromInteger 0) | 
|  | 44 | +        then | 
|  | 45 | +            if rLastLiquidityCumulativeIndex == fromInteger 0 | 
|  | 46 | +                then | 
|  | 47 | +                    reserve { | 
|  | 48 | +                    rLastLiquidityCumulativeIndex = cumulatedLiquidityInterest, | 
|  | 49 | +                    rLastUpdated = currentSlot | 
|  | 50 | +                    } | 
|  | 51 | +                else | 
|  | 52 | +                    reserve { | 
|  | 53 | +                    rLastLiquidityCumulativeIndex = rLastLiquidityCumulativeIndex * cumulatedLiquidityInterest, | 
|  | 54 | +                    rLastUpdated = currentSlot | 
|  | 55 | +                    } | 
|  | 56 | +        else reserve | 
|  | 57 | +    where | 
|  | 58 | +        totalBorrows = getTotalBorrows userConfigs | 
|  | 59 | +        cumulatedLiquidityInterest = calculateLinearInterest rLastUpdated currentSlot rLiquidityRate | 
|  | 60 | + | 
|  | 61 | +{-# INLINABLE getTotalBorrows #-} | 
|  | 62 | +getTotalBorrows :: [UserConfig] -> Rational | 
|  | 63 | +getTotalBorrows = foldr (\acc cur -> cur + (iaAmount . ucDebt $ acc)) (fromInteger 0) | 
|  | 64 | + | 
|  | 65 | +{-# INLINABLE calculateLinearInterest #-} | 
|  | 66 | +calculateLinearInterest :: Slot -> Slot -> Rational -> Rational | 
|  | 67 | +calculateLinearInterest last current rate = rate * timeDelta | 
|  | 68 | +    where | 
|  | 69 | +        timeDifference = current - last | 
|  | 70 | +        timeDelta = getSlot timeDifference % getSlot slotsPerYear | 
|  | 71 | + | 
|  | 72 | +slotsPerYear :: Slot | 
|  | 73 | +slotsPerYear = Slot 31536000 | 
|  | 74 | + | 
|  | 75 | +data RateParams = RateParams { | 
|  | 76 | +    rpAvailableLiquidity :: Integer, | 
|  | 77 | +    rpTotalBorrows       :: Rational | 
|  | 78 | +} | 
|  | 79 | + | 
|  | 80 | +{-# INLINABLE updateReserveInterestRates #-} | 
|  | 81 | +updateReserveInterestRates :: RateParams -> Slot -> Rational -> Reserve -> Reserve | 
|  | 82 | +updateReserveInterestRates rateParams currentSlot averageStableBorrowRate reserve@Reserve{..} = | 
|  | 83 | +    reserve { | 
|  | 84 | +        rLiquidityRate = getCurrentLiqudityRate rateParams averageStableBorrowRate, | 
|  | 85 | +        rCurrentStableBorrowRate = getCurrentStableBorrowRate rInterestRateModel rateParams, | 
|  | 86 | +        rLastUpdated = currentSlot } | 
|  | 87 | + | 
|  | 88 | +{-# INLINABLE getCurrentLiqudityRate #-} | 
|  | 89 | +getCurrentLiqudityRate :: RateParams -> Rational -> Rational | 
|  | 90 | +getCurrentLiqudityRate rateParams averageStableBorrowRate = | 
|  | 91 | +    if utilizationRate == fromInteger 0 | 
|  | 92 | +        then fromInteger 0 | 
|  | 93 | +        else borrowRate `divideRatio` utilizationRate | 
|  | 94 | +    where | 
|  | 95 | +        utilizationRate = getUtilizationRate rateParams | 
|  | 96 | +        borrowRate = if (rpTotalBorrows rateParams) == (fromInteger 0) then (fromInteger 0) else averageStableBorrowRate | 
|  | 97 | + | 
|  | 98 | +defaultRateModel :: InterestRateModel | 
|  | 99 | +defaultRateModel = InterestRateModel { | 
|  | 100 | +    irmOptimalUtilizationRate = 8 % 10, | 
|  | 101 | +    irmExcessUtilizationRate = 2 % 10, | 
|  | 102 | +    irmStableRateSlope1 = 4 % 100, | 
|  | 103 | +    irmStableRateSlope2 = 1 % 1, | 
|  | 104 | +    irmMarketBorrowRate = 4 % 100 | 
|  | 105 | +} | 
|  | 106 | + | 
|  | 107 | +-- TODO: figure out the right way to do it | 
|  | 108 | +{-# INLINABLE divideRatio #-} | 
|  | 109 | +divideRatio :: Rational -> Rational -> Rational | 
|  | 110 | +divideRatio a b = reduce (numerator a * denominator b) (denominator a * numerator b) | 
|  | 111 | + | 
|  | 112 | +{-# INLINABLE getCurrentStableBorrowRate #-} | 
|  | 113 | +getCurrentStableBorrowRate :: InterestRateModel -> RateParams -> Rational | 
|  | 114 | +getCurrentStableBorrowRate InterestRateModel{..} rateParams = | 
|  | 115 | +    if utilizationRate > irmOptimalUtilizationRate | 
|  | 116 | +        then | 
|  | 117 | +            let excessUtilizationRateRatio = (utilizationRate - irmOptimalUtilizationRate) `divideRatio` irmExcessUtilizationRate | 
|  | 118 | +                in irmMarketBorrowRate + irmStableRateSlope1 + irmStableRateSlope2 * excessUtilizationRateRatio | 
|  | 119 | +        else | 
|  | 120 | +            irmMarketBorrowRate + irmStableRateSlope1 * utilizationRate `divideRatio` irmOptimalUtilizationRate | 
|  | 121 | +    where | 
|  | 122 | +        utilizationRate = getUtilizationRate rateParams | 
|  | 123 | + | 
|  | 124 | +{-# INLINABLE getUtilizationRate #-} | 
|  | 125 | +getUtilizationRate :: RateParams -> Rational | 
|  | 126 | +getUtilizationRate RateParams{..} = | 
|  | 127 | +    if rpTotalBorrows == (fromInteger 0) || rpAvailableLiquidity == 0 | 
|  | 128 | +        then fromInteger 0 | 
|  | 129 | +        else rpTotalBorrows `divideRatio` (rpTotalBorrows + fromInteger rpAvailableLiquidity) | 
|  | 130 | + | 
|  | 131 | +{-# INLINABLE getNormalizedIncome #-} | 
|  | 132 | +getNormalizedIncome :: Reserve -> Slot -> Slot -> Rational | 
|  | 133 | +getNormalizedIncome Reserve{..} previous current = | 
|  | 134 | +    rLastLiquidityCumulativeIndex * calculateLinearInterest previous current rLiquidityRate | 
0 commit comments