From f42245c75cd2eb6bd8b309dff9b47937207fbead Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Thu, 7 Nov 2019 13:15:35 +1000 Subject: [PATCH 1/3] tests: Let ServerSpec error path tests pass on windows --- lib/core/src/Cardano/Wallet/Api/Server.hs | 17 ++++++++++++++-- .../unit/Cardano/Wallet/Api/ServerSpec.hs | 3 +++ .../cardano-wallet-test-utils.cabal | 3 +++ lib/test-utils/src/Test/Utils/Windows.hs | 20 +++++++++++++++++++ nix/.stack.nix/cardano-wallet-test-utils.nix | 2 ++ 5 files changed, 43 insertions(+), 2 deletions(-) create mode 100644 lib/test-utils/src/Test/Utils/Windows.hs diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index d4b3a59888b..cee833f1939 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -205,7 +205,7 @@ import Data.Generics.Internal.VL.Lens import Data.Generics.Labels () import Data.List - ( isSubsequenceOf, sortOn ) + ( isInfixOf, isSubsequenceOf, sortOn ) import Data.Maybe ( fromMaybe, isJust ) import Data.Proxy @@ -270,6 +270,7 @@ import System.IO.Error , isAlreadyInUseError , isDoesNotExistError , isPermissionError + , isUserError ) import System.Random ( getStdRandom, random ) @@ -371,21 +372,33 @@ ioToListenError hostPreference portOpt e -- Usually caused by trying to listen on a privileged port | isPermissionError e = Just ListenErrorOperationNotPermitted - -- Bad hostname + -- Bad hostname -- Linux and Darwin | isDoesNotExistError e = Just (ListenErrorHostDoesNotExist hostPreference) + -- Bad hostname (bind: WSAEOPNOTSUPP) -- Windows + | isUserError e && hasDescription "10045" = + Just (ListenErrorHostDoesNotExist hostPreference) -- Address is valid, but can't be used for listening -- Linux | show (ioeGetErrorType e) == "invalid argument" = Just (ListenErrorInvalidAddress hostPreference) -- Address is valid, but can't be used for listening -- Darwin | show (ioeGetErrorType e) == "unsupported operation" = Just (ListenErrorInvalidAddress hostPreference) + -- Address is valid, but can't be used for listening -- Windows + | isOtherError e && hasDescription "WSAEINVAL" = + Just (ListenErrorInvalidAddress hostPreference) + -- Listening on an unavailable or privileged port -- Windows + | isOtherError e && hasDescription "WSAEACCESS" = + Just (ListenErrorAddressAlreadyInUse (listenPort portOpt)) | otherwise = Nothing where listenPort (ListenOnPort port) = Just port listenPort ListenOnRandomPort = Nothing + isOtherError ex = show (ioeGetErrorType ex) == "failed" + hasDescription text = text `isInfixOf` show e + {------------------------------------------------------------------------------- Core API -------------------------------------------------------------------------------} diff --git a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs index 0e42451cced..2d7679747f7 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs @@ -10,6 +10,8 @@ import Network.Socket ( SockAddr (..), getSocketName, tupleToHostAddress ) import Test.Hspec ( Spec, describe, it, shouldBe, shouldReturn ) +import Test.Utils.Windows + ( skipOnWindows ) spec :: Spec spec = describe "API Server" $ do @@ -40,6 +42,7 @@ spec = describe "API Server" $ do -- assuming we are not running the tests as root it "handles privileged ports" $ do + skipOnWindows "Impossible to uniquely detect this error case" withListeningSocket "127.0.0.1" (ListenOnPort 23) $ \res -> res `shouldBe` Left ListenErrorOperationNotPermitted diff --git a/lib/test-utils/cardano-wallet-test-utils.cabal b/lib/test-utils/cardano-wallet-test-utils.cabal index e20f0df239f..b06093abc7b 100644 --- a/lib/test-utils/cardano-wallet-test-utils.cabal +++ b/lib/test-utils/cardano-wallet-test-utils.cabal @@ -30,6 +30,8 @@ library -Werror build-depends: base + , hspec-core + , hspec-expectations , network , QuickCheck , random-shuffle @@ -40,3 +42,4 @@ library exposed-modules: Test.Utils.Ports Test.Utils.Time + Test.Utils.Windows diff --git a/lib/test-utils/src/Test/Utils/Windows.hs b/lib/test-utils/src/Test/Utils/Windows.hs new file mode 100644 index 00000000000..5c14bebd3e1 --- /dev/null +++ b/lib/test-utils/src/Test/Utils/Windows.hs @@ -0,0 +1,20 @@ +-- | +-- Copyright: © 2018-2019 IOHK +-- License: Apache-2.0 +-- +-- Utility function for making test suites pass on Windows. + +module Test.Utils.Windows + ( skipOnWindows + ) where + +import Prelude + +import Control.Exception (throwIO) +import Test.Hspec.Core.Spec (ResultStatus(..)) +import Test.Hspec.Expectations (Expectation, HasCallStack) +import System.Info (os) +import Control.Monad (when) + +skipOnWindows :: HasCallStack => String -> Expectation +skipOnWindows _reason = when (os == "mingw32") $ throwIO Success diff --git a/nix/.stack.nix/cardano-wallet-test-utils.nix b/nix/.stack.nix/cardano-wallet-test-utils.nix index ae2a69d831b..19df6945552 100644 --- a/nix/.stack.nix/cardano-wallet-test-utils.nix +++ b/nix/.stack.nix/cardano-wallet-test-utils.nix @@ -61,6 +61,8 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: "library" = { depends = [ (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."hspec-core" or (buildDepError "hspec-core")) + (hsPkgs."hspec-expectations" or (buildDepError "hspec-expectations")) (hsPkgs."network" or (buildDepError "network")) (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) (hsPkgs."random-shuffle" or (buildDepError "random-shuffle")) From ee6ab8d2aad7b9eac91d3ba2d15fc9a3f745b149 Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Thu, 7 Nov 2019 13:31:08 +1000 Subject: [PATCH 2/3] tests: Close temp file so that SqliteSpec passes on Windows --- lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs index 742fc302bf4..42296fe5252 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs @@ -140,6 +140,8 @@ import GHC.Conc ( TVar, atomically, newTVarIO, readTVarIO, writeTVar ) import System.Directory ( doesFileExist, removeFile ) +import System.IO + ( hClose ) import System.IO.Error ( isUserError ) import System.IO.Temp @@ -550,7 +552,8 @@ withTestDBFile withTestDBFile action expectations = do logConfig <- defaultConfigTesting trace <- setupTrace (Right logConfig) "connectionSpec" - withSystemTempFile "spec.db" $ \fp _handle -> do + withSystemTempFile "spec.db" $ \fp handle -> do + hClose handle removeFile fp withDBLayer logConfig trace (Just fp) action expectations fp From c8b1e58b4ad641f2ff940b6af150668bf119715c Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 7 Nov 2019 11:23:40 +0100 Subject: [PATCH 3/3] fix stylish-haskell in newly introduced Windows test-utils --- lib/test-utils/src/Test/Utils/Windows.hs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/lib/test-utils/src/Test/Utils/Windows.hs b/lib/test-utils/src/Test/Utils/Windows.hs index 5c14bebd3e1..bc5d85997dc 100644 --- a/lib/test-utils/src/Test/Utils/Windows.hs +++ b/lib/test-utils/src/Test/Utils/Windows.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + -- | -- Copyright: © 2018-2019 IOHK -- License: Apache-2.0 @@ -10,11 +12,16 @@ module Test.Utils.Windows import Prelude -import Control.Exception (throwIO) -import Test.Hspec.Core.Spec (ResultStatus(..)) -import Test.Hspec.Expectations (Expectation, HasCallStack) -import System.Info (os) -import Control.Monad (when) +import Control.Exception + ( throwIO ) +import Control.Monad + ( when ) +import System.Info + ( os ) +import Test.Hspec.Core.Spec + ( ResultStatus (..) ) +import Test.Hspec.Expectations + ( Expectation, HasCallStack ) skipOnWindows :: HasCallStack => String -> Expectation skipOnWindows _reason = when (os == "mingw32") $ throwIO Success