Skip to content

Commit db52f16

Browse files
mgsloanmgsloan
committed
Debug logging when stack is downloading
1 parent 9be58d7 commit db52f16

2 files changed

Lines changed: 53 additions & 40 deletions

File tree

‎src/Network/HTTP/Download.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE DeriveDataTypeable #-}
33
{-# LANGUAGE MultiParamTypeClasses #-}
44
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE TemplateHaskell #-}
56
module Network.HTTP.Download
67
( verifiedDownload
78
, DownloadRequest(..)
@@ -28,6 +29,7 @@ import Control.Exception.Enclosed (handleIO)
2829
import Control.Monad (void)
2930
import Control.Monad.Catch (MonadThrow, MonadMask, throwM)
3031
import Control.Monad.IO.Class (MonadIO, liftIO)
32+
import Control.Monad.Logger (MonadLogger, logDebug)
3133
import Control.Monad.Reader (MonadReader, ReaderT, ask,
3234
runReaderT)
3335
import Data.Aeson.Extended (FromJSON, parseJSON)
@@ -40,7 +42,11 @@ import Data.Conduit.Attoparsec (sinkParser)
4042
import Data.Conduit.Binary (sinkHandle, sourceHandle)
4143
import qualified Data.Conduit.Binary as CB
4244
import Data.Foldable (forM_)
45+
import Data.Monoid ((<>))
46+
import Data.Text.Encoding.Error (lenientDecode)
47+
import Data.Text.Encoding (decodeUtf8With)
4348
import Data.Typeable (Typeable)
49+
import Network.HTTP.Client (path)
4450
import Network.HTTP.Client.Conduit (HasHttpManager, Manager, Request,
4551
Response, checkStatus,
4652
getHttpManager, parseUrl,
@@ -64,7 +70,7 @@ import System.IO (IOMode (ReadMode),
6470
-- appropriate destination.
6571
--
6672
-- Throws an exception if things go wrong
67-
download :: (MonadReader env m, HasHttpManager env, MonadIO m)
73+
download :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m)
6874
=> Request
6975
-> Path Abs File -- ^ destination
7076
-> m Bool -- ^ Was a downloaded performed (True) or did the file already exist (False)?
@@ -81,11 +87,12 @@ download req destpath = do
8187
-- | Same as 'download', but will download a file a second time if it is already present.
8288
--
8389
-- Returns 'True' if the file was downloaded, 'False' otherwise
84-
redownload :: (MonadReader env m, HasHttpManager env, MonadIO m)
90+
redownload :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m)
8591
=> Request
8692
-> Path Abs File -- ^ destination
8793
-> m Bool
8894
redownload req0 dest = do
95+
$logDebug $ "Downloading " <> decodeUtf8With lenientDecode (path req0)
8996
let destFilePath = toFilePath dest
9097
etagFilePath = destFilePath <.> "etag"
9198

‎src/Network/HTTP/Download/Verified.hs‎

Lines changed: 44 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88
{-# LANGUAGE RankNTypes #-}
99
{-# LANGUAGE GADTs #-}
1010
{-# LANGUAGE StandaloneDeriving #-}
11+
{-# LANGUAGE TemplateHaskell #-}
1112
module Network.HTTP.Download.Verified
1213
( verifiedDownload
1314
, recoveringHttp
@@ -19,38 +20,41 @@ module Network.HTTP.Download.Verified
1920
, VerifiedDownloadException(..)
2021
) where
2122

22-
import qualified Data.List as List
23-
import qualified Data.ByteString as ByteString
24-
import qualified Data.ByteString.Base64 as B64
25-
import qualified Data.Conduit.Binary as CB
26-
import qualified Data.Conduit.List as CL
27-
import qualified Data.Text as Text
28-
import qualified Data.Text.Encoding as Text
23+
import qualified Data.List as List
24+
import qualified Data.ByteString as ByteString
25+
import qualified Data.ByteString.Base64 as B64
26+
import qualified Data.Conduit.Binary as CB
27+
import qualified Data.Conduit.List as CL
28+
import qualified Data.Text as Text
29+
import qualified Data.Text.Encoding as Text
2930

30-
import Control.Monad
31-
import Control.Monad.Catch
32-
import Control.Monad.IO.Class
33-
import Control.Monad.Reader
34-
import Control.Retry (recovering,limitRetries,RetryPolicy,constantDelay)
35-
import Control.Applicative
31+
import Control.Applicative
32+
import Control.Monad
33+
import Control.Monad.Catch
34+
import Control.Monad.IO.Class
35+
import Control.Monad.Logger (logDebug, MonadLogger)
36+
import Control.Monad.Reader
37+
import Control.Retry (recovering,limitRetries,RetryPolicy,constantDelay)
3638
import "cryptohash" Crypto.Hash
37-
import Crypto.Hash.Conduit (sinkHash)
38-
import Data.ByteString (ByteString)
39-
import Data.ByteString.Char8 (readInteger)
40-
import Data.Conduit
41-
import Data.Conduit.Binary (sourceHandle, sinkHandle)
42-
import Data.Foldable (traverse_,for_)
43-
import Data.Monoid
44-
import Data.String
45-
import Data.Typeable (Typeable)
46-
import GHC.IO.Exception (IOException(..),IOErrorType(..))
47-
import Network.HTTP.Client.Conduit
48-
import Network.HTTP.Types.Header (hContentLength, hContentMD5)
49-
import Path
50-
import Prelude -- Fix AMP warning
51-
import System.FilePath((<.>))
52-
import System.Directory
53-
import System.IO
39+
import Crypto.Hash.Conduit (sinkHash)
40+
import Data.ByteString (ByteString)
41+
import Data.ByteString.Char8 (readInteger)
42+
import Data.Conduit
43+
import Data.Conduit.Binary (sourceHandle, sinkHandle)
44+
import Data.Foldable (traverse_,for_)
45+
import Data.Monoid
46+
import Data.String
47+
import Data.Text.Encoding (decodeUtf8With)
48+
import Data.Text.Encoding.Error (lenientDecode)
49+
import Data.Typeable (Typeable)
50+
import GHC.IO.Exception (IOException(..),IOErrorType(..))
51+
import Network.HTTP.Client.Conduit
52+
import Network.HTTP.Types.Header (hContentLength, hContentMD5)
53+
import Path
54+
import Prelude -- Fix AMP warning
55+
import System.Directory
56+
import System.FilePath ((<.>))
57+
import System.IO
5458

5559
-- | A request together with some checks to perform.
5660
data DownloadRequest = DownloadRequest
@@ -215,21 +219,23 @@ recoveringHttp retryPolicy =
215219
-- Throws VerifiedDownloadException.
216220
-- Throws IOExceptions related to file system operations.
217221
-- Throws HttpException.
218-
verifiedDownload :: (MonadReader env m, HasHttpManager env, MonadIO m)
222+
verifiedDownload :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m)
219223
=> DownloadRequest
220224
-> Path Abs File -- ^ destination
221225
-> (Maybe Integer -> Sink ByteString (ReaderT env IO) ()) -- ^ custom hook to observe progress
222226
-> m Bool -- ^ Whether a download was performed
223227
verifiedDownload DownloadRequest{..} destpath progressSink = do
224228
let req = drRequest
225229
env <- ask
226-
liftIO $ whenM' getShouldDownload $ do
227-
createDirectoryIfMissing True dir
228-
withBinaryFile fptmp WriteMode $ \h ->
229-
recoveringHttp drRetryPolicy $
230-
flip runReaderT env $
231-
withResponse req (go h)
232-
renameFile fptmp fp
230+
whenM' (liftIO getShouldDownload) $ do
231+
$logDebug $ "Downloading " <> decodeUtf8With lenientDecode (path req)
232+
liftIO $ do
233+
createDirectoryIfMissing True dir
234+
withBinaryFile fptmp WriteMode $ \h ->
235+
recoveringHttp drRetryPolicy $
236+
flip runReaderT env $
237+
withResponse req (go h)
238+
renameFile fptmp fp
233239
where
234240
whenM' mp m = do
235241
p <- mp

0 commit comments

Comments
 (0)