diff --git a/MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs b/MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs index 18d584f0a..8c3bb8610 100644 --- a/MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs +++ b/MetaLamp/lending-pool/src/Plutus/Contracts/Endpoints.hs @@ -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 @@ -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 @@ -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) @@ -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) diff --git a/MetaLamp/lending-pool/src/Plutus/PAB/Simulation.hs b/MetaLamp/lending-pool/src/Plutus/PAB/Simulation.hs index 8bc8ab263..0d0519225 100644 --- a/MetaLamp/lending-pool/src/Plutus/PAB/Simulation.hs +++ b/MetaLamp/lending-pool/src/Plutus/PAB/Simulation.hs @@ -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 @@ -155,33 +155,33 @@ 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 @@ -189,55 +189,55 @@ runLendingPoolSimulation = void $ Simulator.runSimulationWith handlers $ do _ <- 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 diff --git a/MetaLamp/lending-pool/test/Fixtures/Init.hs b/MetaLamp/lending-pool/test/Fixtures/Init.hs index d7a4e2c32..5d1d50684 100644 --- a/MetaLamp/lending-pool/test/Fixtures/Init.hs +++ b/MetaLamp/lending-pool/test/Fixtures/Init.hs @@ -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 @@ -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 () @@ -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 diff --git a/MetaLamp/lending-pool/test/Utils/Data.hs b/MetaLamp/lending-pool/test/Utils/Data.hs index 1e5f01832..8fa6693de 100644 --- a/MetaLamp/lending-pool/test/Utils/Data.hs +++ b/MetaLamp/lending-pool/test/Utils/Data.hs @@ -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 @@ -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 diff --git a/MetaLamp/lending-pool/test/Utils/Trace.hs b/MetaLamp/lending-pool/test/Utils/Trace.hs index 6c8a1d90a..8f9c73412 100644 --- a/MetaLamp/lending-pool/test/Utils/Trace.hs +++ b/MetaLamp/lending-pool/test/Utils/Trace.hs @@ -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