diff --git a/cabal-cache.cabal b/cabal-cache.cabal --- a/cabal-cache.cabal +++ b/cabal-cache.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: cabal-cache -version: 1.0.1.3 +version: 1.0.1.4 synopsis: CI Assistant for Haskell projects description: CI Assistant for Haskell projects. Implements package caching. homepage: https://github.com/haskell-works/cabal-cache @@ -28,8 +28,8 @@ common antiope-s3 { build-depends: antiope-s3 >= 7.4.4 && < 8 } common bytestring { build-depends: bytestring >= 0.10.8.2 && < 0.11 } common conduit-extra { build-depends: conduit-extra >= 1.3.1.1 && < 1.4 } -common cryptonite { build-depends: cryptonite >= 0.25 && < 1 } common containers { build-depends: containers >= 0.6.0.1 && < 0.7 } +common cryptonite { build-depends: cryptonite >= 0.25 && < 1 } common deepseq { build-depends: deepseq >= 1.4.4.0 && < 1.5 } common directory { build-depends: directory >= 1.3.3.0 && < 1.4 } common exceptions { build-depends: exceptions >= 0.10.1 && < 0.11 } @@ -116,6 +116,7 @@ HaskellWorks.CabalCache.Concurrent.Fork HaskellWorks.CabalCache.Concurrent.Type HaskellWorks.CabalCache.Core + HaskellWorks.CabalCache.Data.List HaskellWorks.CabalCache.Error HaskellWorks.CabalCache.GhcPkg HaskellWorks.CabalCache.Hash diff --git a/src/App/Commands/Options/Types.hs b/src/App/Commands/Options/Types.hs --- a/src/App/Commands/Options/Types.hs +++ b/src/App/Commands/Options/Types.hs @@ -20,7 +20,7 @@ data SyncFromArchiveOptions = SyncFromArchiveOptions { region :: Region - , archiveUri :: Location + , archiveUris :: [Location] , storePath :: FilePath , storePathHash :: Maybe String , threads :: Int diff --git a/src/App/Commands/SyncFromArchive.hs b/src/App/Commands/SyncFromArchive.hs --- a/src/App/Commands/SyncFromArchive.hs +++ b/src/App/Commands/SyncFromArchive.hs @@ -27,7 +27,7 @@ import Foreign.C.Error (eXDEV) import HaskellWorks.CabalCache.AppError import HaskellWorks.CabalCache.IO.Error (catchErrno, exceptWarn, maybeToExcept) -import HaskellWorks.CabalCache.Location (Location (..), toLocation, (<.>), ()) +import HaskellWorks.CabalCache.Location (toLocation, (<.>), ()) import HaskellWorks.CabalCache.Metadata (loadMetadata) import HaskellWorks.CabalCache.Show import HaskellWorks.CabalCache.Version (archiveVersion) @@ -38,6 +38,7 @@ import qualified Control.Concurrent.STM as STM import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as L import qualified Data.Map as M import qualified Data.Map.Strict as Map import qualified Data.Text as T @@ -45,6 +46,7 @@ import qualified HaskellWorks.CabalCache.Concurrent.DownloadQueue as DQ import qualified HaskellWorks.CabalCache.Concurrent.Fork as IO import qualified HaskellWorks.CabalCache.Core as Z +import qualified HaskellWorks.CabalCache.Data.List as L import qualified HaskellWorks.CabalCache.GhcPkg as GhcPkg import qualified HaskellWorks.CabalCache.Hash as H import qualified HaskellWorks.CabalCache.IO.Console as CIO @@ -64,17 +66,18 @@ runSyncFromArchive :: Z.SyncFromArchiveOptions -> IO () runSyncFromArchive opts = do - let storePath = opts ^. the @"storePath" - let archiveUri = opts ^. the @"archiveUri" - let threads = opts ^. the @"threads" - let awsLogLevel = opts ^. the @"awsLogLevel" - let versionedArchiveUri = archiveUri archiveVersion - let storePathHash = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath) - let scopedArchiveUri = versionedArchiveUri T.pack storePathHash + let storePath = opts ^. the @"storePath" + let archiveUris = opts ^. the @"archiveUris" + let threads = opts ^. the @"threads" + let awsLogLevel = opts ^. the @"awsLogLevel" + let versionedArchiveUris = archiveUris & each %~ ( archiveVersion) + let storePathHash = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath) + let scopedArchiveUris = versionedArchiveUris & each %~ ( T.pack storePathHash) CIO.putStrLn $ "Store path: " <> toText storePath CIO.putStrLn $ "Store path hash: " <> T.pack storePathHash - CIO.putStrLn $ "Archive URI: " <> toText archiveUri + forM_ archiveUris $ \archiveUri -> do + CIO.putStrLn $ "Archive URI: " <> toText archiveUri CIO.putStrLn $ "Archive version: " <> archiveVersion CIO.putStrLn $ "Threads: " <> tshow threads CIO.putStrLn $ "AWS Log level: " <> tshow awsLogLevel @@ -127,10 +130,10 @@ IO.forkThreadsWait threads $ DQ.runQueue downloadQueue $ \packageId -> case M.lookup packageId pInfos of Just pInfo -> do - let archiveBaseName = Z.packageDir pInfo <.> ".tar.gz" - let archiveFile = versionedArchiveUri T.pack archiveBaseName - let scopedArchiveFile = scopedArchiveUri T.pack archiveBaseName - let packageStorePath = storePath Z.packageDir pInfo + let archiveBaseName = Z.packageDir pInfo <.> ".tar.gz" + let archiveFiles = versionedArchiveUris & each %~ ( T.pack archiveBaseName) + let scopedArchiveFiles = scopedArchiveUris & each %~ ( T.pack archiveBaseName) + let packageStorePath = storePath Z.packageDir pInfo storeDirectoryExists <- doesDirectoryExist packageStorePath let maybePackage = M.lookup packageId planPackages @@ -145,7 +148,7 @@ else if storeDirectoryExists then return True else runResAws envAws $ onError (cleanupStorePath packageStorePath packageId) False $ do - (existingArchiveFileContents, existingArchiveFile) <- ExceptT $ IO.readFirstAvailableResource envAws [archiveFile, scopedArchiveFile] + (existingArchiveFileContents, existingArchiveFile) <- ExceptT $ IO.readFirstAvailableResource envAws (foldMap L.tuple2ToList (L.zip archiveFiles scopedArchiveFiles)) CIO.putStrLn $ "Extracting: " <> toText existingArchiveFile let tempArchiveFile = tempPath archiveBaseName @@ -204,11 +207,12 @@ <> showDefault <> value Oregon <> help "The AWS region in which to operate" ) - <*> option (maybeReader (toLocation . T.pack)) - ( long "archive-uri" - <> help "Archive URI to sync to" - <> metavar "S3_URI" - <> value (Local $ homeDirectory ".cabal" "archive") + <*> some + ( option (maybeReader (toLocation . T.pack)) + ( long "archive-uri" + <> help "Archive URI to sync to" + <> metavar "S3_URI" + ) ) <*> strOption ( long "store-path" diff --git a/src/HaskellWorks/CabalCache/Data/List.hs b/src/HaskellWorks/CabalCache/Data/List.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/CabalCache/Data/List.hs @@ -0,0 +1,10 @@ +module HaskellWorks.CabalCache.Data.List + ( tuple2ToDL + , tuple2ToList + ) where + +tuple2ToDL :: (a, a) -> [a] -> [a] +tuple2ToDL (a, b) = (a:) . (b:) + +tuple2ToList :: (a, a) -> [a] +tuple2ToList ab = tuple2ToDL ab []