hackage-mirror 0.1.0.0 → 0.1.1.1

raw patch · 4 files changed

+45/−40 lines, 4 filesdep ~basedep ~retrydep ~transformersnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, retry, transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−0
• README.md +4/−1
• hackage-mirror.cabal +5/−5
• src/Hackage/Mirror.hs +33/−34

@@ -0,0 +1,3 @@+## 0.1.1.1++* Support retry 0.7 [#4](https://github.com/fpco/hackage-mirror/issues/4)

@@ -1,10 +1,13 @@ # Hackage Mirror +![TravisCI](https://travis-ci.org/fpco/hackage-mirror.svg)+![Hackage](https://img.shields.io/hackage/v/hackage-mirror.svg)+ A tool to create an AWS S3 mirror of Hackage.  ## Install -    cabal install+    cabal install hackage-mirror  ## Usage 

@@ -1,5 +1,5 @@ name:                hackage-mirror-version:             0.1.0.0+version:             0.1.1.1 synopsis:            Simple mirroring utility for Hackage description:         Package allows you to mirror all of hackage to your own s3 bucket. homepage:            http://fpcomplete.com@@ -10,7 +10,7 @@ maintainer:          tim@fpcomplete.com category:            Distribution build-type:          Simple-extra-source-files:  README.md+extra-source-files:  README.md ChangeLog.md cabal-version:       >=1.10  source-repository head@@ -22,7 +22,7 @@   hs-source-dirs:      src   exposed-modules:     Hackage.Mirror   build-depends:       aws >=0.11-                     , base >=4.7 && <5+                     , base >=4.6 && <5                      , bytestring                      , cereal                      , conduit@@ -49,14 +49,14 @@                      , temporary                      , text                      , thyme-                     , transformers >=0.4+                     , transformers                      , unordered-containers  executable hackage-mirror   default-language:    Haskell2010   hs-source-dirs:      main   main-is:             Main.hs-  build-depends:       base >=4.7 && <5+  build-depends:       base >=4.6 && <5                      , hackage-mirror                      , monad-logger                      , optparse-applicative

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}@@ -71,8 +72,9 @@       MonadResource(..),       MonadThrow,       transResourceT,-      monadThrow )-import Control.Retry ( retrying, (<>) )+      monadThrow,+      runResourceT )+import Control.Retry ( retrying ) import qualified Crypto.Hash.SHA512 as SHA512 ( hashlazy ) import Data.ByteString ( ByteString ) import qualified Data.ByteString.Lazy as BL@@ -82,7 +84,7 @@     ( sourceLbs, sourceFile, sinkLbs, sinkFile ) import qualified Data.Conduit.Lazy as CL     ( MonadActive, lazyConsume )-import qualified Data.Conduit.List as CL ( mapMaybeM )+import qualified Data.Conduit.List as CL ( mapMaybeM, sinkNull ) import Data.Conduit.Zlib as CZ     ( WindowBits(WindowBits), ungzip, compress ) import Data.Default ( def )@@ -90,6 +92,7 @@     ( insert, fromList, lookup, toList, empty ) import Data.IORef ( newIORef ) import Data.List ( isPrefixOf )+import qualified Data.Monoid as Monoid import Data.Serialize ( encode, decodeLazy ) import qualified Data.Text as T ( unpack, pack, isInfixOf ) import qualified Data.Text.Encoding as T ( encodeUtf8 )@@ -97,7 +100,8 @@     ( Response(responseBody),       RequestBody(RequestBodyLBS),       Manager,-      withManager,+      newManager,+      tlsManagerSettings,       http,       parseUrl ) import System.Directory ( doesFileExist, createDirectoryIfMissing )@@ -130,7 +134,7 @@   | FilePath  packageFullName :: Package -> String-packageFullName Package {..} = packageName <> "-" <> packageVersion+packageFullName Package {..} = packageName Monoid.<> "-" Monoid.<> packageVersion  pathKind :: String -> PathKind pathKind url@@ -150,10 +154,10 @@             case splitDirectories (Tar.entryPath ent) of                 [name, vers, _] ->                     yield $ Package name vers cabal-                        (T.encodeUtf8 (T.pack (name <> vers))) ent-                ["preferred-versions"] -> return ()+                        (T.encodeUtf8 (T.pack (name Monoid.<> vers))) ent+                (reverse -> "preferred-versions":_) -> return ()                 _ -> $(logError) $ "Failed to parse package name: "-                               <> T.pack (Tar.entryPath ent)+                               Monoid.<> T.pack (Tar.entryPath ent)             sinkEntries entries         | otherwise = sinkEntries entries     sinkEntries Tar.Done = return ()@@ -191,7 +195,11 @@          -> ResourceT m (Aws.Response (Aws.ResponseMetadata a) a) awsRetry cfg svcfg mgr r =     transResourceT liftIO $+#if MIN_VERSION_retry(0,7,0)+        retrying def (const $ return . isLeft . Aws.responseResult) $ const $ Aws.aws cfg svcfg mgr r+#else         retrying def (const $ return . isLeft . Aws.responseResult) $ Aws.aws cfg svcfg mgr r+#endif   where     isLeft Left{} = True     isLeft Right{} = False@@ -269,7 +277,8 @@ mirrorHackage Options {..} = do     ref <- liftIO (newIORef [])     cfg <- mkCfg ref-    withManager $ \mgr -> do+    mgr <- liftIO $ newManager tlsManagerSettings+    runResourceT $ do         sums <- getChecksums cfg mgr         putChecksums cfg mgr "00-checksums.bak" sums         newSums <- liftIO $ newTVarIO sums@@ -280,28 +289,21 @@                 sums' <- liftIO $ readTVarIO newSums                 putChecksums cfg mgr "00-checksums.dat" sums'   where-    go cfg mgr sums newSums changed = do-        ents <- CL.lazyConsume $-            getEntries cfg mgr $= processEntries cfg mgr sums newSums changed+    go cfg mgr sums newSums changed = withTemp "index" $ \temp -> do+        $(logInfo) [st|Downloading index.tar.gz from #{from}|]+        download cfg svccfg mgr from "00-index.tar.gz" $$ CB.sinkFile temp -        -- Use a temp file as a "backing store" to accumulate the new tarball.-        -- Only when it is complete and we've reached the end normally do we-        -- copy the file onto the server.  The checksum file is saved in all-        -- cases so that we know what we mirrored in this session; the index-        -- file, meanwhile, is always valid (albeit temporarily out-of-date if-        -- we abort due to an exception).-        withTemp "index" $ \temp -> do-            CB.sourceLbs (Tar.write ents)-                $= CZ.compress 7 (WindowBits 31) -- gzip compression-                $$ CB.sinkFile temp+        getEntries cfg mgr temp+            $$ processEntries cfg mgr sums newSums changed+            $= CL.sinkNull -            -- Writing the tarball is what causes the changed bit to be-            -- calculated, so we write it first to a temp file and then only-            -- upload it if necessary.-            ch <- liftIO $ readTVarIO changed-            when ch $ void $ do-                _ <- push cfg mgr "00-index.tar.gz" $ CB.sourceFile temp-                $(logInfo) [st|Uploaded 00-index.tar.gz|]+        -- Writing the tarball is what causes the changed bit to be+        -- calculated, so we write it first to a temp file and then only+        -- upload it if necessary.+        ch <- liftIO $ readTVarIO changed+        when ch $ void $ do+            _ <- push cfg mgr "00-index.tar.gz" $ CB.sourceFile temp+            $(logInfo) [st|Uploaded 00-index.tar.gz|]      processEntries cfg mgr sums newSums changed =         CL.mapMaybeM $ \pkg@(Package {..}) -> do@@ -347,7 +349,7 @@                 let msg = T.pack (show (e :: SomeException))                 unless ("No tarball exists for this package version"                         `T.isInfixOf` msg) $-                    $(logError) $ "FAILED " <> T.pack file <> ": " <> msg+                    $(logError) $ "FAILED " Monoid.<> T.pack file Monoid.<> ": " Monoid.<> msg         return eres      getChecksums cfg mgr = do@@ -363,10 +365,7 @@         void $ push cfg mgr file $ yield (encode (M.toList sums))         $(logInfo) [st|Uploaded #{file}|] -    getEntries cfg mgr = do-        $(logInfo) [st|Downloading index.tar.gz from #{from}|]-        indexPackages $-            download cfg svccfg mgr from "00-index.tar.gz" $= CZ.ungzip+    getEntries cfg mgr temp = indexPackages $ CB.sourceFile temp $= CZ.ungzip      withTemp :: MonadBaseControl IO m => String -> (FilePath -> m ()) -> m ()     withTemp prefix f = control $ \run ->