Merge pull request #83 from input-output-hk/rvl/56/test-request

Port integration tests Request module from old codebase

.weeder.yaml

@@ -22,6 +22,24 @@
     - message:
       - name: Module not compiled
       - module: Cardano.Launcher.Windows
+    - message:
+      - name: Weeds exported
+      - module:
+        - name: Test.Integration.Framework.DSL
+        - identifier:
+          - </>
+          - expectSuccess
+          - json
+          - pendingWith
+          - xscenario
+      - module:
+        - name: Test.Integration.Framework.Request
+        - identifier:
+          - $-
+          - ClientError
+          - DecodeFailure
+          - HttpException
+          - successfulRequest
   - section:
     - name: test:unit
     - message:

cardano-wallet.cabal

@@ -154,13 +154,27 @@ test-suite integration
       -Werror
   build-depends:
       base
+    , aeson
     , async
+    , bytestring
     , cardano-wallet
+    , exceptions
     , fmt
+    , generic-lens
     , hspec
+    , hspec-core
+    , http-client
+    , http-api-data
+    , http-types
+    , aeson-qq
+    , lens
+    , mtl
     , process
-    , transformers
     , say
+    , template-haskell
+    , text
+    , transformers
+
   type:
      exitcode-stdio-1.0
   hs-source-dirs:
@@ -171,6 +185,9 @@ test-suite integration
   other-modules:
       Cardano.NetworkLayer.HttpBridgeSpec
       Cardano.Launcher
+      Test.Integration.Framework.DSL
+      Test.Integration.Framework.Request
+      Test.Integration.Framework.Scenario
   if os(windows)
     build-depends: Win32
     other-modules: Cardano.Launcher.Windows

test/integration/Main.hs

@@ -1 +1,65 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+module Main where
+
+import Control.Concurrent
+    ( threadDelay )
+import Control.Concurrent.MVar
+    ( newMVar )
+
+import Data.Aeson
+    ( Value )
+import Data.Text
+    ( Text )
+import Network.HTTP.Client
+    ( Manager, defaultManagerSettings, newManager )
+import Prelude
+import System.Process
+    ( proc, withCreateProcess )
+import Test.Hspec
+    ( beforeAll, describe, hspec )
+
+import qualified Data.Text as T
+
+import Test.Integration.Framework.DSL
+    ( Context (..)
+    , Scenarios
+    , expectError
+    , request
+    , request_
+    , scenario
+    , verify
+    )
+import Test.Integration.Framework.Request
+    ( RequestException (..) )
+
+import qualified Cardano.NetworkLayer.HttpBridgeSpec as HttpBridge
+
+main :: IO ()
+main = do
+    hspec $ do
+        describe "Cardano.NetworkLayer.HttpBridge" HttpBridge.spec
+
+        beforeAll (withWallet (newMVar . Context ())) $ do
+            describe "Integration test framework" dummySpec
+
+-- Runs the wallet server only. The API is not implemented yet, so this is
+-- basically a placeholder until then.
+withWallet :: ((Text, Manager) -> IO a) -> IO a
+withWallet action = do
+    let launch = proc "cardano-wallet-server" []
+        baseURL = T.pack ("http://localhost:8090/")
+    manager <- newManager defaultManagerSettings
+    withCreateProcess launch $ \_ _ _ _ph -> do
+        threadDelay 1000000
+        action (baseURL, manager)
+
+-- Exercise the request functions, which just fail at the moment.
+dummySpec :: Scenarios Context
+dummySpec = do
+    scenario "Try the API which isn't implemented yet" $ do
+        response <- request ("GET", "api/wallets") Nothing
+        verify (response :: Either RequestException Value)
+            [ expectError
+            ]
+
+    scenario "request_ function is always successful" $ do
+        request_ ("GET", "api/xyzzy") Nothing

test/integration/Test/Integration/Framework/DSL.hs

@@ -0,0 +1,157 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Test.Integration.Framework.DSL
+    (
+    -- * Scenario
+      scenario
+    , xscenario
+    , pendingWith
+    , Scenarios
+    , Context(..)
+
+    -- * Steps
+    , request
+    , request_
+    , successfulRequest
+    , verify
+
+    -- * Expectations
+    , expectSuccess
+    , expectError
+    , RequestException(..)
+
+    -- * Helpers
+    , ($-)
+    , (</>)
+    , (!!)
+    , json
+    ) where
+
+import Prelude hiding
+    ( fail )
+
+import Control.Concurrent.MVar
+    ( MVar )
+import Control.Monad.Fail
+    ( MonadFail (..) )
+import Control.Monad.IO.Class
+    ( MonadIO, liftIO )
+import Data.Aeson.QQ
+    ( aesonQQ )
+import Data.Function
+    ( (&) )
+import Data.List
+    ( (!!) )
+import Data.Text
+    ( Text )
+import GHC.Generics
+    ( Generic )
+import Language.Haskell.TH.Quote
+    ( QuasiQuoter )
+import Network.HTTP.Client
+    ( Manager )
+import Test.Hspec.Core.Spec
+    ( SpecM, it, xit )
+
+import qualified Test.Hspec.Core.Spec as H
+
+import Test.Integration.Framework.Request
+    ( RequestException (..), request, request_, successfulRequest, ($-) )
+import Test.Integration.Framework.Scenario
+    ( Scenario )
+import Web.HttpApiData
+    ( ToHttpApiData (..) )
+
+--
+-- SCENARIO
+--
+
+data Context = Context
+    { _hlint :: ()
+        -- ^ Something to stop hlint complaining
+    , _manager
+        :: (Text, Manager)
+        -- ^ The underlying BaseUrl and Manager used by the Wallet Client
+    } deriving (Generic)
+
+
+-- | Just a type-alias to 'SpecM', like 'scenario'. Ultimately, everything is
+-- made in such way that we can use normal (albeit lifted) HSpec functions and
+-- utilities if needed (and rely on its CLI as well when needed).
+type Scenarios ctx = SpecM (MVar ctx) ()
+
+-- | Just a slightly-specialized alias for 'it' to help lil'GHC.
+scenario
+    :: String
+    -> Scenario Context IO ()
+    -> Scenarios Context
+scenario = it
+
+xscenario
+    :: String
+    -> Scenario Context IO ()
+    -> Scenarios Context
+xscenario = xit
+
+-- | Lifted version of `H.pendingWith` allowing for temporarily skipping
+-- scenarios from execution with a reason, like:
+--
+--      scenario title $ do
+--          pendingWith "This test fails due to bug #213"
+--          test
+pendingWith
+    :: (MonadIO m, MonadFail m)
+    => String
+    -> m ()
+pendingWith = liftIO . H.pendingWith
+
+-- | Apply 'a' to all actions in sequence
+verify :: (Monad m) => a -> [a -> m ()] -> m ()
+verify a = mapM_ (a &)
+
+
+-- | Expect an errored response, without any further assumptions
+expectError
+    :: (MonadIO m, MonadFail m, Show a)
+    => Either RequestException a
+    -> m ()
+expectError = \case
+    Left _  -> return ()
+    Right a -> wantedErrorButSuccess a
+
+
+-- | Expect a successful response, without any further assumptions
+expectSuccess
+    :: (MonadIO m, MonadFail m, Show a)
+    => Either RequestException a
+    -> m ()
+expectSuccess = \case
+    Left e  -> wantedSuccessButError e
+    Right _ -> return ()
+
+wantedSuccessButError
+    :: (MonadFail m, Show e)
+    => e
+    -> m void
+wantedSuccessButError =
+    fail . ("expected a successful response but got an error: " <>) . show
+
+wantedErrorButSuccess
+    :: (MonadFail m, Show a)
+    => a
+    -> m void
+wantedErrorButSuccess =
+    fail . ("expected an error but got a successful response: " <>) . show
+
+
+--
+-- HELPERS
+--
+
+json :: QuasiQuoter
+json = aesonQQ
+
+infixr 5 </>
+(</>) :: ToHttpApiData a => Text -> a -> Text
+base </> next = mconcat [base, "/", toQueryParam next]