From 2ee29e312a612668fed650c7dd259f8d5c0b9c88 Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 20 Oct 2020 16:41:57 +1100 Subject: [PATCH] New output-restore-list option for capturing a list of all products restored --- app/App/Commands/Options/Types.hs | 15 ++++++++------- app/App/Commands/SyncFromArchive.hs | 18 +++++++++++++++++- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/app/App/Commands/Options/Types.hs b/app/App/Commands/Options/Types.hs index bccc71e4..d0525c3b 100644 --- a/app/App/Commands/Options/Types.hs +++ b/app/App/Commands/Options/Types.hs @@ -27,13 +27,14 @@ data PlanOptions = PlanOptions } deriving (Eq, Show, Generic) data SyncFromArchiveOptions = SyncFromArchiveOptions - { region :: Region - , archiveUris :: [Location] - , buildPath :: FilePath - , storePath :: FilePath - , storePathHash :: Maybe String - , threads :: Int - , awsLogLevel :: Maybe AWS.LogLevel + { region :: Region + , archiveUris :: [Location] + , buildPath :: FilePath + , storePath :: FilePath + , storePathHash :: Maybe String + , threads :: Int + , awsLogLevel :: Maybe AWS.LogLevel + , outputRestoreList :: Maybe FilePath } deriving (Eq, Show, Generic) data VersionOptions = VersionOptions deriving (Eq, Show, Generic) diff --git a/app/App/Commands/SyncFromArchive.hs b/app/App/Commands/SyncFromArchive.hs index 7de235eb..c9c288e3 100644 --- a/app/App/Commands/SyncFromArchive.hs +++ b/app/App/Commands/SyncFromArchive.hs @@ -50,6 +50,7 @@ import qualified HaskellWorks.CabalCache.IO.Lazy as IO import qualified HaskellWorks.CabalCache.IO.Tar as IO import qualified HaskellWorks.CabalCache.Types as Z import qualified System.Directory as IO +import qualified System.Exit as IO import qualified System.IO as IO import qualified System.IO.Temp as IO import qualified System.IO.Unsafe as IO @@ -71,6 +72,9 @@ runSyncFromArchive opts = do let storePathHash = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath) let scopedArchiveUris = versionedArchiveUris & each %~ ( T.pack storePathHash) + maybeHandleRestoreList <- forM (opts ^. the @"outputRestoreList") $ \restoreListFile -> do + IO.openFile restoreListFile IO.WriteMode + CIO.putStrLn $ "Store path: " <> toText storePath CIO.putStrLn $ "Store path hash: " <> T.pack storePathHash forM_ archiveUris $ \archiveUri -> do @@ -149,6 +153,10 @@ runSyncFromArchive opts = do (existingArchiveFileContents, existingArchiveFile) <- ExceptT $ IO.readFirstAvailableResource envAws (foldMap L.tuple2ToList (L.zip archiveFiles scopedArchiveFiles)) CIO.putStrLn $ "Extracting: " <> toText existingArchiveFile + forM_ maybeHandleRestoreList $ \handleRestoreList -> do + liftIO $ IO.hPutStrLn handleRestoreList (T.unpack (toText existingArchiveFile)) + liftIO $ IO.hFlush handleRestoreList + let tempArchiveFile = tempPath archiveBaseName liftIO $ LBS.writeFile tempArchiveFile existingArchiveFileContents IO.extractTar tempArchiveFile storePath @@ -180,8 +188,9 @@ runSyncFromArchive opts = do Left msg -> CIO.hPutStrLn IO.stderr msg Left appError -> do CIO.hPutStrLn IO.stderr $ "ERROR: Unable to parse plan.json file: " <> displayAppError appError + IO.exitFailure - return () + forM_ maybeHandleRestoreList IO.hClose cleanupStorePath :: (MonadIO m, MonadCatch m) => FilePath -> Z.PackageId -> AppError -> m () cleanupStorePath packageStorePath packageId e = do @@ -244,6 +253,13 @@ optsSyncFromArchive = SyncFromArchiveOptions <> metavar "AWS_LOG_LEVEL" ) ) + <*> optional + ( strOption + ( long "output-restore-list" + <> help "File to which a list of restored cabal store products will be written" + <> metavar "FILE" + ) + ) cmdSyncFromArchive :: Mod CommandFields (IO ()) cmdSyncFromArchive = command "sync-from-archive" $ flip info idm $ runSyncFromArchive <$> optsSyncFromArchive