http-download-0.2.0.0/src/0000755000000000000000000000000013627366103013417 5ustar0000000000000000http-download-0.2.0.0/src/Network/0000755000000000000000000000000013627366103015050 5ustar0000000000000000http-download-0.2.0.0/src/Network/HTTP/0000755000000000000000000000000013627366114015631 5ustar0000000000000000http-download-0.2.0.0/src/Network/HTTP/Download/0000755000000000000000000000000013627366114017400 5ustar0000000000000000http-download-0.2.0.0/test/0000755000000000000000000000000013627366103013607 5ustar0000000000000000http-download-0.2.0.0/test/Network/0000755000000000000000000000000013627366103015240 5ustar0000000000000000http-download-0.2.0.0/test/Network/HTTP/0000755000000000000000000000000013627366103016017 5ustar0000000000000000http-download-0.2.0.0/test/Network/HTTP/Download/0000755000000000000000000000000013627366114017570 5ustar0000000000000000http-download-0.2.0.0/src/Network/HTTP/Download.hs0000644000000000000000000001032513627366114017735 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Download ( DownloadRequest , mkDownloadRequest , modifyRequest , setHashChecks , setLengthCheck , setRetryPolicy , setForceDownload , 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 = mkDownloadRequest req 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 http-download-0.2.0.0/src/Network/HTTP/Download/Verified.hs0000644000000000000000000003670213627366114021501 0ustar0000000000000000{-# 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 , drRetryPolicyDefault , HashCheck(..) , CheckHexDigest(..) , LengthCheck , VerifiedDownloadException(..) -- * DownloadRequest construction , DownloadRequest , mkDownloadRequest , modifyRequest , setHashChecks , setLengthCheck , setRetryPolicy , setForceDownload ) where import qualified Data.List as List import qualified Data.ByteString.Base64 as B64 import Conduit (sinkHandle) 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 import System.IO (openTempFileWithDefaultPermissions) -- | A request together with some checks to perform. -- -- Construct using the 'downloadRequest' smart constructor and associated -- setters. The constructor itself is not exposed to avoid breaking changes -- with additional fields. -- -- @since 0.2.0.0 data DownloadRequest = DownloadRequest { drRequest :: Request , drHashChecks :: [HashCheck] , drLengthCheck :: Maybe LengthCheck , drRetryPolicy :: RetryPolicy , drForceDownload :: Bool -- ^ whether to redownload or not if file exists } -- | Construct a new 'DownloadRequest' from the given 'Request'. Use associated -- setters to modify the value further. -- -- @since 0.2.0.0 mkDownloadRequest :: Request -> DownloadRequest mkDownloadRequest req = DownloadRequest req [] Nothing drRetryPolicyDefault False -- | Modify the 'Request' inside a 'DownloadRequest'. Especially intended for modifying the @User-Agent@ request header. -- -- @since 0.2.0.0 modifyRequest :: (Request -> Request) -> DownloadRequest -> DownloadRequest modifyRequest f dr = dr { drRequest = f $ drRequest dr } -- | Set the hash checks to be run when verifying. -- -- @since 0.2.0.0 setHashChecks :: [HashCheck] -> DownloadRequest -> DownloadRequest setHashChecks x dr = dr { drHashChecks = x } -- | Set the length check to be run when verifying. -- -- @since 0.2.0.0 setLengthCheck :: Maybe LengthCheck -> DownloadRequest -> DownloadRequest setLengthCheck x dr = dr { drLengthCheck = x } -- | Set the retry policy to be used when downloading. -- -- @since 0.2.0.0 setRetryPolicy :: RetryPolicy -> DownloadRequest -> DownloadRequest setRetryPolicy x dr = dr { drRetryPolicy = x } -- | If 'True', force download even if the file already exists. Useful for -- download a resource which may change over time. setForceDownload :: Bool -> DownloadRequest -> DownloadRequest setForceDownload x dr = dr { drForceDownload = x } -- | 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) | DownloadHttpError HttpException 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) show (DownloadHttpError exception) = "Download expectation failure: " ++ show exception 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 withTempFileWithDefaultPermissions dir (FP.takeFileName fp) $ \fptmp htmp -> do recoveringHttp drRetryPolicy $ catchingHttpExceptions $ httpSink req $ go (sinkHandle htmp) hClose htmp liftIO $ renameFile fptmp fp where whenM' mp m = do p <- mp if p then m >> return True else return False fp = toFilePath destpath dir = toFilePath $ parent destpath getShouldDownload = if drForceDownload then return True else 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)) catchingHttpExceptions :: RIO env a -> RIO env a catchingHttpExceptions action = catch action (throwM . DownloadHttpError) -- | Like 'UnliftIO.Temporary.withTempFile', but the file is created with -- default file permissions, instead of read/write access only for the owner. withTempFileWithDefaultPermissions :: MonadUnliftIO m => FilePath -- ^ Temp dir to create the file in. -> String -- ^ File name template. See 'openTempFile'. -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file. -> m a withTempFileWithDefaultPermissions tmpDir template action = bracket (liftIO (openTempFileWithDefaultPermissions tmpDir template)) (\(name, handle') -> liftIO (hClose handle' >> ignoringIOErrors (removeFile name))) (uncurry action) where ignoringIOErrors = void. tryIO http-download-0.2.0.0/test/Spec.hs0000644000000000000000000000005413627366103015034 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-download-0.2.0.0/test/Network/HTTP/Download/VerifiedSpec.hs0000644000000000000000000001372313627366114022502 0ustar0000000000000000{-# 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 $ setHashChecks [exampleHashCheck] $ setLengthCheck (Just exampleLengthCheck) $ setRetryPolicy (limitRetries 1) $ mkDownloadRequest req 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 = setLengthCheck (Just exampleWrongContentLength) exampleReq 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 = setHashChecks [wrongHashCheck] exampleReq 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 = setRetryPolicy (limitRetries 1) $ mkDownloadRequest req let go = run $ verifiedDownload dReq dest exampleProgressHook doesFileExist dest `shouldReturn` False go `shouldReturn` True doesFileExist dest `shouldReturn` True it "does redownload when forceDownload is True" $ withTempDir' $ \dir -> do examplePath <- getExamplePath dir doesFileExist examplePath `shouldReturn` False let go = run $ verifiedDownload exampleReq examplePath exampleProgressHook go `shouldReturn` True doesFileExist examplePath `shouldReturn` True let forceReq = setForceDownload True exampleReq let go' = run $ verifiedDownload forceReq examplePath exampleProgressHook go' `shouldReturn` True doesFileExist examplePath `shouldReturn` True http-download-0.2.0.0/LICENSE0000644000000000000000000000273113627366103013640 0ustar0000000000000000Copyright (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-0.2.0.0/http-download.cabal0000644000000000000000000000341213627366136016406 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.32.0. -- -- see: https://github.com/sol/hpack -- -- hash: 0eb36743b21d8003fc0ab6478ffc685d061b3c386bb35b293c1a50718a5fbd78 name: http-download version: 0.2.0.0 synopsis: Verified downloads with retries description: Higher level HTTP download APIs include verification of content and retries category: Development homepage: https://github.com/commercialhaskell/http-download#readme bug-reports: https://github.com/commercialhaskell/http-download/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/http-download 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