http-download (empty) → 0.1.0.0
raw patch · 6 files changed
+680/−0 lines, 6 filesdep +basedep +base64-bytestringdep +bytestring
Dependencies added: base, base64-bytestring, bytestring, conduit, conduit-extra, cryptonite, cryptonite-conduit, directory, exceptions, filepath, hspec, hspec-discover, http-client, http-conduit, http-download, http-types, memory, path, path-io, retry, rio, rio-prettyprint
Files
- LICENSE +24/−0
- http-download.cabal +76/−0
- src/Network/HTTP/Download.hs +110/−0
- src/Network/HTTP/Download/Verified.hs +324/−0
- test/Network/HTTP/Download/VerifiedSpec.hs +145/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2015-2019, Stack contributors+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 Stack nor the+ names of its 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 STACK 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.
+ http-download.cabal view
@@ -0,0 +1,76 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: b6a9c41e4facbc95bcb9ee81b15c8c682b88f638fa8df0382f9e4e54b6ab1629++name: http-download+version: 0.1.0.0+synopsis: Verified downloads with retries+category: Development+homepage: https://github.com/commercialhaskell/stack#readme+bug-reports: https://github.com/commercialhaskell/stack/issues+author: Michael Snoyman+maintainer: michael@snoyman.com+copyright: 2018-2019 FP Complete+license: BSD3+license-file: LICENSE+build-type: Simple++source-repository head+ type: git+ location: https://github.com/commercialhaskell/stack++library+ exposed-modules:+ Network.HTTP.Download+ Network.HTTP.Download.Verified+ other-modules:+ Paths_http_download+ hs-source-dirs:+ src/+ build-depends:+ base >=4.10 && <5+ , base64-bytestring+ , bytestring+ , conduit+ , conduit-extra+ , cryptonite+ , cryptonite-conduit+ , directory+ , exceptions+ , filepath+ , http-client+ , http-conduit+ , http-types+ , memory+ , path+ , path-io+ , retry+ , rio+ , rio-prettyprint+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Network.HTTP.Download.VerifiedSpec+ Paths_http_download+ hs-source-dirs:+ test+ build-depends:+ base >=4.10 && <5+ , cryptonite+ , hspec+ , hspec-discover+ , http-client+ , http-download+ , path+ , path-io+ , retry+ , rio+ , rio-prettyprint+ default-language: Haskell2010
+ src/Network/HTTP/Download.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Download+ ( DownloadRequest(..)+ , drRetryPolicyDefault+ , HashCheck(..)+ , DownloadException(..)+ , CheckHexDigest(..)+ , LengthCheck+ , VerifiedDownloadException(..)++ , download+ , redownload+ , verifiedDownload+ ) where++import qualified Data.ByteString.Lazy as L+import Conduit+import qualified Data.Conduit.Binary as CB+import Network.HTTP.Download.Verified+import Network.HTTP.Client (HttpException, Request, Response, checkResponse, path, requestHeaders)+import Network.HTTP.Simple (getResponseBody, getResponseHeaders, getResponseStatusCode, withResponse)+import Path (Path, Abs, File, toFilePath)+import Path.IO (doesFileExist)+import RIO+import RIO.PrettyPrint+import System.Directory (createDirectoryIfMissing,+ removeFile)+import System.FilePath (takeDirectory, (<.>))+++-- | Download the given URL to the given location. If the file already exists,+-- no download is performed. Otherwise, creates the parent directory, downloads+-- to a temporary file, and on file download completion moves to the+-- appropriate destination.+--+-- Throws an exception if things go wrong+download :: HasTerm env+ => Request+ -> Path Abs File -- ^ destination+ -> RIO env Bool -- ^ Was a downloaded performed (True) or did the file already exist (False)?+download req destpath = do+ let downloadReq = DownloadRequest+ { drRequest = req+ , drHashChecks = []+ , drLengthCheck = Nothing+ , drRetryPolicy = drRetryPolicyDefault+ }+ let progressHook _ = return ()+ verifiedDownload downloadReq destpath progressHook++-- | Same as 'download', but will download a file a second time if it is already present.+--+-- Returns 'True' if the file was downloaded, 'False' otherwise+redownload :: HasTerm env+ => Request+ -> Path Abs File -- ^ destination+ -> RIO env Bool+redownload req0 dest = do+ logDebug $ "Downloading " <> display (decodeUtf8With lenientDecode (path req0))+ let destFilePath = toFilePath dest+ etagFilePath = destFilePath <.> "etag"++ metag <- do+ exists <- doesFileExist dest+ if not exists+ then return Nothing+ else liftIO $ handleIO (const $ return Nothing) $ fmap Just $+ withSourceFile etagFilePath $ \src -> runConduit $ src .| CB.take 512++ let req1 =+ case metag of+ Nothing -> req0+ Just etag -> req0+ { requestHeaders =+ requestHeaders req0 +++ [("If-None-Match", L.toStrict etag)]+ }+ req2 = req1 { checkResponse = \_ _ -> return () }+ recoveringHttp drRetryPolicyDefault $ catchingHttpExceptions $ liftIO $+ withResponse req2 $ \res -> case getResponseStatusCode res of+ 200 -> do+ createDirectoryIfMissing True $ takeDirectory destFilePath++ -- Order here is important: first delete the etag, then write the+ -- file, then write the etag. That way, if any step fails, it will+ -- force the download to happen again.+ handleIO (const $ return ()) $ removeFile etagFilePath++ withSinkFileCautious destFilePath $ \sink ->+ runConduit $ getResponseBody res .| sink++ forM_ (lookup "ETag" (getResponseHeaders res)) $ \e ->+ withSinkFileCautious etagFilePath $ \sink ->+ runConduit $ yield e .| sink++ return True+ 304 -> return False+ _ -> throwM $ RedownloadInvalidResponse req2 dest $ void res++ where+ catchingHttpExceptions :: RIO env a -> RIO env a+ catchingHttpExceptions action = catch action (throwM . RedownloadHttpError)++data DownloadException = RedownloadInvalidResponse Request (Path Abs File) (Response ())+ | RedownloadHttpError HttpException+ + deriving (Show, Typeable)+instance Exception DownloadException
+ src/Network/HTTP/Download/Verified.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+module Network.HTTP.Download.Verified+ ( verifiedDownload+ , recoveringHttp+ , DownloadRequest(..)+ , drRetryPolicyDefault+ , HashCheck(..)+ , CheckHexDigest(..)+ , LengthCheck+ , VerifiedDownloadException(..)+ ) where++import qualified Data.List as List+import qualified Data.ByteString.Base64 as B64+import Conduit (withSinkFile)+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL++import Control.Monad+import Control.Monad.Catch (Handler (..)) -- would be nice if retry exported this itself+import Control.Retry (recovering,limitRetries,RetryPolicy,exponentialBackoff,RetryStatus(..))+import Crypto.Hash+import Crypto.Hash.Conduit (sinkHash)+import Data.ByteArray as Mem (convert)+import Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16))+import Data.ByteString.Char8 (readInteger)+import Data.Conduit+import Data.Conduit.Binary (sourceHandle)+import Data.Monoid (Sum(..))+import GHC.IO.Exception (IOException(..),IOErrorType(..))+import Network.HTTP.Client (Request, HttpException, getUri, path)+import Network.HTTP.Simple (getResponseHeaders, httpSink)+import Network.HTTP.Types (hContentLength, hContentMD5)+import Path+import RIO hiding (Handler)+import RIO.PrettyPrint+import qualified RIO.ByteString as ByteString+import qualified RIO.Text as Text+import System.Directory+import qualified System.FilePath as FP ((<.>))++-- | A request together with some checks to perform.+data DownloadRequest = DownloadRequest+ { drRequest :: Request+ , drHashChecks :: [HashCheck]+ , drLengthCheck :: Maybe LengthCheck+ , drRetryPolicy :: RetryPolicy+ }++-- | Default to retrying seven times with exponential backoff starting from+-- one hundred milliseconds.+--+-- This means the tries will occur after these delays if necessary:+--+-- * 0.1s+-- * 0.2s+-- * 0.4s+-- * 0.8s+-- * 1.6s+-- * 3.2s+-- * 6.4s+drRetryPolicyDefault :: RetryPolicy+drRetryPolicyDefault = limitRetries 7 <> exponentialBackoff onehundredMilliseconds+ where onehundredMilliseconds = 100000++data HashCheck = forall a. (Show a, HashAlgorithm a) => HashCheck+ { hashCheckAlgorithm :: a+ , hashCheckHexDigest :: CheckHexDigest+ }+deriving instance Show HashCheck++data CheckHexDigest+ = CheckHexDigestString String+ | CheckHexDigestByteString ByteString+ | CheckHexDigestHeader ByteString+ deriving Show+instance IsString CheckHexDigest where+ fromString = CheckHexDigestString++type LengthCheck = Int++-- | An exception regarding verification of a download.+data VerifiedDownloadException+ = WrongContentLength+ Request+ Int -- expected+ ByteString -- actual (as listed in the header)+ | WrongStreamLength+ Request+ Int -- expected+ Int -- actual+ | WrongDigest+ Request+ String -- algorithm+ CheckHexDigest -- expected+ String -- actual (shown)+ deriving (Typeable)+instance Show VerifiedDownloadException where+ show (WrongContentLength req expected actual) =+ "Download expectation failure: ContentLength header\n"+ ++ "Expected: " ++ show expected ++ "\n"+ ++ "Actual: " ++ displayByteString actual ++ "\n"+ ++ "For: " ++ show (getUri req)+ show (WrongStreamLength req expected actual) =+ "Download expectation failure: download size\n"+ ++ "Expected: " ++ show expected ++ "\n"+ ++ "Actual: " ++ show actual ++ "\n"+ ++ "For: " ++ show (getUri req)+ show (WrongDigest req algo expected actual) =+ "Download expectation failure: content hash (" ++ algo ++ ")\n"+ ++ "Expected: " ++ displayCheckHexDigest expected ++ "\n"+ ++ "Actual: " ++ actual ++ "\n"+ ++ "For: " ++ show (getUri req)++instance Exception VerifiedDownloadException++-- This exception is always caught and never thrown outside of this module.+data VerifyFileException+ = WrongFileSize+ Int -- expected+ Integer -- actual (as listed by hFileSize)+ deriving (Show, Typeable)+instance Exception VerifyFileException++-- Show a ByteString that is known to be UTF8 encoded.+displayByteString :: ByteString -> String+displayByteString =+ Text.unpack . Text.strip . decodeUtf8Lenient++-- Show a CheckHexDigest in human-readable format.+displayCheckHexDigest :: CheckHexDigest -> String+displayCheckHexDigest (CheckHexDigestString s) = s ++ " (String)"+displayCheckHexDigest (CheckHexDigestByteString s) = displayByteString s ++ " (ByteString)"+displayCheckHexDigest (CheckHexDigestHeader h) =+ show (B64.decodeLenient h) ++ " (Header. unencoded: " ++ show h ++ ")"+++-- | Make sure that the hash digest for a finite stream of bytes+-- is as expected.+--+-- Throws WrongDigest (VerifiedDownloadException)+sinkCheckHash :: MonadThrow m+ => Request+ -> HashCheck+ -> ConduitM ByteString o m ()+sinkCheckHash req HashCheck{..} = do+ digest <- sinkHashUsing hashCheckAlgorithm+ let actualDigestString = show digest+ let actualDigestHexByteString = Mem.convertToBase Mem.Base16 digest+ let actualDigestBytes = Mem.convert digest++ let passedCheck = case hashCheckHexDigest of+ CheckHexDigestString s -> s == actualDigestString+ CheckHexDigestByteString b -> b == actualDigestHexByteString+ CheckHexDigestHeader b -> B64.decodeLenient b == actualDigestHexByteString+ || B64.decodeLenient b == actualDigestBytes+ -- A hack to allow hackage tarballs to download.+ -- They should really base64-encode their md5 header as per rfc2616#sec14.15.+ -- https://github.com/commercialhaskell/stack/issues/240+ || b == actualDigestHexByteString++ unless passedCheck $+ throwM $ WrongDigest req (show hashCheckAlgorithm) hashCheckHexDigest actualDigestString++assertLengthSink :: MonadThrow m+ => Request+ -> LengthCheck+ -> ZipSink ByteString m ()+assertLengthSink req expectedStreamLength = ZipSink $ do+ Sum actualStreamLength <- CL.foldMap (Sum . ByteString.length)+ when (actualStreamLength /= expectedStreamLength) $+ throwM $ WrongStreamLength req expectedStreamLength actualStreamLength++-- | A more explicitly type-guided sinkHash.+sinkHashUsing :: (Monad m, HashAlgorithm a) => a -> ConduitM ByteString o m (Digest a)+sinkHashUsing _ = sinkHash++-- | Turns a list of hash checks into a ZipSink that checks all of them.+hashChecksToZipSink :: MonadThrow m => Request -> [HashCheck] -> ZipSink ByteString m ()+hashChecksToZipSink req = traverse_ (ZipSink . sinkCheckHash req)++-- 'Control.Retry.recovering' customized for HTTP failures+recoveringHttp :: forall env a. HasTerm env => RetryPolicy -> RIO env a -> RIO env a+recoveringHttp retryPolicy =+ helper $ \run -> recovering retryPolicy (handlers run) . const+ where+ helper :: (UnliftIO (RIO env) -> IO a -> IO a) -> RIO env a -> RIO env a+ helper wrapper action = withUnliftIO $ \run -> wrapper run (unliftIO run action)++ handlers :: UnliftIO (RIO env) -> [RetryStatus -> Handler IO Bool]+ handlers u = [Handler . alwaysRetryHttp u,const $ Handler retrySomeIO]++ alwaysRetryHttp :: UnliftIO (RIO env) -> RetryStatus -> HttpException -> IO Bool+ alwaysRetryHttp u rs _ = do+ unliftIO u $+ prettyWarn $ vcat+ [ flow $ unwords+ [ "Retry number"+ , show (rsIterNumber rs)+ , "after a total delay of"+ , show (rsCumulativeDelay rs)+ , "us"+ ]+ , flow $ unwords+ [ "If you see this warning and stack fails to download,"+ , "but running the command again solves the problem,"+ , "please report here: https://github.com/commercialhaskell/stack/issues/3510"+ , "Make sure to paste the output of 'stack --version'"+ ]+ ]+ return True++ retrySomeIO :: Monad m => IOException -> m Bool+ retrySomeIO e = return $ case ioe_type e of+ -- hGetBuf: resource vanished (Connection reset by peer)+ ResourceVanished -> True+ -- conservatively exclude all others+ _ -> False++-- | Copied and extended version of Network.HTTP.Download.download.+--+-- Has the following additional features:+-- * Verifies that response content-length header (if present)+-- matches expected length+-- * Limits the download to (close to) the expected # of bytes+-- * Verifies that the expected # bytes were downloaded (not too few)+-- * Verifies md5 if response includes content-md5 header+-- * Verifies the expected hashes+--+-- Throws VerifiedDownloadException.+-- Throws IOExceptions related to file system operations.+-- Throws HttpException.+verifiedDownload+ :: HasTerm env+ => DownloadRequest+ -> Path Abs File -- ^ destination+ -> (Maybe Integer -> ConduitM ByteString Void (RIO env) ()) -- ^ custom hook to observe progress+ -> RIO env Bool -- ^ Whether a download was performed+verifiedDownload DownloadRequest{..} destpath progressSink = do+ let req = drRequest+ whenM' (liftIO getShouldDownload) $ do+ logDebug $ "Downloading " <> display (decodeUtf8With lenientDecode (path req))+ liftIO $ createDirectoryIfMissing True dir+ recoveringHttp drRetryPolicy $+ withSinkFile fptmp $ httpSink req . go+ liftIO $ renameFile fptmp fp+ where+ whenM' mp m = do+ p <- mp+ if p then m >> return True else return False++ fp = toFilePath destpath+ fptmp = fp FP.<.> "tmp"+ dir = toFilePath $ parent destpath++ getShouldDownload = do+ fileExists <- doesFileExist fp+ if fileExists+ -- only download if file does not match expectations+ then not <$> fileMatchesExpectations+ -- or if it doesn't exist yet+ else return True++ -- precondition: file exists+ -- TODO: add logging+ fileMatchesExpectations =+ ((checkExpectations >> return True)+ `catch` \(_ :: VerifyFileException) -> return False)+ `catch` \(_ :: VerifiedDownloadException) -> return False++ checkExpectations = withBinaryFile fp ReadMode $ \h -> do+ for_ drLengthCheck $ checkFileSizeExpectations h+ runConduit+ $ sourceHandle h+ .| getZipSink (hashChecksToZipSink drRequest drHashChecks)++ -- doesn't move the handle+ checkFileSizeExpectations h expectedFileSize = do+ fileSizeInteger <- hFileSize h+ when (fileSizeInteger > toInteger (maxBound :: Int)) $+ throwM $ WrongFileSize expectedFileSize fileSizeInteger+ let fileSize = fromInteger fileSizeInteger+ when (fileSize /= expectedFileSize) $+ throwM $ WrongFileSize expectedFileSize fileSizeInteger++ checkContentLengthHeader headers expectedContentLength =+ case List.lookup hContentLength headers of+ Just lengthBS -> do+ let lengthStr = displayByteString lengthBS+ when (lengthStr /= show expectedContentLength) $+ throwM $ WrongContentLength drRequest expectedContentLength lengthBS+ _ -> return ()++ go sink res = do+ let headers = getResponseHeaders res+ mcontentLength = do+ hLength <- List.lookup hContentLength headers+ (i,_) <- readInteger hLength+ return i+ for_ drLengthCheck $ checkContentLengthHeader headers+ let hashChecks = (case List.lookup hContentMD5 headers of+ Just md5BS ->+ [ HashCheck+ { hashCheckAlgorithm = MD5+ , hashCheckHexDigest = CheckHexDigestHeader md5BS+ }+ ]+ Nothing -> []+ ) ++ drHashChecks++ maybe id (\len -> (CB.isolate len .|)) drLengthCheck+ $ getZipSink+ ( hashChecksToZipSink drRequest hashChecks+ *> maybe (pure ()) (assertLengthSink drRequest) drLengthCheck+ *> ZipSink sink+ *> ZipSink (progressSink mcontentLength))
+ test/Network/HTTP/Download/VerifiedSpec.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Network.HTTP.Download.VerifiedSpec (spec) where++import Control.Retry (limitRetries)+import Crypto.Hash+import Network.HTTP.Client+import Network.HTTP.Download.Verified+import Path+import Path.IO -- hiding (withSystemTempDir)+import System.IO (writeFile, readFile)+import RIO+import RIO.PrettyPrint+import RIO.PrettyPrint.StylesUpdate+import Test.Hspec++-- TODO: share across test files+withTempDir' :: (Path Abs Dir -> IO a) -> IO a+withTempDir' = withSystemTempDir "NHD_VerifiedSpec"++-- | An example path to download the exampleReq.+getExamplePath :: Path Abs Dir -> IO (Path Abs File)+getExamplePath dir = do+ file <- parseRelFile "cabal-install-1.22.4.0.tar.gz"+ return (dir </> file)++-- | An example DownloadRequest that uses a SHA1+exampleReq :: DownloadRequest+exampleReq = fromMaybe (error "exampleReq") $ do+ req <- parseRequest "http://download.fpcomplete.com/stackage-cli/linux64/cabal-install-1.22.4.0.tar.gz"+ return DownloadRequest+ { drRequest = req+ , drHashChecks = [exampleHashCheck]+ , drLengthCheck = Just exampleLengthCheck+ , drRetryPolicy = limitRetries 1+ }++exampleHashCheck :: HashCheck+exampleHashCheck = HashCheck+ { hashCheckAlgorithm = SHA1+ , hashCheckHexDigest = CheckHexDigestString "b98eea96d321cdeed83a201c192dac116e786ec2"+ }++exampleLengthCheck :: LengthCheck+exampleLengthCheck = 302513++-- | The wrong ContentLength for exampleReq+exampleWrongContentLength :: Int+exampleWrongContentLength = 302512++-- | The wrong SHA1 digest for exampleReq+exampleWrongDigest :: CheckHexDigest+exampleWrongDigest = CheckHexDigestString "b98eea96d321cdeed83a201c192dac116e786ec3"++exampleWrongContent :: String+exampleWrongContent = "example wrong content"++isWrongContentLength :: VerifiedDownloadException -> Bool+isWrongContentLength WrongContentLength{} = True+isWrongContentLength _ = False++isWrongDigest :: VerifiedDownloadException -> Bool+isWrongDigest WrongDigest{} = True+isWrongDigest _ = False++data TestTerm = TestTerm++instance HasLogFunc TestTerm where+ -- ingoring output for now+ logFuncL = lens (const $ mkLogFunc mempty) (\t _ -> t)++instance HasStylesUpdate TestTerm where+ stylesUpdateL = lens (const $ StylesUpdate []) (\t _ -> t)++instance HasTerm TestTerm where+ useColorL = lens (const False) (\t _ -> t)+ termWidthL = lens (const 80) (\t _ -> t)++spec :: Spec+spec = do+ let exampleProgressHook _ = return ()++ describe "verifiedDownload" $ do+ let run func = runRIO TestTerm func+ -- Preconditions:+ -- * the exampleReq server is running+ -- * the test runner has working internet access to it+ it "downloads the file correctly" $ withTempDir' $ \dir -> do+ examplePath <- getExamplePath dir+ doesFileExist examplePath `shouldReturn` False+ let go = run $ verifiedDownload exampleReq examplePath exampleProgressHook+ go `shouldReturn` True+ doesFileExist examplePath `shouldReturn` True++ it "is idempotent, and doesn't redownload unnecessarily" $ withTempDir' $ \dir -> do+ examplePath <- getExamplePath dir+ doesFileExist examplePath `shouldReturn` False+ let go = run $ verifiedDownload exampleReq examplePath exampleProgressHook+ go `shouldReturn` True+ doesFileExist examplePath `shouldReturn` True+ go `shouldReturn` False+ doesFileExist examplePath `shouldReturn` True++ -- https://github.com/commercialhaskell/stack/issues/372+ it "does redownload when the destination file is wrong" $ withTempDir' $ \dir -> do+ examplePath <- getExamplePath dir+ let exampleFilePath = toFilePath examplePath+ writeFile exampleFilePath exampleWrongContent+ doesFileExist examplePath `shouldReturn` True+ readFile exampleFilePath `shouldReturn` exampleWrongContent+ let go = run $ verifiedDownload exampleReq examplePath exampleProgressHook+ go `shouldReturn` True+ doesFileExist examplePath `shouldReturn` True+ readFile exampleFilePath `shouldNotReturn` exampleWrongContent++ it "rejects incorrect content length" $ withTempDir' $ \dir -> do+ examplePath <- getExamplePath dir+ let wrongContentLengthReq = exampleReq+ { drLengthCheck = Just exampleWrongContentLength+ }+ let go = run $ verifiedDownload wrongContentLengthReq examplePath exampleProgressHook+ go `shouldThrow` isWrongContentLength+ doesFileExist examplePath `shouldReturn` False++ it "rejects incorrect digest" $ withTempDir' $ \dir -> do+ examplePath <- getExamplePath dir+ let wrongHashCheck = exampleHashCheck { hashCheckHexDigest = exampleWrongDigest }+ let wrongDigestReq = exampleReq { drHashChecks = [wrongHashCheck] }+ let go = run $ verifiedDownload wrongDigestReq examplePath exampleProgressHook+ go `shouldThrow` isWrongDigest+ doesFileExist examplePath `shouldReturn` False++ -- https://github.com/commercialhaskell/stack/issues/240+ it "can download hackage tarballs" $ withTempDir' $ \dir -> do+ dest <- (dir </>) <$> parseRelFile "acme-missiles-0.3.tar.gz"+ req <- parseRequest "http://hackage.haskell.org/package/acme-missiles-0.3/acme-missiles-0.3.tar.gz"+ let dReq = DownloadRequest+ { drRequest = req+ , drHashChecks = []+ , drLengthCheck = Nothing+ , drRetryPolicy = limitRetries 1+ }+ let go = run $ verifiedDownload dReq dest exampleProgressHook+ doesFileExist dest `shouldReturn` False+ go `shouldReturn` True+ doesFileExist dest `shouldReturn` True
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}