Skip to content

Commit

Permalink
Merge pull request #47 from input-output-hk/MetaLamp/lending-pool/rem…
Browse files Browse the repository at this point in the history 
…ove-last-monoid

Remove Last monoid from contract Writer type
  • Loading branch information
@stanislav-az
stanislav-az authored Jun 29, 2021
2 parents 7fbae32 + 7c1214b commit 58ccc2c
Show file tree
Hide file tree
Showing 5 changed files with 61 additions and 56 deletions.
21 changes: 14 additions & 7 deletions MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,18 +115,25 @@ data ContractResponse e a = ContractSuccess a | ContractError e | ContractPendin
deriving stock (Prelude.Eq, Show, Generic)
deriving anyclass (ToJSON, FromJSON)

instance Semigroup (ContractResponse e a) where
a <> b = b

instance Monoid (ContractResponse e a) where
mempty = ContractPending
mappend = (<>)

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 ()
-> (p -> Contract (ContractResponse Text r) s Text a)
-> Contract (ContractResponse Text r) s Void ()
handleContract _ g c = do
e <- runError $ do
p <- endpoint @l
_ <- tell $ Last $ Just ContractPending
_ <- tell ContractPending
errorHandler `handleError` c p
tell $ Last $ Just $ case e of
tell $ case e of
Left err -> ContractError err
Right a -> ContractSuccess $ g a
where
Expand All @@ -141,7 +148,7 @@ type AaveOwnerSchema =
data OwnerContractState = Started Aave
deriving (Prelude.Eq, Show, Generic, FromJSON, ToJSON)

ownerEndpoints :: Contract (Last (ContractResponse Text OwnerContractState)) AaveOwnerSchema Void ()
ownerEndpoints :: Contract (ContractResponse Text OwnerContractState) AaveOwnerSchema Void ()
ownerEndpoints = forever $ handleContract (Proxy @"start") Started start

-- | Gets current Lending Pool reserves state
Expand Down Expand Up @@ -458,7 +465,7 @@ data UserContractState =
Lens.makeClassyPrisms ''UserContractState

-- TODO ? add repayWithCollateral
userEndpoints :: Aave -> Contract (Last (ContractResponse Text UserContractState)) AaveUserSchema Void ()
userEndpoints :: Aave -> Contract (ContractResponse Text UserContractState) AaveUserSchema Void ()
userEndpoints aave = forever $
handleContract (Proxy @"deposit") (const Deposited) (deposit aave)
`select` handleContract (Proxy @"withdraw") (const Withdrawn) (withdraw aave)
Expand All @@ -483,7 +490,7 @@ data InfoContractState =
| Users (AssocMap.Map (AssetClass, PubKeyHash) UserConfig)
deriving (Prelude.Eq, Show, Generic, FromJSON, ToJSON)

infoEndpoints :: Aave -> Contract (Last (ContractResponse Text InfoContractState)) AaveInfoSchema Void ()
infoEndpoints :: Aave -> Contract (ContractResponse Text InfoContractState) AaveInfoSchema Void ()
infoEndpoints aave = forever $
handleContract (Proxy @"fundsAt") FundsAt fundsAt
`select` handleContract (Proxy @"poolFunds") PoolFunds (const $ poolFunds aave)
Expand Down
78 changes: 39 additions & 39 deletions MetaLamp/lending-pool/src/Plutus/PAB/Simulation.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -121,9 +121,9 @@ activateContracts = do

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
aa <- flip Simulator.waitForState cidStart $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.OwnerContractState)) of
Success (ContractSuccess (Aave.Started aa)) -> Just aa
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Aave instance created: " ++ show aa

cidInfo <- Simulator.activateContract ownerWallet $ AaveInfo aa
Expand Down Expand Up @@ -155,89 +155,89 @@ runLendingPoolSimulation = void $ Simulator.runSimulationWith handlers $ do
_ <-
Simulator.callEndpointOnInstance userCid "deposit" $
Aave.DepositParams { Aave.dpAsset = head testAssets, Aave.dpOnBehalfOf = sender, Aave.dpAmount = 400 }
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.Deposited))) -> Just ()
_ -> Nothing
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.Deposited) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful deposit"

_ <-
Simulator.callEndpointOnInstance userCid "withdraw" $
Aave.WithdrawParams { Aave.wpAsset = head testAssets, Aave.wpUser = sender, Aave.wpAmount = 30 }
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.Withdrawn))) -> Just ()
_ -> Nothing
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.Withdrawn) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful withdraw"

_ <-
Simulator.callEndpointOnInstance userCid "provideCollateral" $
Aave.ProvideCollateralParams { Aave.pcpUnderlyingAsset = head testAssets, Aave.pcpOnBehalfOf = sender, Aave.pcpAmount = 200 }
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.CollateralProvided))) -> Just ()
_ -> Nothing
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.CollateralProvided) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful provideCollateral"

_ <-
Simulator.callEndpointOnInstance userCid "revokeCollateral" $
Aave.RevokeCollateralParams { Aave.rcpUnderlyingAsset = head testAssets, Aave.rcpOnBehalfOf = sender, Aave.rcpAmount = 50 }
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.CollateralRevoked))) -> Just ()
_ -> Nothing
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.CollateralRevoked) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful revokeCollateral"

let lenderCid = cidUser Map.! Wallet 3
let lender = pubKeyHash . walletPubKey $ Wallet 3
_ <-
Simulator.callEndpointOnInstance lenderCid "deposit" $
Aave.DepositParams { Aave.dpAsset = testAssets !! 1, Aave.dpOnBehalfOf = lender, Aave.dpAmount = 200 }
flip Simulator.waitForState lenderCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.Deposited))) -> Just ()
_ -> Nothing
flip Simulator.waitForState lenderCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.Deposited) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful deposit from lender"

_ <-
Simulator.callEndpointOnInstance userCid "borrow" $
Aave.BorrowParams { Aave.bpAsset = testAssets !! 1, Aave.bpAmount = 35, Aave.bpOnBehalfOf = sender }
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.Borrowed))) -> Just ()
_ -> Nothing
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.Borrowed) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful borrow"

_ <-
Simulator.callEndpointOnInstance userCid "repay" $
Aave.RepayParams { Aave.rpAsset = testAssets !! 1, Aave.rpAmount = 25, Aave.rpOnBehalfOf = sender }
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.UserContractState))) of
Success (Monoid.Last (Just (ContractSuccess Aave.Repaid))) -> Just ()
_ -> Nothing
flip Simulator.waitForState userCid $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.UserContractState)) of
Success (ContractSuccess Aave.Repaid) -> Just ()
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Successful repay"

_ <- Simulator.callEndpointOnInstance cidInfo "fundsAt" sender
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.InfoContractState))) of
Success (Monoid.Last (Just (ContractSuccess (Aave.FundsAt v)))) -> Just v
_ -> Nothing
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.InfoContractState)) of
Success (ContractSuccess (Aave.FundsAt v)) -> Just v
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Final user funds: " <> show v

_ <- Simulator.callEndpointOnInstance cidInfo "fundsAt" lender
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.InfoContractState))) of
Success (Monoid.Last (Just (ContractSuccess (Aave.FundsAt v)))) -> Just v
_ -> Nothing
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.InfoContractState)) of
Success (ContractSuccess (Aave.FundsAt v)) -> Just v
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Final lender funds: " <> show v

_ <- Simulator.callEndpointOnInstance cidInfo "reserves" ()
reserves <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.InfoContractState))) of
Success (Monoid.Last (Just (ContractSuccess (Aave.Reserves reserves)))) -> Just reserves
_ -> Nothing
reserves <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.InfoContractState)) of
Success (ContractSuccess (Aave.Reserves reserves)) -> Just reserves
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Final reserves: " <> show reserves

_ <- Simulator.callEndpointOnInstance cidInfo "poolFunds" ()
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.InfoContractState))) of
Success (Monoid.Last (Just (ContractSuccess (Aave.PoolFunds v)))) -> Just v
_ -> Nothing
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.InfoContractState)) of
Success (ContractSuccess (Aave.PoolFunds v)) -> Just v
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Final pool funds: " <> show v

_ <- Simulator.callEndpointOnInstance cidInfo "users" ()
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (Monoid.Last (ContractResponse Text Aave.InfoContractState))) of
Success (Monoid.Last (Just (ContractSuccess (Aave.Users v)))) -> Just v
_ -> Nothing
v <- flip Simulator.waitForState cidInfo $ \json -> case (fromJSON json :: Result (ContractResponse Text Aave.InfoContractState)) of
Success (ContractSuccess (Aave.Users v)) -> Just v
_ -> Nothing
Simulator.logString @(Builtin AaveContracts) $ "Final users: " <> show v
_ <- liftIO getLine
shutdown
Expand Down
5 changes: 2 additions & 3 deletions MetaLamp/lending-pool/test/Fixtures/Init.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@ module Fixtures.Init where

import Control.Monad (forM, forM_, void)
import qualified Data.Map as Map
import Data.Monoid (Last (..))
import Data.Text (Text)
import Data.Void (Void)
import qualified Fixtures.Aave as AaveMock
Expand Down Expand Up @@ -52,7 +51,7 @@ initialFunds = lovelaceValueOf 1000000 <> mconcat ((`assetClassValue` 1000) <$>
startContract :: Contract () Aave.AaveOwnerSchema Text ()
startContract = void $ AaveMock.start startParams

userContract :: Contract (Last (ContractResponse Text Aave.UserContractState)) Aave.AaveUserSchema Void ()
userContract :: Contract (ContractResponse Text Aave.UserContractState) Aave.AaveUserSchema Void ()
userContract = void $ Aave.userEndpoints AaveMock.aave

distributeTrace :: Trace.EmulatorTrace ()
Expand Down Expand Up @@ -80,7 +79,7 @@ oracleTrace = do
_ <- Trace.waitNSlots 5
pure ()

type UserHandle = Trace.ContractHandle (Last (ContractResponse Text Aave.UserContractState)) Aave.AaveUserSchema Void
type UserHandle = Trace.ContractHandle (ContractResponse Text Aave.UserContractState) Aave.AaveUserSchema Void

defaultTrace :: Trace.EmulatorTrace (Map.Map Wallet UserHandle)
defaultTrace = do
Expand Down
7 changes: 3 additions & 4 deletions MetaLamp/lending-pool/test/Utils/Data.hs
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
module Utils.Data where

import Data.Function ((&))
import Data.Monoid (Last (..))
import Plutus.Contracts.Endpoints (ContractResponse (..))
import Plutus.V1.Ledger.Crypto (PubKeyHash, pubKeyHash)
import qualified PlutusTx.AssocMap as AssocMap
Expand All @@ -19,9 +18,9 @@ one f = foldr reducer False
modifyAt :: PlutusTx.Eq k => (v -> v) -> k -> AssocMap.Map k v -> AssocMap.Map k v
modifyAt f k m = maybe m (\v -> AssocMap.insert k (f v) m) (AssocMap.lookup k m)

isLastError :: Last (ContractResponse e a) -> Bool
isLastError (Last (Just (ContractError _))) = True
isLastError _ = False
isLastError :: ContractResponse e a -> Bool
isLastError (ContractError _) = True
isLastError _ = False

getPubKey :: Wallet -> PubKeyHash
getPubKey = pubKeyHash . walletPubKey
6 changes: 3 additions & 3 deletions MetaLamp/lending-pool/test/Utils/Trace.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,13 +41,13 @@ getState ::
, JSON.FromJSON e'
)
=> (a -> Maybe b) ->
Trace.ContractHandle (Last (ContractResponse e a)) s e' ->
Trace.ContractHandle (ContractResponse e a) s e' ->
Trace.EmulatorTrace b
getState pick userHandle = do
res <- Trace.observableState userHandle
case res of
(Last (Just (ContractSuccess s))) -> maybe (throwError . GenericError $ "Unexpected state: " <> show s) pure (pick s)
(Last (Just (ContractError e))) -> throwError . GenericError .show $ e
ContractSuccess s -> maybe (throwError . GenericError $ "Unexpected state: " <> show s) pure (pick s)
ContractError e -> throwError . GenericError . show $ e
s -> throwError . JSONDecodingError $ "Unexpected state: " <> show s

utxoAtAddress :: Monad m => Address -> (UtxoMap -> m c)-> L.FoldM m EmulatorEvent c
Expand Down

0 comments on commit 58ccc2c

Please sign in to comment.