hedgehog-extras 0.6.1.0 → 0.6.2.0

raw patch · 5 files changed

+117/−2 lines, 5 filesdep +hedgehog-extrasdep +tastydep +tasty-hedgehogPVP ok

version bump matches the API change (PVP)

Dependencies added: hedgehog-extras, tasty, tasty-hedgehog

API changes (from Hackage documentation)

Files

• hedgehog-extras.cabal +24/−2
• src/Hedgehog/Extras/Stock/IO/Network/Port.hs +53/−0
• src/Hedgehog/Extras/Test/File.hs +13/−0
• test/Hedgehog/Extras/Stock/IO/Network/PortSpec.hs +26/−0
• test/hedgehog-extras-test.hs +1/−0

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:                   hedgehog-extras-version:                0.6.1.0+version:                0.6.2.0 synopsis:               Supplemental library for hedgehog description:            Supplemental library for hedgehog. category:               Test@@ -27,17 +27,21 @@ common exceptions                   { build-depends: exceptions                                                   } common filepath                     { build-depends: filepath                                                     } common hedgehog                     { build-depends: hedgehog                                                     }+common hedgehog-quickcheck          { build-depends: hedgehog-quickcheck                                          } common http-conduit                 { build-depends: http-conduit                                                 } common lifted-async                 { build-depends: lifted-async                                                 } common lifted-base                  { build-depends: lifted-base                                                  }-common monad-control                { build-depends: monad-control                                                } common mmorph                       { build-depends: mmorph                                                       }+common monad-control                { build-depends: monad-control                                                } common mtl                          { build-depends: mtl                                                          } common network                      { build-depends: network                                                      } common process                      { build-depends: process                                                      } common resourcet                    { build-depends: resourcet                                                    } common stm                          { build-depends: stm                                                          } common tar                          { build-depends: tar                              <  0.6                      }+common tasty                        { build-depends: tasty                                                        }+common tasty-hedgehog               { build-depends: tasty-hedgehog                                               }+common tasty-quickcheck             { build-depends: tasty-quickcheck                                             } common temporary                    { build-depends: temporary                                                    } common text                         { build-depends: text                                                         } common time                         { build-depends: time                             >= 1.9.1                    }@@ -47,6 +51,8 @@ common yaml                         { build-depends: yaml                                                         } common zlib                         { build-depends: zlib                                                         } +common hedgehog-extras              { build-depends: hedgehog-extras                                              }+ common Win32   if os(windows)     build-depends:      Win32   >= 2.5.4.1@@ -109,6 +115,7 @@                         Hedgehog.Extras.Stock.CallStack                         Hedgehog.Extras.Stock.IO.File                         Hedgehog.Extras.Stock.IO.Network.NamedPipe+                        Hedgehog.Extras.Stock.IO.Network.Port                         Hedgehog.Extras.Stock.IO.Network.Socket                         Hedgehog.Extras.Stock.IO.Network.Sprocket                         Hedgehog.Extras.Stock.IO.Process@@ -124,3 +131,18 @@                         Hedgehog.Extras.Test.MonadAssertion                         Hedgehog.Extras.Test.Network                         Hedgehog.Extras.Test.Process++test-suite hedgehog-extras-test+  import:               base, project-config,+                        hedgehog,+                        hedgehog-extras,+                        network,+                        tasty,+                        tasty-hedgehog,+  hs-source-dirs:       test+  main-is:              hedgehog-extras-test.hs+  type:                 exitcode-stdio-1.0++  other-modules:        Hedgehog.Extras.Stock.IO.Network.PortSpec++  build-tool-depends:   tasty-discover:tasty-discover

@@ -0,0 +1,53 @@+{-# LANGUAGE TypeApplications #-}++module Hedgehog.Extras.Stock.IO.Network.Port+  ( randomPort+  , reserveRandomPort+  , portInUse+  ) where++import           Control.Exception+import           Control.Monad (Monad (..), MonadFail (..))+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Resource+import           Data.Bool+import           Data.Either+import           Data.Function+import           Network.Socket++-- | Return a random available port on a specified host address+randomPort :: ()+  => MonadIO m+  => MonadFail m+  => HostAddress+  -> m PortNumber+randomPort hostAddress = do+  sock <- liftIO $ socket AF_INET Stream defaultProtocol+  liftIO $ bind sock $ SockAddrInet defaultPort hostAddress+  SockAddrInet port _ <- liftIO $ getSocketName sock+  liftIO $ close sock+  return port++reserveRandomPort :: ()+  => MonadFail m+  => MonadResource m+  => HostAddress+  -> m (ReleaseKey, PortNumber)+reserveRandomPort hostAddress = do+  sock <- liftIO $ socket AF_INET Stream defaultProtocol+  liftIO $ bind sock $ SockAddrInet defaultPort hostAddress+  SockAddrInet port _ <- liftIO $ getSocketName sock+  releaseKey <- register $ close sock+  return (releaseKey, port)++-- | Check if a port is in use on a specified host address+portInUse :: ()+  => MonadIO m+  => HostAddress+  -> PortNumber+  -> m Bool+portInUse hostAddress pn = do+  sock <- liftIO $ socket AF_INET Stream defaultProtocol+  result <- liftIO $ try @SomeException $ bind sock (SockAddrInet pn hostAddress)+  liftIO $ close sock+  return $ either (const False) (const True) result

@@ -47,6 +47,7 @@   , assertEndsWithSingleNewline    , appendFileTimeDelta+  , assertDirectoryMissing   ) where  import           Control.Applicative (Applicative (..))@@ -336,3 +337,15 @@   baseTime <- H.noteShowIO DTC.getCurrentTime   let delay = DTC.diffUTCTime baseTime offsetTime   appendFile filePath $ show @DTC.NominalDiffTime delay <> "\n"++-- | Asserts that the given directory exists.+assertDirectoryExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()+assertDirectoryExists dir = GHC.withFrozenCallStack $ do+  exists <- H.evalIO $ IO.doesDirectoryExist dir+  unless exists $ H.failWithCustom GHC.callStack Nothing ("Directory '" <> dir <> "' does not exist on the file system.")++-- | Asserts that the given directory is missing.+assertDirectoryMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()+assertDirectoryMissing dir = GHC.withFrozenCallStack $ do+  exists <- H.evalIO $ IO.doesDirectoryExist dir+  when exists $ H.failWithCustom GHC.callStack Nothing ("Directory '" <> dir <> "' does exist on the file system.")

@@ -0,0 +1,26 @@+module Hedgehog.Extras.Stock.IO.Network.PortSpec+  ( hprop_randomPort+  ) where++import           Data.Function+import           Data.Semigroup+import           Hedgehog (Property)+import qualified Hedgehog as H+import qualified Hedgehog.Extras as H+import qualified Hedgehog.Extras.Stock.IO.Network.Port as IO+import qualified Network.Socket as N+import           Text.Show++hprop_randomPort :: Property+hprop_randomPort =+  H.propertyOnce $ do+    let hostAddress = N.tupleToHostAddress (0, 0, 0, 0)++    pn <- H.evalIO $ IO.randomPort hostAddress++    H.note_ $ "Allocated port: " <> show pn++    -- Check that the port is available and can be bound to a socket.+    sock <- H.evalIO $ N.socket N.AF_INET N.Stream N.defaultProtocol+    H.evalIO $ N.bind sock $ N.SockAddrInet pn hostAddress+    H.evalIO $ N.close sock

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-}