From 6f690da75a010fdd33f57e48879ee05cad283b53 Mon Sep 17 00:00:00 2001 From: Larry Adames Date: Tue, 28 Feb 2023 18:25:34 -0500 Subject: [PATCH] SCP-5029 create common file for web e2e tests --- .../marlowe-integration-tests.cabal | 1 + .../Language/Marlowe/Runtime/Web/Common.hs | 68 +++++++++++++++++++ .../Marlowe/Runtime/Web/GetContracts.hs | 62 +---------------- 3 files changed, 72 insertions(+), 59 deletions(-) create mode 100644 marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs diff --git a/marlowe-integration-tests/marlowe-integration-tests.cabal b/marlowe-integration-tests/marlowe-integration-tests.cabal index bbea428d23..37df24c027 100644 --- a/marlowe-integration-tests/marlowe-integration-tests.cabal +++ b/marlowe-integration-tests/marlowe-integration-tests.cabal @@ -64,6 +64,7 @@ executable marlowe-integration-tests Language.Marlowe.Runtime.Integration.MarloweQuery Language.Marlowe.Runtime.IntegrationSpec Language.Marlowe.Runtime.WebSpec + Language.Marlowe.Runtime.Web.Common Language.Marlowe.Runtime.Web.GetContracts Language.Marlowe.Runtime.CliSpec build-depends: diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs new file mode 100644 index 0000000000..4ed3ae4198 --- /dev/null +++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/Common.hs @@ -0,0 +1,68 @@ +module Language.Marlowe.Runtime.Web.Common + where + +import Cardano.Api + ( AsType(..) + , ShelleyWitnessSigningKey(..) + , TextEnvelope(..) + , TextEnvelopeType(..) + , deserialiseFromTextEnvelope + , serialiseToTextEnvelope + , signShelleyTransaction + ) +import Cardano.Api.SerialiseTextEnvelope (TextEnvelopeDescr(..)) +import Control.Concurrent (threadDelay) +import Control.Monad.IO.Class (MonadIO(liftIO)) + +import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Language.Marlowe as V1 +import Language.Marlowe.Runtime.Integration.Common +import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses(..)) +import qualified Language.Marlowe.Runtime.Web as Web +import Language.Marlowe.Runtime.Web.Client (getContract, postContract, putContract) +import Language.Marlowe.Runtime.Web.Server.DTO (ToDTO(toDTO)) +import Servant.Client (ClientM) + +createCloseContract :: Wallet -> ClientM Web.TxOutRef +createCloseContract Wallet{..}= do + let WalletAddresses{..} = addresses + let webChangeAddress = toDTO changeAddress + let webExtraAddresses = Set.map toDTO extraAddresses + let webCollataralUtxos = Set.map toDTO collateralUtxos + + Web.CreateTxBody{txBody = createTxBody, ..} <- postContract + webChangeAddress + (Just webExtraAddresses) + (Just webCollataralUtxos) + Web.PostContractsRequest + { metadata = mempty + , version = Web.V1 + , roles = Nothing + , contract = V1.Close + , minUTxODeposit = 2_000_000 + } + + createTx <- liftIO $ signShelleyTransaction' createTxBody signingKeys + putContract contractId createTx + _ <- waitUntilConfirmed (\Web.ContractState{status} -> status) $ getContract contractId + pure contractId + +signShelleyTransaction' :: Web.TextEnvelope -> [ShelleyWitnessSigningKey] -> IO Web.TextEnvelope +signShelleyTransaction' Web.TextEnvelope{..} wits = do + let te = TextEnvelope { teType = TextEnvelopeType (T.unpack teType), teDescription = TextEnvelopeDescr (T.unpack teDescription), teRawCBOR = Web.unBase16 teCborHex } + txBody <- case deserialiseFromTextEnvelope (AsTxBody AsBabbage) te of + Left err -> fail $ show err + Right a -> pure a + pure case serialiseToTextEnvelope Nothing $ signShelleyTransaction txBody wits of + TextEnvelope (TextEnvelopeType ty) _ bytes -> Web.TextEnvelope (T.pack ty) "" $ Web.Base16 bytes + +waitUntilConfirmed :: MonadIO m => (a -> Web.TxStatus) -> m a -> m a +waitUntilConfirmed getStatus getResource = do + resource <- getResource + case getStatus resource of + Web.Confirmed -> pure resource + _ -> do + liftIO $ threadDelay 1000 + waitUntilConfirmed getStatus getResource + diff --git a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/GetContracts.hs b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/GetContracts.hs index 949c7d79f6..5385c48448 100644 --- a/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/GetContracts.hs +++ b/marlowe-integration-tests/test/Language/Marlowe/Runtime/Web/GetContracts.hs @@ -1,32 +1,18 @@ module Language.Marlowe.Runtime.Web.GetContracts where -import Cardano.Api - ( AsType(..) - , ShelleyWitnessSigningKey(..) - , TextEnvelope(..) - , TextEnvelopeType(..) - , deserialiseFromTextEnvelope - , serialiseToTextEnvelope - , signShelleyTransaction - ) -import Cardano.Api.SerialiseTextEnvelope (TextEnvelopeDescr(..)) -import Control.Concurrent (threadDelay) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Exception (throw) import Data.Proxy (Proxy(Proxy)) -import qualified Data.Set as Set -import qualified Data.Text as T -import qualified Language.Marlowe as V1 import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain import Language.Marlowe.Runtime.Integration.Common -import Language.Marlowe.Runtime.Transaction.Api (WalletAddresses(..)) import qualified Language.Marlowe.Runtime.Web as Web -import Language.Marlowe.Runtime.Web.Client (Page(..), getContract, getContracts, postContract, putContract) +import Language.Marlowe.Runtime.Web.Client (Page(..), getContracts) +import Language.Marlowe.Runtime.Web.Common (createCloseContract) import Language.Marlowe.Runtime.Web.Server.DTO (ToDTO(toDTO)) import Network.HTTP.Types (Status(..)) -import Servant.Client (ClientError(FailureResponse), ClientM) +import Servant.Client (ClientError(FailureResponse)) import Servant.Client.Streaming (ResponseF(Response, responseStatusCode)) import Servant.Pagination (Range(..), RangeOrder(..)) import Test.Hspec (Spec, describe, it, shouldBe) @@ -194,45 +180,3 @@ invalidTxIdSpec = it "returns an error message" $ withLocalMarloweRuntime $ runI _ -> fail $ "Expected 416 response code - got " <> show result -createCloseContract :: Wallet -> ClientM Web.TxOutRef -createCloseContract Wallet{..}= do - let WalletAddresses{..} = addresses - let webChangeAddress = toDTO changeAddress - let webExtraAddresses = Set.map toDTO extraAddresses - let webCollateralUtxos = Set.map toDTO collateralUtxos - - Web.CreateTxBody{txBody = createTxBody, ..} <- postContract - webChangeAddress - (Just webExtraAddresses) - (Just webCollateralUtxos) - Web.PostContractsRequest - { tags = mempty - , metadata = mempty - , version = Web.V1 - , roles = Nothing - , contract = V1.Close - , minUTxODeposit = 2_000_000 - } - - createTx <- liftIO $ signShelleyTransaction' createTxBody signingKeys - putContract contractId createTx - _ <- waitUntilConfirmed (\Web.ContractState{status} -> status) $ getContract contractId - pure contractId - -signShelleyTransaction' :: Web.TextEnvelope -> [ShelleyWitnessSigningKey] -> IO Web.TextEnvelope -signShelleyTransaction' Web.TextEnvelope{..} wits = do - let te = TextEnvelope { teType = TextEnvelopeType (T.unpack teType), teDescription = TextEnvelopeDescr (T.unpack teDescription), teRawCBOR = Web.unBase16 teCborHex } - txBody <- case deserialiseFromTextEnvelope (AsTxBody AsBabbage) te of - Left err -> fail $ show err - Right a -> pure a - pure case serialiseToTextEnvelope Nothing $ signShelleyTransaction txBody wits of - TextEnvelope (TextEnvelopeType ty) _ bytes -> Web.TextEnvelope (T.pack ty) "" $ Web.Base16 bytes - -waitUntilConfirmed :: MonadIO m => (a -> Web.TxStatus) -> m a -> m a -waitUntilConfirmed getStatus getResource = do - resource <- getResource - case getStatus resource of - Web.Confirmed -> pure resource - _ -> do - liftIO $ threadDelay 1000 - waitUntilConfirmed getStatus getResource