diff --git a/port-utils.cabal b/port-utils.cabal --- a/port-utils.cabal +++ b/port-utils.cabal @@ -1,18 +1,15 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- --- hash: 86eb2c8b9fe7b1d2f8dcce2f6eae318261062f193924cf7fe0119f3191c4088b +-- hash: ea761433564c3d41b9bd1c895dc3c46f05ee75b16c4e1868c6bdade55f4afaee name: port-utils -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Utilities for creating and waiting on ports -description: Utilities for creating and waiting on ports. - . - @openFreePort@ will create a socket bound to a random port (like @warp@'s @openFreePort@). - . - @wait@ will attempt to connect to given host and port repeatedly until successful. - . +description: Utilities for creating and waiting on ports. . @openFreePort@ will create a socket bound to a random port (like @warp@'s @openFreePort@). . @wait@ will attempt to connect to given host and port repeatedly until successful. . homepage: https://github.com/jfischoff/port-utils#readme bug-reports: https://github.com/jfischoff/port-utils/issues author: Jonathan Fischoff @@ -21,10 +18,9 @@ license: BSD3 license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: - ChangeLog.md README.md + ChangeLog.md source-repository head type: git @@ -40,6 +36,7 @@ hs-source-dirs: src default-extensions: ScopedTypeVariables RecordWildCards LambdaCase UndecidableInstances TypeSynonymInstances FlexibleInstances + ghc-options: -Wall build-depends: base >=4.7 && <5 , network diff --git a/src/Network/Socket/Free.hs b/src/Network/Socket/Free.hs --- a/src/Network/Socket/Free.hs +++ b/src/Network/Socket/Free.hs @@ -1,6 +1,5 @@ -module Network.Socket.Free (openFreePort) where +module Network.Socket.Free (openFreePort, getFreePort) where import qualified Network.Socket as N -import qualified Control.Concurrent as C import qualified Control.Exception as E import qualified System.IO.Error as Error @@ -22,3 +21,17 @@ ) Nothing Nothing + +-- | Open a TCP socket, get its port and close the socket. +-- Useful when you have an external service that needs a fresh port. +-- +-- There is a small race condition present: +-- It's possible to get a free port only for it to +-- be bound by some other process or thread before used +-- +-- Since 0.2.1 +getFreePort :: IO Int +getFreePort = do + (port, socket) <- openFreePort + N.close socket + pure port diff --git a/src/Network/Socket/Wait/Internal.hs b/src/Network/Socket/Wait/Internal.hs --- a/src/Network/Socket/Wait/Internal.hs +++ b/src/Network/Socket/Wait/Internal.hs @@ -15,6 +15,7 @@ import qualified Network.Socket as N import qualified Control.Concurrent as C import qualified Control.Exception as E +import qualified System.IO.Error as IOE ------------------------------------------------------------------------------- -- Simple Api @@ -96,7 +97,7 @@ -- wait = waitWith mempty defaultDelay -- @ -- --- Since 0.0.0.1 +-- Since 0.2.0.0 waitWith :: EventHandlers IO -- ^ A record of IO actions that are called during sp -> Int @@ -107,7 +108,13 @@ -- ^ Port -> IO () waitWith eh delay host port - = waitM eh (C.threadDelay delay) (connectAction host port) + = if port < 1 + then E.throwIO $ IOE.mkIOError + IOE.illegalOperationErrorType + ("Invalid port! " <> show port <> " is less than 1") + Nothing + Nothing + else waitM eh (C.threadDelay delay) (connectAction host port) -- | This function loops if the second argument returns 'False'. Between the -- recursive calls it will call it's first argument. diff --git a/test/Tests/Network/Socket/WaitSpec.hs b/test/Tests/Network/Socket/WaitSpec.hs --- a/test/Tests/Network/Socket/WaitSpec.hs +++ b/test/Tests/Network/Socket/WaitSpec.hs @@ -1,15 +1,16 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} module Tests.Network.Socket.WaitSpec where import qualified Network.Socket.Wait.Internal as W import qualified Network.Socket.Free as F import qualified Network.Socket as N import qualified Control.Concurrent as C -import qualified Control.Concurrent.STM as S import qualified Control.Exception as E import qualified Test.Hspec as H import qualified System.Timeout as T import qualified Control.Concurrent.Async as A import qualified Control.Monad.Trans.State as St +import qualified Control.Monad as M instance Monad m => Semigroup (St.StateT s m ()) where (<>) = (>>) @@ -18,40 +19,81 @@ mempty = pure () mappend = (<>) -main :: IO () -main = H.hspec spec +blockPort :: N.Socket -> IO () +blockPort sock = E.bracket F.openFreePort (N.close . snd) $ \(port1, sock1) -> do + N.listen sock1 1 + N.connect sock $ N.SockAddrInet (fromIntegral port1) $ N.tupleToHostAddress (127,0,0,1) + M.forever $ C.threadDelay 100000000 -throwTimeout :: Int -> String -> IO a -> IO a -throwTimeout delay msg action = T.timeout delay action >>= \case - Nothing -> fail $ "timed out " ++ msg - Just x -> pure x +testAtFirstUnavailable :: String -> (IO () -> Int -> IO ()) -> H.SpecWith (Int, N.Socket) +testAtFirstUnavailable message test = H.describe (message ++ " when the port is") $ do + H.it "free" $ \(port, sock) -> N.close sock >> test (pure ()) port + H.it "is bound and CLOSED" $ \(port, sock) -> test (N.close sock) port + H.it "is in a state other than listening" $ \(port, sock) -> + A.withAsync (blockPort sock) $ \thread -> test (A.cancel thread >> N.close sock) port +testUnavailable :: String -> (Int -> IO ()) -> H.SpecWith (Int, N.Socket) +testUnavailable message = testAtFirstUnavailable message . const + +withListeningSocket :: Int -> IO () -> IO () +withListeningSocket port action = E.bracket (N.socket N.AF_INET N.Stream N.defaultProtocol) N.close $ \sock -> do + N.setSocketOption sock N.ReuseAddr 1 + (M.void $ N.bind sock $ N.SockAddrInet (fromIntegral port) $ N.tupleToHostAddress (127,0,0,1)) + `E.onException` (putStrLn "bad stuff") + N.listen sock 1 + action + spec :: H.Spec spec = do + -- Black box tests of wait with all the caveats. Just a little bit of sanity testing. + H.describe "wait" $ H.before F.openFreePort $ H.after (N.close . snd) $ do + testUnavailable "never returns" $ \port -> do + T.timeout 100000 (W.wait "127.0.0.1" port) >>= \case + Nothing -> pure () + Just () -> fail "wait returned! I should have blocked forever!" + + H.it "does connect if port is available" $ \(port, sock) -> do + N.listen sock 128 + W.wait "127.0.0.1" port + + testAtFirstUnavailable "at first does not return" $ \unblock port -> do + A.withAsync (W.wait "127.0.0.1" port) $ \thread -> do + C.threadDelay 100000 + -- Ensure wait is blocking the thread from completing + A.poll thread >>= \case + Just _ -> fail "wait returned when the port was unavailable!" + Nothing -> pure () + -- Free the port + unblock + -- Ensure wait is able to connect when the socket is in a listening state. + withListeningSocket port $ A.wait thread + + H.it "throw if the port is invalid" $ \(_, _) -> + W.wait "localhost" 0 `H.shouldThrow` (\(_ :: IOError) -> True) + + H.it "throws if the host does not exist" $ \(_, _) -> + W.wait "invalid." 3000 `H.shouldThrow` (\(_ :: IOError) -> True) + H.describe "connectAction" $ H.before F.openFreePort $ H.after (N.close . snd) $ do - H.it "returns False if it fails to connect" $ \(port, sock) -> do - N.close sock - -- There is a small race that another process might bind to this port + testUnavailable "return False" $ \port -> W.connectAction "127.0.0.1" port `H.shouldReturn` False H.it "returns True if it connects" $ \(port, sock) -> do N.listen sock 128 - W.connectAction "127.0.0.1" port `H.shouldReturn` True - H.it "returns True if connects after failing" $ \(port, sock) -> do - N.close sock - + testAtFirstUnavailable "returns True if connects after failing" $ \unblock port-> do W.connectAction "127.0.0.1" port `H.shouldReturn` False - E.bracket (N.socket N.AF_INET N.Stream N.defaultProtocol) N.close $ \sock' -> do - N.bind sock' $ N.SockAddrInet (fromIntegral port) $ N.tupleToHostAddress (127,0,0,1) - N.listen sock' 128 + unblock + withListeningSocket port $ W.connectAction "127.0.0.1" port `H.shouldReturn` True - H.it "throws if the host does not exist" $ \(_, _) -> do - W.connectAction "invalid." 3000 `H.shouldThrow` (\(_ :: IOError) -> True) +#ifdef linux_HOST_OS + H.it "returns false if there is a connection timeout" $ \_ -> do + W.connectAction "93.184.216.34" 80 `H.shouldReturn` False +#endif H.describe "waitM" $ do H.it "returns immediantly if the action returns True" $ @@ -63,4 +105,7 @@ 0 -> St.put 1 >> pure False _ -> St.put 2 >> pure True - flip St.execState 0 (W.waitM mempty (pure ()) theAction) `H.shouldBe` 2 + flip St.execState 0 (W.waitM mempty (pure ()) theAction) `H.shouldBe` (2 :: Int) + +main :: IO () +main = H.hspec spec