hedgehog-extras 0.4.4.1 → 0.4.5.1

raw patch · 4 files changed

+68/−2 lines, 4 filesdep +http-conduitdep +tardep +zlibPVP ok

version bump matches the API change (PVP)

Dependencies added: http-conduit, tar, zlib

API changes (from Hackage documentation)

Files

• hedgehog-extras.cabal +7/−1
• src/Hedgehog/Extras/Test/File.hs +1/−1
• src/Hedgehog/Extras/Test/Golden.hs +1/−0
• src/Hedgehog/Extras/Test/Network.hs +59/−0

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:                   hedgehog-extras-version:                0.4.4.1+version:                0.4.5.1 synopsis:               Supplemental library for hedgehog description:            Supplemental library for hedgehog. category:               Test@@ -27,6 +27,7 @@ common exceptions                   { build-depends: exceptions                                                   } common filepath                     { build-depends: filepath                                                     } common hedgehog                     { build-depends: hedgehog                                                     }+common http-conduit                 { build-depends: http-conduit                                                 } common hw-aeson                     { build-depends: hw-aeson                         >= 0.1.8.0                  } common mmorph                       { build-depends: mmorph                                                       } common mtl                          { build-depends: mtl                                                          }@@ -34,6 +35,7 @@ common process                      { build-depends: process                                                      } common resourcet                    { build-depends: resourcet                                                    } common stm                          { build-depends: stm                                                          }+common tar                          { build-depends: tar                                                          } common temporary                    { build-depends: temporary                                                    } common text                         { build-depends: text                                                         } common time                         { build-depends: time                             >= 1.9.1                    }@@ -41,6 +43,7 @@ common unliftio                     { build-depends: unliftio                                                     } common unordered-containers         { build-depends: unordered-containers                                         } common yaml                         { build-depends: yaml                                                         }+common zlib                         { build-depends: zlib                                                         }  common Win32   if os(windows)@@ -69,6 +72,7 @@                         exceptions,                         filepath,                         hedgehog,+                        http-conduit,                         hw-aeson,                         mmorph,                         mtl,@@ -76,6 +80,7 @@                         process,                         resourcet,                         stm,+                        tar,                         temporary,                         text,                         time,@@ -84,6 +89,7 @@                         unordered-containers,                         Win32,                         yaml,+                        zlib,   hs-source-dirs:       src  

@@ -128,7 +128,7 @@ -- | Rename the 'src' file to 'dst'. renameFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m () renameFile src dst = GHC.withFrozenCallStack $ do-  H.annotate $ "Copying from " <> show src <> " to " <> show dst+  H.annotate $ "Renaming from " <> show src <> " to " <> show dst   H.evalIO $ IO.renameFile src dst  -- | Create a symbolic link from 'dst' to 'src'.

@@ -60,6 +60,7 @@       referenceLines <- List.lines <$> H.readFile referenceFile       let difference = getGroupedDiff actualLines referenceLines       case difference of+        []       -> pure ()         [Both{}] -> pure ()         _        -> failMessage callStack $ ppDiff difference     else if createFiles

@@ -1,5 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} +{- HLINT ignore "Redundant flip" -}+ module Hedgehog.Extras.Test.Network   ( doesFileExists   , isPortOpen@@ -7,6 +9,8 @@   , assertPortOpen   , assertSocketExists   , doesSprocketExist+  , downloadToFile+  , downloadAndExtractGithubCommitToTemp   ) where  import           Control.Exception (IOException, try)@@ -15,21 +19,32 @@ 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@@ -64,3 +79,47 @@     Left (e :: IOException) -> do       H.annotate $ "Error: " <> show e       return False++-- | Download from a URl to a file+downloadToFile :: (MonadTest m, MonadIO m, HasCallStack) => String -> FilePath -> m ()+downloadToFile url path = GHC.withFrozenCallStack $ do+  H.note_ $ "Downloading " <> url <> " to " <> path+  H.evalIO $ HTTP.simpleHttp url >>= LBS.writeFile path++tarErrors :: TAR.Entries (Either TAR.FormatError TAR.TarBombError) -> [Either TAR.FormatError TAR.TarBombError]+tarErrors entries = TAR.foldEntries (flip const) id (:) 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 dir repository commit = GHC.withFrozenCallStack $ do+  let url = "https://github.com/" <> repository <> "/archive/" <> commit <> ".tar.gz"+  let topDir = FP.takeFileName repository <> "-" <> commit+  let tarPath = dir </> topDir <> ".tar.gz"+  let dest = dir </> topDir++  tarFileExists <- H.evalIO $ IO.doesFileExist tarPath+  if tarFileExists+    then H.note_ $ "Already downloaded " <> url <> " to " <> tarPath+    else do+      H.note_ $ "Downloading " <> url <> " to " <> tarPath+      H.evalIO $ HTTP.simpleHttp url >>= LBS.writeFile tarPath++  destExists <- H.evalIO $ IO.doesDirectoryExist dest+  if destExists+    then H.note_ $ "Already extracted " <> tarPath <> " to " <> dest+    else do+      H.note_ $ "Extracting " <> tarPath <> " to " <> dest+      errors <- H.evalIO $ tarErrors . TAR.checkTarbomb topDir . TAR.read . GZ.decompress <$> LBS.readFile tarPath++      unless (List.null errors) $ do+        H.annotate $ "Errors: " <> show errors+        H.failure++      H.evalIO $ TAR.unpack dir . TAR.read . GZ.decompress =<< LBS.readFile tarPath++      void . H.assertIO $ H.doesDirectoryExist dest++  H.note dest