SCP-5029 create common file for web e2e tests

input-output-hk · Mar 17, 2023 · 6f690da · 6f690da
1 parent 130b8ca
commit 6f690da
Show file tree

Hide file tree

Showing 3 changed files with 72 additions and 59 deletions.
diff --git 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
@@ -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
@@ -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