port-utils 0.2.0.0 → 0.2.1.0
raw patch · 4 files changed
+97/−35 lines, 4 files
Files
- port-utils.cabal +8/−11
- src/Network/Socket/Free.hs +15/−2
- src/Network/Socket/Wait/Internal.hs +9/−2
- test/Tests/Network/Socket/WaitSpec.hs +65/−20
port-utils.cabal view
@@ -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
src/Network/Socket/Free.hs view
@@ -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
src/Network/Socket/Wait/Internal.hs view
@@ -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.
test/Tests/Network/Socket/WaitSpec.hs view
@@ -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