port-utils (empty) → 0.1.0.0

raw patch · 9 files changed

+365/−0 lines, 9 filesdep +asyncdep +basedep +hspecsetup-changed

Dependencies added: async, base, hspec, network, port-utils, stm

Files

• ChangeLog.md +2/−0
• LICENSE +30/−0
• README.md +35/−0
• Setup.hs +2/−0
• port-utils.cabal +64/−0
• src/Network/Socket/Free.hs +22/−0
• src/Network/Socket/Wait.hs +122/−0
• test/Spec.hs +1/−0
• test/Tests/Network/Socket/WaitSpec.hs +87/−0

@@ -0,0 +1,2 @@+# Changelog for wait-on-port+- 0.0.0.1 First version

@@ -0,0 +1,30 @@+Copyright Jonathan Fischoff (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,35 @@+# port-utilities++## openFreePort++This is another version of `warp`'s `openFreePort` function. Nice if you don't already depend on `warp`.++`openFreePort` returns a socket on random port and the port it has been bound to.++```haskell+openFreePort :: IO (Int, Socket)+```++## wait++`wait` will attempt to connect to a host and port until successful. Between each unsuccessful attempt it sleeps for 10 ms++Here is an example of the primary function:++```haskell+import Network.Socket.Wait (wait)++void $ forkIO $ Warp.run 7000 app+-- Wait for the server to start listening on the socket+wait "127.0.0.1" 7000+-- Communicate with the server+...+```++In bash one could write:++```bash+while ! nc -z localhost 7000 ; do sleep 0.01 ; done+```++The above was copied from this stackoverflow answer https://stackoverflow.com/a/50008755

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,64 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 1ad31dac471f46cb9662477c2482898df6c968ddb94a409cfd8cdd7ec870c4a1++name:           port-utils+version:        0.1.0.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 free port will @warp@'s @openFreePort@+ .+ @wait@ will attempt to connect to given host and port until successful.+ .+homepage:       https://github.com/jfischoff/port-utilities#readme+bug-reports:    https://github.com/jfischoff/port-utilities/issues+author:         Jonathan Fischoff+maintainer:     jonathangfischoff@gmail.com+copyright:      2018 Jonathan Fischoff+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/jfischoff/port-utilities++library+  exposed-modules:+      Network.Socket.Free+      Network.Socket.Wait+  other-modules:+      Paths_port_utils+  hs-source-dirs:+      src+  default-extensions: ScopedTypeVariables RecordWildCards LambdaCase+  build-depends:+      base >=4.7 && <5+    , network+  default-language: Haskell2010++test-suite unit-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Tests.Network.Socket.WaitSpec+      Paths_port_utils+  hs-source-dirs:+      test+  default-extensions: ScopedTypeVariables RecordWildCards LambdaCase+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      async+    , base >=4.7 && <5+    , hspec+    , network+    , port-utils+    , stm+  default-language: Haskell2010

@@ -0,0 +1,22 @@+module Network.Socket.Free (openFreePort) 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++-- | Open a TCP socket on a random free port. This is like 'warp''s+--   openFreePort.+openFreePort :: IO (Int, N.Socket)+openFreePort =+  E.bracketOnError (N.socket N.AF_INET N.Stream N.defaultProtocol) N.close+    $ \sock -> do+      N.bind sock $ N.SockAddrInet 0 $ N.tupleToHostAddress (127,0,0,1)+      N.getSocketName sock >>= \case+        N.SockAddrInet port _ -> pure (fromIntegral port, sock)+        addr -> E.throwIO+          $ Error.mkIOError Error.userErrorType+            (  "openFreePort was unable to create socket with a SockAddrInet. "+            <> "Got " <> show addr+            )+            Nothing+            Nothing

@@ -0,0 +1,122 @@+module Network.Socket.Wait+  ( -- * Simple Wait Api+    wait+    -- * Advanced Wait Api+  , waitWith+  , EventHandlers (..)+  , defaultDelay+  ) where+import qualified Network.Socket as N+import qualified Control.Concurrent as C+import qualified Control.Exception as E++-------------------------------------------------------------------------------+-- Simple Api+-------------------------------------------------------------------------------++-- | 'wait' will retry to connect to the given host and port repeated every+-- 10 milliseconds until it is successful. It will throw an 'IOError' if the+-- host cannot be resolved.+--+-- A typical use case is to call 'wait' in test code to wait for a server to+-- start before trying to connect. For example:+--+-- @+--    void $ forkIO $ Warp.run 7000 app+--    -- Wait for the server to start listening on the socket+--    wait "127.0.0.1" 7000+--    -- Communicate with the server+-- @+--+-- If you would like to control the delay or understand how many connection+-- attempts were made use 'waitWith'.+--+-- Since 0.0.0.1+wait :: String+     -- ^ Host+     -> Int+     -- ^ Port+     -> IO ()+wait = waitWith mempty defaultDelay++-------------------------------------------------------------------------------+-- Advanced Api+-------------------------------------------------------------------------------+-- | The default delay between retries is 10000 microseconds (10 ms)+defaultDelay :: Int+defaultDelay = 10000++-- | The 'EventHandlers' is a record of 'IO' actions that are called when+--   interesting events occur in the lifecycle of the 'waitWith' loop.+--   One can pass in custom 'EventHandlers' values to implement logging+--   and other forms of instrumentation.+--+--   For example for debug one could print out each step using:+--+-- @+--    printHandlers = EventHandlers+--      { createdSocket = putStrLn "createdSocket"+--      , delaying      = putStrLn "delaying"+--      , restarting    = putStrLn "restarting"+--      }+-- @+--+data EventHandlers = EventHandlers+  { createdSocket :: IO ()+  -- ^ Called after the socket is created+  , delaying      :: IO ()+  -- ^ Called after a failed attempt to connect before the thread+  -- is put to sleep.+  , restarting    :: IO ()+  -- ^ Called before a recursive call to restart the connection attempt+  }++instance Semigroup EventHandlers where+  x <> y = EventHandlers+    { createdSocket = createdSocket x <> createdSocket y+    , delaying      = delaying      x <> delaying      y+    , restarting    = restarting    x <> restarting    y+    }++instance Monoid EventHandlers where+  mempty  = EventHandlers mempty mempty mempty+  mappend = (<>)++-- | Advanced usage. In most situations calling 'wait' will suffice. This allows+-- one to customize the delay between retries and debug the behavior of the+-- function. 'wait' is defined as+--+-- @+--    wait = waitWith mempty defaultDelay+-- @+--+-- Since 0.0.0.1+waitWith :: EventHandlers+         -- ^ A record of IO actions that are called during sp+         -> Int+         -- ^ Microseconds to delay+         -> String+         -- ^ Host+         -> Int+         -- ^ Port+         -> IO ()+waitWith eh@EventHandlers {..} delay host port = do+  res <- E.try $ do+    let hints = N.defaultHints { N.addrSocketType = N.Stream }+    -- getAddrInfo returns a non-empty array or throws per the doc+    addr:_ <- N.getAddrInfo (Just hints) (Just host) (Just $ show port)+    E.bracket+      (N.socket (N.addrFamily addr) (N.addrSocketType addr) (N.addrProtocol addr))+      N.close+      $ \sock -> do+        createdSocket+        N.connect sock $ N.addrAddress addr++  case res of+    Left (_ :: E.IOException) -> do+      delaying+      C.threadDelay delay++      restarting+      waitWith eh delay host port+    Right _ -> pure ()

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,87 @@+module Tests.Network.Socket.WaitSpec where+import qualified Network.Socket.Wait 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++main :: IO ()+main = H.hspec spec++data WaitState+  = Start+  | Retried+  | Open+  deriving (Show, Eq)++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++spec :: H.Spec+spec = H.before F.openFreePort $ H.after (N.close . snd) $ H.describe "wait" $ do+  H.it "retries if a socket is not ready" $ \(port, sock) -> do+    -- There is a small race some what might connect to this+    N.close sock++    retryRef <- S.newTVarIO 0++    let retryCount = 2++        handlers = mempty { W.restarting = S.atomically $ S.modifyTVar' retryRef (+1) }++    let start = W.waitWith handlers W.defaultDelay "127.0.0.1" port+    E.bracket (C.forkIO start) C.killThread $ \_ ->+      T.timeout+        (retryCount * W.defaultDelay * 10) -- wait more than long enough+        (S.atomically $ S.check . (==2) =<< S.readTVar retryRef) >>= \case+          Nothing+            -> fail+            $ "timed out waiting for the wait to retry "+            ++ show retryCount+            ++ " times"+          Just _  -> pure ()++  H.it "connects immediantly to socket when it is ready" $ \(port, sock) -> do+    N.listen sock 128++    retryRef <- S.newTVarIO 0++    let handlers = mempty { W.restarting = S.atomically $ S.modifyTVar' retryRef (+1) }++    T.timeout+      (W.defaultDelay * 10) -- wait more than long enough+      (W.waitWith handlers W.defaultDelay "127.0.0.1" port) >>= \case+        Nothing -> fail "timed out waiting to connect"+        Just _  -> S.atomically (S.readTVar retryRef) `H.shouldReturn` 0++  H.it "connects even if the socket is not open at first" $ \(port, sock) -> do+    N.close sock+    retryRef <- S.newTVarIO Start++    let handlers = mempty+          { W.restarting    = S.atomically $ S.writeTVar retryRef Retried+          , W.createdSocket = S.atomically $ S.readTVar retryRef >>= \case+              -- Pass through and first and fail+              Start   -> pure ()+              -- Block until listening+              Retried -> S.retry+              -- Pass through+              Open    -> pure ()+          }++    let start = W.waitWith handlers W.defaultDelay "127.0.0.1" port+    throwTimeout 100000 "waiting for wait to return"+      $ E.bracket (A.async start) A.wait $ \_ -> do+        S.atomically $ S.check . (==Retried) =<< S.readTVar retryRef++        E.bracketOnError (N.socket N.AF_INET N.Stream N.defaultProtocol) N.close+          $ \sock' -> do+            S.atomically $ S.writeTVar retryRef Open+            N.bind sock' $ N.SockAddrInet (fromIntegral port) $ N.tupleToHostAddress (127,0,0,1)+            N.listen sock' 128