{-# LANGUAGE PatternGuards #-} module Distribution.Server.Features.BuildReports.Backup ( dumpBackup, restoreBackup, buildReportsToExport, packageReportsToExport ) where import Distribution.Server.Features.BuildReports.BuildReport (BuildReport) import qualified Distribution.Server.Features.BuildReports.BuildReport as Report import Distribution.Server.Features.BuildReports.BuildReports (BuildReports(..), PkgBuildReports(..), BuildReportId(..), BuildLog(..)) import qualified Distribution.Server.Features.BuildReports.BuildReports as Reports import qualified Distribution.Server.Framework.BlobStorage as BlobStorage import Distribution.Server.Framework.BackupDump import Distribution.Server.Framework.BackupRestore import Distribution.Server.Util.Parse (unpackUTF8, packUTF8) import Distribution.Package import Distribution.Text (display, simpleParse) import Distribution.Version import Control.Monad (foldM) import Data.Map (Map) import qualified Data.Map as Map import System.FilePath (splitExtension) import Data.ByteString.Lazy (ByteString) dumpBackup :: BuildReports -> [BackupEntry] dumpBackup = buildReportsToExport restoreBackup :: RestoreBackup BuildReports restoreBackup = updateReports Reports.emptyReports Map.empty -- when logs are encountered before their corresponding build reports type PartialLogs = Map (PackageId, BuildReportId) BuildLog updateReports :: BuildReports -> PartialLogs -> RestoreBackup BuildReports updateReports buildReports partialLogs = RestoreBackup { restoreEntry = \entry -> do case entry of BackupByteString ["package", pkgStr, reportItem] bs | Just pkgId <- simpleParse pkgStr , (num, ".txt") <- splitExtension reportItem -> do checkPackageVersion pkgStr pkgId (buildReports', partialLogs') <- importReport pkgId num bs buildReports partialLogs return (updateReports buildReports' partialLogs') BackupBlob ["package", pkgStr, reportItem] blobId | Just pkgId <- simpleParse pkgStr , (num, ".log") <- splitExtension reportItem -> do checkPackageVersion pkgStr pkgId (buildReports', partialLogs') <- importLog pkgId num blobId buildReports partialLogs return (updateReports buildReports' partialLogs') _ -> return (updateReports buildReports partialLogs) , restoreFinalize = foldM insertLog buildReports (Map.toList partialLogs) } insertLog :: BuildReports -> ((PackageId, BuildReportId), BuildLog) -> Restore BuildReports insertLog buildReps ((pkgId, reportId), buildLog) = case Reports.setBuildLog pkgId reportId (Just buildLog) buildReps of Just buildReps' -> return buildReps' Nothing -> fail $ "Build log #" ++ display reportId ++ " exists for " ++ display pkgId ++ " but report itself does not" checkPackageVersion :: String -> PackageIdentifier -> Restore () checkPackageVersion pkgStr pkgId = case packageVersion pkgId of Version [] [] -> fail $ "Build report package id " ++ show pkgStr ++ " must specify a version" _ -> return () importReport :: PackageId -> String -> ByteString -> BuildReports -> PartialLogs -> Restore (BuildReports, PartialLogs) importReport pkgId repIdStr contents buildReps partialLogs = do reportId <- parseText "report id" repIdStr report <- either fail return $ Report.parse (unpackUTF8 contents) let (mlog, partialLogs') = Map.updateLookupWithKey (\_ _ -> Nothing) (pkgId, reportId) partialLogs buildReps' = Reports.unsafeSetReport pkgId reportId (report, mlog) buildReps --doesn't check for duplicates return (buildReps', partialLogs') importLog :: PackageId -> String -> BlobStorage.BlobId -> BuildReports -> PartialLogs -> Restore (BuildReports, PartialLogs) importLog pkgId repIdStr blobId buildReps logs = do reportId <- parseText "report id" repIdStr let buildLog = BuildLog blobId case Reports.setBuildLog pkgId reportId (Just buildLog) buildReps of Nothing -> return (buildReps, Map.insert (pkgId, reportId) buildLog logs) Just buildReps' -> return (buildReps', logs) ------------------------------------------------------------------------------ buildReportsToExport :: BuildReports -> [BackupEntry] buildReportsToExport buildReports = concatMap (uncurry packageReportsToExport) (Map.toList $ Reports.reportsIndex buildReports) packageReportsToExport :: PackageId -> PkgBuildReports -> [BackupEntry] packageReportsToExport pkgId pkgReports = concatMap (uncurry $ reportToExport prefix) (Map.toList $ Reports.reports pkgReports) where prefix = ["package", display pkgId] reportToExport :: [FilePath] -> BuildReportId -> (BuildReport, Maybe BuildLog) -> [BackupEntry] reportToExport prefix reportId (report, mlog) = BackupByteString (getPath ".txt") (packUTF8 $ Report.show report) : case mlog of Nothing -> []; Just (BuildLog blobId) -> [blobToBackup (getPath ".log") blobId] where getPath ext = prefix ++ [display reportId ++ ext]