Metalamp/lending pool/backend/add tests

MetaLamp/lending-pool/plutus-starter.cabal

@@ -96,3 +96,46 @@ executable generate-purs
     plutus-use-cases,
     plutus-ledger,
     plutus-tx
+
+test-suite test
+    type: exitcode-stdio-1.0
+    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
+    default-language: Haskell2010
+    ghc-options: -Wall -Wnoncanonical-monad-instances
+                 -Wincomplete-uni-patterns -Wincomplete-record-updates
+                 -Wredundant-constraints -Widentities -rtsopts
+                 -- See Plutus Tx readme
+                 -fobject-code -fno-ignore-interface-pragmas -fno-omit-interface-pragmas
+    build-depends:
+        plutus-core -any,
+        plutus-tx -any,
+        plutus-contract -any,
+        plutus-ledger -any,
+        plutus-starter,
+        plutus-ledger-api,
+        plutus-tx-plugin
+    build-depends:
+        base >=4.9 && <5,
+        aeson -any,
+        bytestring -any,
+        containers -any,
+        data-default -any,
+        freer-extras -any,
+        hedgehog -any,
+        prettyprinter -any,
+        tasty -any,
+        tasty-hunit -any,
+        tasty-hedgehog >=0.2.0.0,
+        tasty-golden -any,
+        tasty-quickcheck -any,
+        text -any,
+        lens -any,
+        mtl -any,
+        row-types -any,
+        QuickCheck -any,
+        freer-simple -any,
+        foldl -any,
+        streaming -any

MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs

@@ -18,7 +18,8 @@
 
 module Plutus.Contracts.Endpoints where
 
-import           Control.Monad                    (forM, forever, void)
+import qualified Control.Lens                     as Lens
+import           Control.Monad                    hiding (fmap)
 import qualified Data.ByteString                  as BS
 import qualified Data.Map                         as Map
 import           Data.Monoid                      (Last (..))
@@ -82,11 +83,16 @@ createReserve aave CreateParams {..} =
 
 -- | Starts the Lending Pool protocol: minting pool NFTs, creating empty user configuration state and all specified liquidity reserves
 start :: HasBlockchainActions s => [CreateParams] -> Contract w s Text Aave
-start params = do
+start = start' $ do
     pkh <- pubKeyHash <$> ownPubKey
-    aaveToken  <- fmap Currency.currencySymbol $
+    fmap Currency.currencySymbol $
            mapError (pack . show @Currency.CurrencyError) $
            Currency.forgeContract pkh [(Core.aaveProtocolName, 1)]
+
+start' :: HasBlockchainActions s => Contract w s Text CurrencySymbol -> [CreateParams] -> Contract w s Text Aave
+start' getAaveToken params = do
+    aaveToken <- getAaveToken
+    pkh <- pubKeyHash <$> ownPubKey
     let aave = Core.aave aaveToken
         payment = assetClassValue (Core.aaveProtocolInst aave) 1
     let aaveTokenTx = TxUtils.mustPayToScript (Core.aaveInstance aave) pkh (Core.LendingPoolDatum pkh) payment
@@ -105,16 +111,38 @@ start params = do
     logInfo @Prelude.String $ printf "started Aave %s at address %s" (show aave) (show $ Core.aaveAddress aave)
     pure aave
 
-ownerEndpoint :: [CreateParams] -> Contract (Last (Either Text Aave)) BlockchainActions Void ()
-ownerEndpoint params = do
-    e <- runError $ start params
+data ContractResponse e a = ContractSuccess a | ContractError e | ContractPending
+    deriving stock    (Prelude.Eq, Show, Generic)
+    deriving anyclass (ToJSON, FromJSON)
+
+handleContract :: forall l a p r s.
+    HasEndpoint l p s
+    => Proxy l
+    -> (a -> r)
+    -> (p -> Contract (Last (ContractResponse Text r)) s Text a)
+    -> Contract (Last (ContractResponse Text r)) s Void ()
+handleContract _ g c = do
+    e <- runError $ do
+        p <- endpoint @l
+        _ <- tell $ Last $ Just ContractPending
+        errorHandler `handleError` c p
     tell $ Last $ Just $ case e of
-        Left err -> Left err
-        Right aa -> Right aa
+        Left err -> ContractError err
+        Right a  -> ContractSuccess $ g a
+        where
+        errorHandler e = do
+            logInfo @Text ("Error submiting the transaction: " <> e)
+            throwError e
 
 type AaveOwnerSchema =
     BlockchainActions
-        .\/ Endpoint "start" ()
+        .\/ Endpoint "start" [CreateParams]
+
+data OwnerContractState = Started Aave
+    deriving (Prelude.Eq, Show, Generic, FromJSON, ToJSON)
+
+ownerEndpoints :: Contract (Last (ContractResponse Text OwnerContractState)) AaveOwnerSchema Void ()
+ownerEndpoints = forever $ handleContract (Proxy @"start") Started start
 
 -- | Gets current Lending Pool reserves state
 reserves :: HasBlockchainActions s => Aave -> Contract w s Text (AssocMap.Map AssetClass Reserve)
@@ -405,30 +433,6 @@ revokeCollateral aave RevokeCollateralParams {..} = do
         getUsersCollateral :: AssetClass -> TxOutTx -> Bool
         getUsersCollateral asset tx = ((> 0) . flip assetClassValueOf asset . txOutValue . txOutTxOut $ tx) &&
                                       (txOutDatumHash . txOutTxOut $ tx) == Just (datumHash . Datum . PlutusTx.toData $ userDatum asset)
-
-data ContractResponse e a = ContractSuccess a | ContractError e | ContractPending
-    deriving stock    (Prelude.Eq, Show, Generic)
-    deriving anyclass (ToJSON, FromJSON)
-
-handleContract :: forall l a p r s.
-    HasEndpoint l p s
-    => Proxy l
-    -> (a -> r)
-    -> (p -> Contract (Last (ContractResponse Text r)) s Text a)
-    -> Contract (Last (ContractResponse Text r)) s Void ()
-handleContract _ g c = do
-    e <- runError $ do
-        p <- endpoint @l
-        _ <- tell $ Last $ Just ContractPending
-        errorHandler `handleError` c p
-    tell $ Last $ Just $ case e of
-        Left err -> ContractError err
-        Right a  -> ContractSuccess $ g a
-        where
-        errorHandler e = do
-            logInfo @Text ("Error submiting the transaction: " <> e)
-            throwError e
-
 type AaveUserSchema =
     BlockchainActions
         .\/ Endpoint "deposit" DepositParams
@@ -451,6 +455,8 @@ data UserContractState =
     | GetPubKeyBalance Value
     deriving (Prelude.Eq, Show, Generic, FromJSON, ToJSON)
 
+Lens.makeClassyPrisms ''UserContractState
+
 -- TODO ? add repayWithCollateral
 userEndpoints :: Aave -> Contract (Last (ContractResponse Text UserContractState)) AaveUserSchema Void ()
 userEndpoints aave = forever $

MetaLamp/lending-pool/src/Plutus/PAB/Simulation.hs

@@ -58,25 +58,28 @@ import           Prelude                             hiding (init)
 import           Wallet.Emulator.Types               (Wallet (..), walletPubKey)
 import           Wallet.Types                        (ContractInstanceId)
 
-wallets :: [Wallet]
-wallets = [Wallet i | i <- [1 .. 4]]
+ownerWallet :: Wallet
+ownerWallet = Wallet 1
 
-testCurrencyNames :: [TokenName]
-testCurrencyNames = ["MOGUS", "USD"]
+userWallets :: [Wallet]
+userWallets = [Wallet i | i <- [2 .. 4]]
+
+testAssets :: [AssetClass]
+testAssets = fmap toAsset ["MOGUS", "USD"]
 
 toAsset :: TokenName -> AssetClass
 toAsset tokenName =
    assetClass (scriptCurrencySymbol . FungibleToken.makeLiquidityPolicy $ tokenName) tokenName
 
-testAssets :: [AssetClass]
-testAssets = fmap toAsset testCurrencyNames
-
-initContract :: Contract (Monoid.Last [Oracle.Oracle]) BlockchainActions Text ()
-initContract = do
+distributeFunds ::
+    [Wallet] ->
+    [AssetClass] ->
+    Contract () BlockchainActions Text ()
+distributeFunds wallets assets = do
     ownPK <- pubKeyHash <$> ownPubKey
-    let testCurrenciesValue = mconcat $ fmap (`assetClassValue` 1000) testAssets
+    let testCurrenciesValue = mconcat $ fmap (`assetClassValue` 1000) assets
         policyLookups = mconcat $
-            fmap (Constraints.monetaryPolicy . FungibleToken.makeLiquidityPolicy . Prelude.snd . unAssetClass) testAssets
+            fmap (Constraints.monetaryPolicy . FungibleToken.makeLiquidityPolicy . Prelude.snd . unAssetClass) assets
         adaValue = lovelaceValueOf amount
     forM_ wallets $ \w -> do
         let pkh = pubKeyHash $ walletPubKey w
@@ -85,7 +88,14 @@ initContract = do
         when (pkh /= ownPK) $ do
             ledgerTx <- submitTxConstraintsWith @Scripts.Any lookups tx
             void $ awaitTxConfirmed $ txId ledgerTx
-    oracles <- forM testAssets $ \asset -> do
+  where
+    amount = 1000000
+
+createOracles ::
+    [AssetClass] ->
+    Contract (Monoid.Last [Oracle.Oracle]) BlockchainActions Text ()
+createOracles assets = do
+    oracles <- forM assets $ \asset -> do
         let oracleParams = Oracle.OracleParams
                 { opFees   = 0
                 , opSymbol = fst . unAssetClass $ asset
@@ -95,29 +105,30 @@ initContract = do
         Oracle.updateOracle oracle oneAdaInLovelace
         pure oracle
     tell $ Monoid.Last $ Just oracles
-  where
-    amount = 1000000
 
 data ContractIDs = ContractIDs { cidUser :: Map.Map Wallet ContractInstanceId, cidInfo :: ContractInstanceId }
 
 activateContracts :: Simulation (Builtin AaveContracts) ContractIDs
 activateContracts = do
-    cidInit  <- Simulator.activateContract (Wallet 1) Init
-    oracles  <- flip Simulator.waitForState cidInit $ \json -> case (fromJSON json :: Result (Monoid.Last [Oracle.Oracle])) of
+    cidFunds <- Simulator.activateContract ownerWallet $ DistributeFunds userWallets testAssets
+    _        <- Simulator.waitUntilFinished cidFunds
+
+    cidOracles  <- Simulator.activateContract ownerWallet $ CreateOracles testAssets
+    oracles  <- flip Simulator.waitForState cidOracles $ \json -> case (fromJSON json :: Result (Monoid.Last [Oracle.Oracle])) of
                     Success (Monoid.Last (Just res)) -> Just res
                     _                                -> Nothing
     Simulator.logString @(Builtin AaveContracts) "Initialization finished."
 
-    let params = fmap (\o -> Aave.CreateParams (Oracle.oAsset o) o) oracles
-    cidStart <- Simulator.activateContract (Wallet 1) (AaveStart params)
-    aa       <- flip Simulator.waitForState cidStart $ \json -> case (fromJSON json :: Result (Monoid.Last (Either Text Aave.Aave))) of
-                    Success (Monoid.Last (Just (Right aa))) -> Just aa
-                    _                                       -> Nothing
+    cidStart <- Simulator.activateContract ownerWallet AaveStart
+    _  <- Simulator.callEndpointOnInstance cidStart "start" $ fmap (\o -> Aave.CreateParams (Oracle.oAsset o) o) oracles
+    aa <- flip Simulator.waitForState cidStart $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.OwnerContractState))) of
+        Success (Monoid.Last (Just (ContractSuccess (Aave.Started aa)))) -> Just aa
+        _                                       -> Nothing
     Simulator.logString @(Builtin AaveContracts) $ "Aave instance created: " ++ show aa
 
-    cidInfo <- Simulator.activateContract (Wallet 1) $ AaveInfo aa
+    cidInfo <- Simulator.activateContract ownerWallet $ AaveInfo aa
 
-    cidUser <- fmap Map.fromList $ forM (tail wallets) $ \w -> do
+    cidUser <- fmap Map.fromList $ forM userWallets $ \w -> do
         cid <- Simulator.activateContract w $ AaveUser aa
         Simulator.logString @(Builtin AaveContracts) $ "Aave user contract started for " ++ show w
         return (w, cid)
@@ -232,8 +243,9 @@ runLendingPoolSimulation = void $ Simulator.runSimulationWith handlers $ do
     shutdown
 
 data AaveContracts =
-      Init
-    | AaveStart [Aave.CreateParams]
+      DistributeFunds [Wallet] [AssetClass]
+    | CreateOracles [AssetClass]
+    | AaveStart
     | AaveInfo Aave.Aave
     | AaveUser Aave.Aave
     deriving (Eq, Show, Generic)
@@ -252,13 +264,15 @@ handleAaveContract = Builtin.handleBuiltin getSchema getContract where
   getSchema = \case
     AaveUser _ -> Builtin.endpointsToSchemas @(Aave.AaveUserSchema .\\ BlockchainActions)
     AaveInfo _ -> Builtin.endpointsToSchemas @(Aave.AaveInfoSchema .\\ BlockchainActions)
-    AaveStart _  -> Builtin.endpointsToSchemas @(Aave.AaveOwnerSchema .\\ BlockchainActions)
-    Init          -> Builtin.endpointsToSchemas @Empty
+    AaveStart  -> Builtin.endpointsToSchemas @(Aave.AaveOwnerSchema .\\ BlockchainActions)
+    DistributeFunds _ _         -> Builtin.endpointsToSchemas @Empty
+    CreateOracles _ -> Builtin.endpointsToSchemas @Empty
   getContract = \case
-    AaveInfo aave    -> SomeBuiltin $ Aave.infoEndpoints aave
-    AaveUser aave    -> SomeBuiltin $ Aave.userEndpoints aave
-    AaveStart params -> SomeBuiltin $ Aave.ownerEndpoint params
-    Init             -> SomeBuiltin initContract
+    AaveInfo aave       -> SomeBuiltin $ Aave.infoEndpoints aave
+    AaveUser aave       -> SomeBuiltin $ Aave.userEndpoints aave
+    AaveStart           -> SomeBuiltin Aave.ownerEndpoints
+    DistributeFunds wallets assets -> SomeBuiltin $ distributeFunds wallets assets
+    CreateOracles assets -> SomeBuiltin $ createOracles assets
 
 handlers :: SimulatorEffectHandlers (Builtin AaveContracts)
 handlers =

MetaLamp/lending-pool/test/Fixtures.hs

@@ -0,0 +1,6 @@
+module Fixtures (module Fixtures.Aave, module Fixtures.Asset, module Fixtures.Init, module Fixtures.Wallet) where
+
+import           Fixtures.Aave
+import           Fixtures.Asset
+import           Fixtures.Init
+import           Fixtures.Wallet

MetaLamp/lending-pool/test/Fixtures/Aave.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeApplications  #-}
+
+module Fixtures.Aave where
+
+import           Data.Text                  (Text)
+import           Fixtures.Symbol            (forgeSymbol, getSymbol)
+import qualified Ledger
+import           Plutus.Contract
+import qualified Plutus.Contracts.Core      as Aave
+import qualified Plutus.Contracts.Endpoints as Aave
+import qualified Plutus.Contracts.TxUtils   as TxUtils
+import           Plutus.V1.Ledger.Value     (CurrencySymbol)
+import           PlutusTx.Prelude
+
+aaveSymbol :: CurrencySymbol
+aaveSymbol = getSymbol Aave.aaveProtocolName
+
+aaveAddress :: Ledger.Address
+aaveAddress = Aave.aaveAddress . Aave.aave $ aaveSymbol
+
+aave :: Aave.Aave
+aave = Aave.aave aaveSymbol
+
+aaveHash :: Ledger.ValidatorHash
+aaveHash = Aave.aaveHash aave
+
+start :: [Aave.CreateParams] -> Contract () Aave.AaveOwnerSchema Text Aave.Aave
+start = Aave.start' (forgeSymbol Aave.aaveProtocolName)

MetaLamp/lending-pool/test/Fixtures/Asset.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Fixtures.Asset where
+
+import qualified Fixtures.Aave           as AaveMock
+import qualified Plutus.Contracts.AToken as AToken
+import           Plutus.PAB.Simulation   (toAsset)
+import           Plutus.V1.Ledger.Value  (AssetClass)
+
+mogus :: AssetClass
+mogus = toAsset "MOGUS"
+
+usd :: AssetClass
+usd = toAsset "USD"
+
+defaultAssets :: [AssetClass]
+defaultAssets = [mogus, usd]
+
+amogus :: AssetClass
+amogus = AToken.makeAToken AaveMock.aaveHash mogus
+
+ausd :: AssetClass
+ausd = AToken.makeAToken AaveMock.aaveHash usd