{-# LANGUAGE ScopedTypeVariables #-}

{- HLINT ignore "Redundant flip" -}

module Hedgehog.Extras.Test.Network
  ( doesFileExists
  , isPortOpen
  , doesSocketExist
  , assertPortOpen
  , assertSocketExists
  , doesSprocketExist
  , downloadToFile
  , downloadAndExtractGithubCommitToTemp
  ) 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.Functor
import           Data.Int
import           Data.Semigroup
import           GHC.Stack (HasCallStack)
import           Hedgehog (MonadTest)
import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket, sprocketSystemName)
import           Prelude (String)
import           System.FilePath ((</>))
import           System.IO (FilePath)
import           Text.Show

import qualified Codec.Archive.Tar as TAR
import qualified Codec.Archive.Tar.Check as TAR
import qualified Codec.Compression.GZip as GZ
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as List
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 Network.HTTP.Conduit as HTTP
import qualified System.Directory as H
import qualified System.Directory as IO
import qualified System.FilePath as FP

-- | Test if a file exists
doesFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool
doesFileExists :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Bool
doesFileExists = m Bool -> m Bool
(HasCallStack => 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

-- | Test if a port is open
isPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m Bool
isPortOpen :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
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

-- | Test if a socket file exists
doesSocketExist :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Bool
doesSocketExist :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Bool
doesSocketExist = m Bool -> m Bool
(HasCallStack => 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

-- | Assert that a port is open
assertPortOpen :: (MonadTest m, MonadIO m, HasCallStack) => Int -> m ()
assertPortOpen :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
Int -> m ()
assertPortOpen = m () -> m ()
(HasCallStack => 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

-- | Assert that a socket file exists is open
assertSocketExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertSocketExists :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertSocketExists = m () -> m ()
(HasCallStack => 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

-- | Test if the sprocket exists
doesSprocketExist :: (MonadTest m, MonadIO m, HasCallStack) => Sprocket -> m Bool
doesSprocketExist :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
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 a. a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Download from a URl to a file
downloadToFile :: (MonadTest m, MonadIO m, HasCallStack) => String -> FilePath -> m ()
downloadToFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
downloadToFile FilePath
url FilePath
path = (HasCallStack => m ()) -> m ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
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
"Downloading " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
  IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
HTTP.simpleHttp FilePath
url IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
path

tarErrors :: TAR.Entries (Either TAR.FormatError TAR.TarBombError) -> [Either TAR.FormatError TAR.TarBombError]
tarErrors :: Entries (Either FormatError TarBombError)
-> [Either FormatError TarBombError]
tarErrors Entries (Either FormatError TarBombError)
entries = (Entry
 -> ([Either FormatError TarBombError]
     -> [Either FormatError TarBombError])
 -> [Either FormatError TarBombError]
 -> [Either FormatError TarBombError])
-> ([Either FormatError TarBombError]
    -> [Either FormatError TarBombError])
-> (Either FormatError TarBombError
    -> [Either FormatError TarBombError]
    -> [Either FormatError TarBombError])
-> Entries (Either FormatError TarBombError)
-> [Either FormatError TarBombError]
-> [Either FormatError TarBombError]
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
TAR.foldEntries ((([Either FormatError TarBombError]
  -> [Either FormatError TarBombError])
 -> Entry
 -> [Either FormatError TarBombError]
 -> [Either FormatError TarBombError])
-> Entry
-> ([Either FormatError TarBombError]
    -> [Either FormatError TarBombError])
-> [Either FormatError TarBombError]
-> [Either FormatError TarBombError]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Either FormatError TarBombError]
 -> [Either FormatError TarBombError])
-> Entry
-> [Either FormatError TarBombError]
-> [Either FormatError TarBombError]
forall a b. a -> b -> a
const) [Either FormatError TarBombError]
-> [Either FormatError TarBombError]
forall a. a -> a
id (:) Entries (Either FormatError TarBombError)
entries []

-- | Download a github commit to a temporary directory, extract it and return the path to the extracted directory.
--
-- If the file is already downloaded, it will not be downloaded again.
-- If the file is already extracted, it will not be extracted again.
downloadAndExtractGithubCommitToTemp :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> String -> m FilePath
downloadAndExtractGithubCommitToTemp :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> FilePath -> m FilePath
downloadAndExtractGithubCommitToTemp FilePath
dir FilePath
repository FilePath
commit = (HasCallStack => m FilePath) -> m FilePath
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => m FilePath) -> m FilePath)
-> (HasCallStack => m FilePath) -> m FilePath
forall a b. (a -> b) -> a -> b
$ do
  let url :: FilePath
url = FilePath
"https://github.com/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
repository FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/archive/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
commit FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tar.gz"
  let topDir :: FilePath
topDir = FilePath -> FilePath
FP.takeFileName FilePath
repository FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
commit
  let tarPath :: FilePath
tarPath = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
topDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tar.gz"
  let dest :: FilePath
dest = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
topDir

  Bool
tarFileExists <- 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
$ FilePath -> IO Bool
IO.doesFileExist FilePath
tarPath
  if Bool
tarFileExists
    then FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.note_ (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Already downloaded " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
tarPath
    else do
      FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.note_ (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Downloading " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
tarPath
      IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
HTTP.simpleHttp FilePath
url IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
tarPath

  Bool
destExists <- 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
$ FilePath -> IO Bool
IO.doesDirectoryExist FilePath
dest
  if Bool
destExists
    then FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.note_ (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Already extracted " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
tarPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
dest
    else do
      FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.note_ (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Extracting " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
tarPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
dest
      [Either FormatError TarBombError]
errors <- IO [Either FormatError TarBombError]
-> m [Either FormatError TarBombError]
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO [Either FormatError TarBombError]
 -> m [Either FormatError TarBombError])
-> IO [Either FormatError TarBombError]
-> m [Either FormatError TarBombError]
forall a b. (a -> b) -> a -> b
$ Entries (Either FormatError TarBombError)
-> [Either FormatError TarBombError]
tarErrors (Entries (Either FormatError TarBombError)
 -> [Either FormatError TarBombError])
-> (ByteString -> Entries (Either FormatError TarBombError))
-> ByteString
-> [Either FormatError TarBombError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Entries FormatError -> Entries (Either FormatError TarBombError)
forall e. FilePath -> Entries e -> Entries (Either e TarBombError)
TAR.checkTarbomb FilePath
topDir (Entries FormatError -> Entries (Either FormatError TarBombError))
-> (ByteString -> Entries FormatError)
-> ByteString
-> Entries (Either FormatError TarBombError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
TAR.read (ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.decompress (ByteString -> [Either FormatError TarBombError])
-> IO ByteString -> IO [Either FormatError TarBombError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
LBS.readFile FilePath
tarPath

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Either FormatError TarBombError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [Either FormatError TarBombError]
errors) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> m ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Errors: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Either FormatError TarBombError] -> FilePath
forall a. Show a => a -> FilePath
show [Either FormatError TarBombError]
errors
        m ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
H.failure

      IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Entries FormatError -> IO ()
forall e. Exception e => FilePath -> Entries e -> IO ()
TAR.unpack FilePath
dir (Entries FormatError -> IO ())
-> (ByteString -> Entries FormatError) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
TAR.read (ByteString -> Entries FormatError)
-> (ByteString -> ByteString) -> ByteString -> Entries FormatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZ.decompress (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteString
LBS.readFile FilePath
tarPath

      m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> (IO Bool -> m ()) -> IO Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> m ()
forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
IO Bool -> m ()
H.assertIO (IO Bool -> m ()) -> IO Bool -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
H.doesDirectoryExist FilePath
dest

  FilePath -> m FilePath
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m FilePath
H.note FilePath
dest