haskell/hackage-server
1
1
Fork 0
mirror of https://github.com/haskell/hackage-server.git synced 2024-11-28 14:22:38 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1225 from RaoulHC/avoid-repeated-tarball-mirroring

Browse Source 
Filter out metadata revisions in index before mirroring
This commit is contained in:
gbaz 2023-10-17 18:46:45 -04:00 committed by GitHub
commit 5662ff4a0d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
exes/MirrorClient.hs
View File

@ -4,7 +4,9 @@ module Main (main) where
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Trans import Control.Monad.Trans
import Data.Function (on)
import Data.List import Data.List
import qualified Data.List.NonEmpty as NonEmpty
import Data.Version import Data.Version
import Network.Browser import Network.Browser
import System.Directory import System.Directory
@ -118,10 +120,14 @@ mirrorOnce verbosity opts
| null (selectedPkgs opts) = pkgsMissingFromDest | null (selectedPkgs opts) = pkgsMissingFromDest
| otherwise = subsetIndex (selectedPkgs opts) | otherwise = subsetIndex (selectedPkgs opts)
pkgsMissingFromDest pkgsMissingFromDest
pkgsToMirror' = filter (\(PkgIndexInfo pkg _ _ _) -> byPkgId cmp = on cmp (\(PkgIndexInfo pkg _ _ _) -> pkg)
pkg `Set.notMember` missingPkgs pkgsToMirror'
&& pkg `Set.notMember` unmirrorablePkgs ) -- Remove any duplicates in the index from metadata revisions
pkgsToMirror = map NonEmpty.head . NonEmpty.groupBy (byPkgId (==)) . sortBy (byPkgId compare)
$ filter (\(PkgIndexInfo pkg _ _ _) ->
pkg `Set.notMember` missingPkgs
&& pkg `Set.notMember` unmirrorablePkgs)
pkgsToMirror
mirrorCount = length pkgsToMirror' mirrorCount = length pkgsToMirror'
ignoreCount = length pkgsToMirror - mirrorCount ignoreCount = length pkgsToMirror - mirrorCount