module Distribution.Server.Features.Distro.Backup ( dumpBackup, restoreBackup, distroUsersToExport, distroUsersToCSV, distrosToExport, distroToCSV ) where import qualified Distribution.Server.Features.Distro.Distributions as Distros import Distribution.Server.Features.Distro.Distributions (DistroName, Distributions(..), DistroVersions(..), DistroPackageInfo(..)) import Distribution.Server.Features.Distro.State import Distribution.Server.Users.Group (UserList(..)) import Distribution.Server.Framework.BackupDump import Distribution.Server.Framework.BackupRestore import Distribution.Text import Data.Version import Text.CSV (CSV, Record) import qualified Data.Map as Map import Data.Map (Map) import qualified Data.IntSet as IntSet import Data.List (foldl') import System.FilePath (takeExtension) dumpBackup :: Distros -> [BackupEntry] dumpBackup allDist = let distros = distDistros allDist versions = distVersions allDist in distroUsersToExport distros:distrosToExport distros versions restoreBackup :: RestoreBackup Distros restoreBackup = updateDistros Distros.emptyDistributions Distros.emptyDistroVersions Map.empty updateDistros :: Distributions -> DistroVersions -> Map DistroName UserList -> RestoreBackup Distros updateDistros distros versions maintainers = RestoreBackup { restoreEntry = \entry -> case entry of BackupByteString ["packages", distro] bs | takeExtension distro == ".csv" -> do csv <- importCSV distro bs (distros', versions') <- importDistro csv distros versions return (updateDistros distros' versions' maintainers) BackupByteString ["maintainers.csv"] bs -> do csv <- importCSV "maintainers.csv" bs maintainers' <- importMaintainers csv maintainers return (updateDistros distros versions maintainers') _ -> return (updateDistros distros versions maintainers) , restoreFinalize = do let distros' = foldl' (\dists (name, group) -> Distros.modifyDistroMaintainers name (const group) dists) distros (Map.toList maintainers) return (Distros distros' versions) } importDistro :: CSV -> Distributions -> DistroVersions -> Restore (Distributions, DistroVersions) importDistro csv dists = \versions -> do let [[distroStr]] = take 1 $ drop 1 csv --no bounds checking.. distro <- parseText "distribution name" distroStr dists' <- addDistribution distro dists versions' <- concatM (map (fromRecord distro) (drop 3 csv)) versions return (dists', versions') where fromRecord :: DistroName -> Record -> DistroVersions -> Restore DistroVersions fromRecord distro [packageStr, versionStr, uri] versions = do package <- parseText "package name" packageStr version <- parseText "version" versionStr return (Distros.addPackage distro package (DistroPackageInfo version uri) versions) fromRecord _ x _ = fail $ "Invalid distribution record " ++ show x addDistribution :: DistroName -> Distributions -> Restore Distributions addDistribution distro dists = do case Distros.addDistro distro dists of Just dists' -> return dists' Nothing -> fail $ "Could not add distro: " ++ display distro importMaintainers :: CSV -> Map DistroName UserList -> Restore (Map DistroName UserList) importMaintainers = concatM . map fromRecord . drop 2 where fromRecord :: Record -> Map DistroName UserList -> Restore (Map DistroName UserList) fromRecord (distroStr:idStr) maintainers = do distro <- parseText "distribution name" distroStr ids <- mapM (parseRead "user id") idStr return (Map.insert distro (UserList $ IntSet.fromList ids) maintainers) fromRecord x _ = fail $ "Invalid distro maintainer record: " ++ show x -------------------------------------------------------------------------- distroUsersToExport :: Distributions -> BackupEntry distroUsersToExport distros = csvToBackup ["maintainers.csv"] (distroUsersToCSV assocUsers) where assocUsers = map (\(name, UserList ul) -> (name, IntSet.toList ul)) . Map.toList $ Distros.nameMap distros distroUsersToCSV :: [(DistroName, [Int])] -> CSV distroUsersToCSV users = [showVersion distrosCSVVer]:distrosCSVKey:map (\(name, ids) -> display name:map show ids) users where distrosCSVKey = ["distro", "maintainers"] distrosCSVVer = Version [0,1] ["unstable"] distrosToExport :: Distributions -> DistroVersions -> [BackupEntry] distrosToExport dists distInfo = map distroEntry (Distros.enumerate dists) where distroEntry distro = csvToBackup ["packages", display distro ++ ".csv"] (distroToCSV distro distInfo) distroToCSV :: DistroName -> DistroVersions -> CSV distroToCSV distro distInfo = let stats = Distros.distroStatus distro distInfo in ([showVersion distrosCSVVer]:) $ ([display distro]:) $ (distrosCSVKey:) $ flip map stats . uncurry $ \name (DistroPackageInfo version url) -> [display name, showVersion version, url] where distrosCSVKey = ["package", "version", "url"] distrosCSVVer = Version [0,1] ["unstable"]