{-# LANGUAGE ScopedTypeVariables #-}
module Hedgehog.Extras.Test.Network
( doesFileExists
, isPortOpen
, doesSocketExist
, assertFileExists
, assertPortOpen
, assertSocketExists
, doesSprocketExist
) where
import Control.Exception (IOException, try)
import Control.Monad
import Control.Monad.IO.Class (MonadIO)
import Data.Bool
import Data.Either
import Data.Function
import Data.Int
import Data.Semigroup
import GHC.Stack (HasCallStack)
import Hedgehog (MonadTest)
import Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket, sprocketSystemName)
import System.IO (FilePath)
import Text.Show
import qualified GHC.Stack as GHC
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Stock.IO.Network.NamedPipe as IO
import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO
import qualified Hedgehog.Extras.Stock.OS as OS
import qualified Hedgehog.Extras.Test.Base as H
import qualified System.Directory as IO
doesFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool
doesFileExists :: FilePath -> m Bool
doesFileExists = m Bool -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m Bool -> m Bool) -> (FilePath -> m Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> m Bool
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO Bool -> m Bool) -> (FilePath -> IO Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
IO.doesFileExist
isPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m Bool
isPortOpen :: Int -> m Bool
isPortOpen Int
port = (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ do
FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.note_ (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Port: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
port
IO Bool -> m Bool
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Int -> IO Bool
IO.isPortOpen Int
port
doesSocketExist :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool
doesSocketExist :: FilePath -> m Bool
doesSocketExist = m Bool -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m Bool -> m Bool) -> (FilePath -> m Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> m Bool
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO Bool -> m Bool) -> (FilePath -> IO Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
IO.doesSocketExist
assertFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertFileExists :: FilePath -> m ()
assertFileExists = m () -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => m Bool -> m ()
H.assertM (m Bool -> m ()) -> (FilePath -> m Bool) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m Bool
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Bool
doesFileExists
assertPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m ()
assertPortOpen :: Int -> m ()
assertPortOpen = m () -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m () -> m ()) -> (Int -> m ()) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => m Bool -> m ()
H.assertM (m Bool -> m ()) -> (Int -> m Bool) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m Bool
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
Int -> m Bool
isPortOpen
assertSocketExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertSocketExists :: FilePath -> m ()
assertSocketExists = m () -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Bool -> m ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => m Bool -> m ()
H.assertM (m Bool -> m ()) -> (FilePath -> m Bool) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m Bool
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Bool
doesSocketExist
doesSprocketExist :: (MonadTest m, MonadIO m, HasCallStack) => Sprocket -> m Bool
doesSprocketExist :: Sprocket -> m Bool
doesSprocketExist Sprocket
socket = (HasCallStack => m Bool) -> m Bool
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m Bool) -> m Bool)
-> (HasCallStack => m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Either IOException Bool
waitResult <- IO (Either IOException Bool) -> m (Either IOException Bool)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO (Either IOException Bool) -> m (Either IOException Bool))
-> (IO Bool -> IO (Either IOException Bool))
-> IO Bool
-> m (Either IOException Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> IO (Either IOException Bool)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Bool -> m (Either IOException Bool))
-> IO Bool -> m (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ if Bool
OS.isWin32
then FilePath -> IO Bool
IO.doesNamedPipeExist (Sprocket -> FilePath
sprocketSystemName Sprocket
socket)
else FilePath -> IO Bool
IO.doesSocketExist (Sprocket -> FilePath
sprocketSystemName Sprocket
socket)
case Either IOException Bool
waitResult of
Right Bool
result -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result
Left (IOException
e :: IOException) -> do
FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False