hackage-security 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+60/−43 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−0
• hackage-security.cabal +4/−1
• src/Hackage/Security/Client/Repository.hs +4/−4
• src/Hackage/Security/Client/Repository/Remote.hs +35/−38

@@ -0,0 +1,17 @@+0.3.0.0+-------+* Don't use compression for range requests (#101)+* Download index.tar.gz, not index.tar, if range request fails (#99)+* Minor change in the LogMessage type (hence the API version bumb)+* Include ChangeLog.md in the tarball (#98)++0.2.0.0+-------+* Allow for network-2.5 (rather than network-uri-2.6)+* Use cryptohash rather than SHA+* Various bugfixes+* API change: introduce RepoOpts in the Remote repository++0.1.0.0+-------+* Initial beta release

@@ -1,5 +1,5 @@ name:                hackage-security-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Hackage security library description:         The hackage security library provides both server and                      client utilities for securing the Hackage package server@@ -28,6 +28,9 @@ category:            Distribution build-type:          Simple cabal-version:       >=1.10++extra-source-files:+  ChangeLog.md  flag base48   description: Are we using base 4.8 or later?

@@ -313,8 +313,8 @@   | LogSelectedMirror MirrorDescription      -- | Updating a file failed-    -- (we will try again by downloading it whole)-  | LogUpdateFailed (Some RemoteFile) UpdateFailure+    -- (we will instead download it whole)+  | LogCannotUpdate (Some RemoteFile) UpdateFailure      -- | We got an exception with a particular mirror     -- (we will try with a different mirror if any are available)@@ -442,8 +442,8 @@       "Updating " ++ pretty file   pretty (LogSelectedMirror mirror) =       "Selected mirror " ++ mirror-  pretty (LogUpdateFailed (Some file) ex) =-      "Updating " ++ pretty file ++ " failed (" ++ pretty ex ++ ")"+  pretty (LogCannotUpdate (Some file) ex) =+      "Cannot update " ++ pretty file ++ " (" ++ pretty ex ++ ")"   pretty (LogMirrorFailed mirror ex) =       "Exception " ++ displayException ex ++ " when using mirror " ++ mirror 

@@ -62,18 +62,11 @@ data ServerCapabilities_ = ServerCapabilities {       -- | Does the server support range requests?       serverAcceptRangesBytes :: Bool--      -- | Did the server apply content compression previously?-      ---      -- We use this as a heuristic to decide whether we want to do an-      -- incremental update of the index or not.-    , serverUsedContentCompression :: Bool     }  newServerCapabilities :: IO ServerCapabilities newServerCapabilities = SC <$> newMVar ServerCapabilities {       serverAcceptRangesBytes      = False-    , serverUsedContentCompression = False     }  updateServerCapabilities :: ServerCapabilities -> [HttpResponseHeader] -> IO ()@@ -81,8 +74,6 @@     return $ caps {         serverAcceptRangesBytes = serverAcceptRangesBytes caps           || HttpResponseAcceptRangesBytes `elem` responseHeaders-      , serverUsedContentCompression = serverUsedContentCompression caps-          || HttpResponseContentCompression `elem` responseHeaders       }  checkServerCapability :: MonadIO m@@ -256,8 +247,11 @@ -- mess things up with respect to hashes etc). Additionally, after a validation -- error we want to make sure caches get files upstream in case the validation -- error was because the cache updated files out of order.-httpRequestHeaders :: RemoteConfig -> IsRetry -> [HttpRequestHeader]-httpRequestHeaders RemoteConfig{..} isRetry =+httpRequestHeaders :: RemoteConfig+                   -> IsRetry+                   -> DownloadMethod fs+                   -> [HttpRequestHeader]+httpRequestHeaders RemoteConfig{..} isRetry method =     case isRetry of       FirstAttempt           -> defaultHeaders       AfterVerificationError -> HttpRequestMaxAge0 : defaultHeaders@@ -267,10 +261,18 @@     defaultHeaders = concat [         [ HttpRequestNoTransform ]       , [ HttpRequestContentCompression-        | repoAllowContentCompression cfgOpts+        | repoAllowContentCompression cfgOpts && not (isRangeRequest method)         ]       ] +    -- If we are doing a range request, we must not request content compression:+    -- servers such as Apache interpret this range against the _compressed_+    -- stream, making it near useless for our purposes here.+    isRangeRequest :: DownloadMethod fs -> Bool+    isRangeRequest NeverUpdated{} = False+    isRangeRequest CannotUpdate{} = False+    isRangeRequest Update{}       = True+ -- | Mirror selection withMirror :: forall a.               HttpLib                -- ^ HTTP client@@ -342,11 +344,12 @@     -- We record the trailer for the file; that is, the number of bytes     -- (counted from the end of the file) that we should overwrite with     -- the remote file.-  | forall f. Update {-        updateFormat  :: HasFormat fs f-      , updateInfo    :: Trusted FileInfo-      , updateLocal   :: AbsolutePath-      , updateTrailer :: Integer+  | forall f f'. Update {+        updateFormat   :: HasFormat fs f+      , updateInfo     :: Trusted FileInfo+      , updateLocal    :: AbsolutePath+      , updateTrailer  :: Integer+      , downloadFormat :: HasFormat fs f'    -- ^ In case an update fails       }  pickDownloadMethod :: RemoteConfig@@ -391,24 +394,20 @@     let trailerLength = 1024      -- File sizes-    canCompress <- checkServerCapability cfgCaps serverUsedContentCompression-    localSize   <- liftIO $ getFileSize cachedIndex-    let infoGz = formatsLookup hasGz formats-        infoUn = formatsLookup hasUn formats-        estCompFactor = if canCompress && repoAllowContentCompression cfgOpts-                          then 10-                          else 1-        estUpdateSize = (fileLength' infoUn - fromIntegral localSize)-                          `div` estCompFactor-    unless (estUpdateSize < fileLength' infoGz) $+    localSize <- liftIO $ getFileSize cachedIndex+    let infoGz     = formatsLookup hasGz formats+        infoUn     = formatsLookup hasUn formats+        updateSize = fileLength' infoUn - fromIntegral localSize+    unless (updateSize < fileLength' infoGz) $       exit $ CannotUpdate hasGz UpdateTooLarge      -- If all these checks pass try to do an incremental update.     return Update {-         updateFormat  = hasUn-       , updateInfo    = infoUn-       , updateLocal   = cachedIndex-       , updateTrailer = trailerLength+         updateFormat   = hasUn+       , updateInfo     = infoUn+       , updateLocal    = cachedIndex+       , updateTrailer  = trailerLength+       , downloadFormat = hasGz        }  -- | Download the specified file using the given download method@@ -419,7 +418,8 @@         -> (forall f. HasFormat fs f -> TempPath -> IO a) -- ^ Callback         -> DownloadMethod fs    -- ^ Selected format         -> IO a-getFile cfg@RemoteConfig{..} isRetry remoteFile callback = go+getFile cfg@RemoteConfig{..} isRetry remoteFile callback method =+    go method   where     go :: (Throws VerificationError, Throws SomeRemoteError)        => DownloadMethod fs -> IO a@@ -427,17 +427,14 @@         cfgLogger $ LogDownloading (Some remoteFile)         download downloadFormat     go CannotUpdate{..} = do-        cfgLogger $ LogUpdateFailed (Some remoteFile) downloadReason+        cfgLogger $ LogCannotUpdate (Some remoteFile) downloadReason         cfgLogger $ LogDownloading (Some remoteFile)         download downloadFormat     go Update{..} = do         cfgLogger $ LogUpdating (Some remoteFile)         -- Attempt to download the file incrementally.         let updateFailed :: SomeException -> IO a-            updateFailed ex = do-              let failure = UpdateFailed ex-              cfgLogger $ LogUpdateFailed (Some remoteFile) failure-              go $ CannotUpdate updateFormat failure+            updateFailed = go . CannotUpdate downloadFormat . UpdateFailed              -- If verification of the file fails, and this is the first attempt,             -- we let the exception be thrown up to the security layer, so that@@ -459,7 +456,7 @@             update updateFormat updateInfo updateLocal updateTrailer      headers :: [HttpRequestHeader]-    headers = httpRequestHeaders cfg isRetry+    headers = httpRequestHeaders cfg isRetry method      -- Get any file from the server, without using incremental updates     download :: Throws SomeRemoteError => HasFormat fs f -> IO a