diff --git a/README.md b/README.md index cba48eb..938d018 100644 --- a/README.md +++ b/README.md @@ -103,16 +103,16 @@ environment variable to your desired profile. The Romefile has three purposes: -1. Specifies what S3 bucket to use - `[Cache]` section. This section is __required__. +1. Specifies what caches to use - `[Cache]` section. This section is __required__. 1. Allows to use custom name mappings between repository names and framework names - `[RepositoryMap]` section. This section is __optional__ and can be omitted. 1. Allows to ignore certain framework names - `[IgnoreMap]` section. This section is __optional__ and can be omitted. - A Romefile looks like this: ``` [Cache] S3-Bucket = ios-dev-bucket + local = /tmp/Rome [RepositoryMap] HockeySDK-iOS = HockeySDK @@ -125,8 +125,10 @@ A Romefile looks like this: The Romefile is in the [INI format](https://en.wikipedia.org/wiki/INI_file) -#### S3Bucket section -This section contains the name of the S3 bucket you want Rome to use to upload/download. +#### Cache section +This section contains the name of: +- the S3 bucket you want Rome to use to upload/download. The key `S3-Bucket` is __required__. +- the path to local directory to use as an additional cache. The key `local` is __optional__. #### RepositoryMap This contains the mappings of git repository names with framework names. @@ -164,6 +166,7 @@ This is particularly useful in case not all your `Cartfile.resolved` entries pro Some repositories use Carthage as a simple mechanism to include other git repositories that do not produce frameworks. Even Carthage itself does this, to include xcconfigs. + Example: Suppose you have the following in your `Cartfile` @@ -172,8 +175,10 @@ Suppose you have the following in your `Cartfile` github "Quick/Nimble" github "jspahrsummers/xcconfigs" ``` + `xcconfigs` can be ignored by Rome by adding an `IgnoreMap` section in the Romefile + ``` [IgnoreMap] xcconfigs = xcconfigs @@ -237,6 +242,8 @@ Uploaded CatFramework to: CatFramework/CatFramework.framework-3.3.1.zip Uploaded CatFramework.dSYM to: CatFramework/CatFramework.framework.dSYM-3.3.1.zip ``` +If a local cache is specified in your `Romefile` and you wish to ignore it pass `--skip-local-cache` on the command line. + #### Downloading Downloading one or more frameworks and corresponding dSYMs @@ -256,6 +263,8 @@ Downloaded CatFramework from: CatFramework/CatFramework.framework.dSYM-3.3.1.zip Unzipped CatFramework from: CatFramework.framework.dSYM-3.3.1.zip ``` +If a local cache is specified in your `Romefile` and you wish to ignore it pass `--skip-local-cache` on the command line. + #### Listing Listing frameworks and reporting on their availability: diff --git a/Rome.cabal b/Rome.cabal index d9af80f..a58e38e 100644 --- a/Rome.cabal +++ b/Rome.cabal @@ -1,5 +1,5 @@ name: Rome -version: 0.7.1.14 +version: 0.8.0.17 synopsis: An S3 cache for Carthage description: Please see README.md homepage: https://github.com/blender/Rome @@ -29,12 +29,15 @@ library , mtl >= 2.2.1 , MissingH >= 1.3 , directory >= 1.2.2 + , filepath >= 1.4 , containers >= 0.5 , unordered-containers >= 0.2.7 + , conduit >= 1.2 , conduit-extra >= 1.1 , ini >= 0.3.5 , text >= 1.2 , time >= 1.5.0 + , transformers >= 0.4 , bytestring >= 0.10 , zip-archive >= 0.2 , resourcet >= 1.1 diff --git a/app/Main.hs b/app/Main.hs index 70627ef..f8da7c7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,7 +8,8 @@ import Options.Applicative as Opts romeVersion :: String -romeVersion = "0.7.1.14" +romeVersion = "0.8.0.17" + diff --git a/src/Data/Romefile.hs b/src/Data/Romefile.hs index 9160a03..d5e1cc1 100644 --- a/src/Data/Romefile.hs +++ b/src/Data/Romefile.hs @@ -11,6 +11,7 @@ module Data.Romefile , FrameworkName (..) , GitRepoName (..) , RomeFileParseResult (..) + , RomeCacheInfo (..) ) where @@ -18,9 +19,13 @@ import Data.Ini as INI import Data.Ini.Utils as INI import Data.HashMap.Strict as M import Data.Monoid +import Data.Maybe import Data.Text import Control.Monad.Except import Control.Monad.Trans +import System.Directory +import System.FilePath +import System.Path.NameManip @@ -36,12 +41,14 @@ data RomefileEntry = RomefileEntry { gitRepositoryName :: GitRepoName } deriving (Show, Eq) -data RomeFileParseResult = RomeFileParseResult { bucket :: Text +data RomeFileParseResult = RomeFileParseResult { cacheInfo :: RomeCacheInfo , repositoryMapEntries :: [RomefileEntry] , ignoreMapEntries :: [RomefileEntry] } - +data RomeCacheInfo = RomeCacheInfo { _bucket :: Text + , _localCacheDir :: Maybe FilePath + } -- |The name of the Romefile romefile :: String @@ -55,6 +62,10 @@ cacheSectionDelimiter = "Cache" s3BucketKey :: Text s3BucketKey = "S3-Bucket" +-- |The local cache dir Key +localCacheDirKey :: Text +localCacheDirKey = "local" + -- |The delimier of the REPOSITORYMAP section repositoryMapSectionDelimiter :: Text repositoryMapSectionDelimiter = "RepositoryMap" @@ -64,21 +75,28 @@ ignoreMapSectionDelimiter :: Text ignoreMapSectionDelimiter = "IgnoreMap" -parseRomefile :: (MonadIO m, MonadError String m) => FilePath -> m RomeFileParseResult +parseRomefile :: MonadIO m => FilePath -> ExceptT FilePath m RomeFileParseResult parseRomefile f = do eitherIni <- liftIO $ INI.readIniFile f case eitherIni of Left iniError -> throwError iniError Right ini -> do - eitherBucker <- getBucket ini - case eitherBucker of - Left e -> throwError $ "Error while parsing " <> f <> ": " <> unpack e - Right bucket -> do - repositoryMapEntries <- getRepostiryMapEntries ini - ignoreMapEntries <- getIgnoreMapEntries ini - return RomeFileParseResult {..} - -getBucket ini = requireKey s3BucketKey `inRequiredSection` cacheSectionDelimiter `fromIni'` ini + _bucket <- withExceptT toErrorMessage $ getBucket ini + maybeCacheDirAsText <- withExceptT toErrorMessage $ getLocalCacheDir ini + _localCacheDir <- liftIO $ mapM absolutize (unpack <$> maybeCacheDirAsText) + repositoryMapEntries <- getRepostiryMapEntries ini + ignoreMapEntries <- getIgnoreMapEntries ini + let cacheInfo = RomeCacheInfo {..} + return RomeFileParseResult { .. } + where + toErrorMessage :: Text -> String + toErrorMessage e = "Error while parsing " <> f <> ": " <> unpack e + +getBucket :: MonadIO m => Ini -> ExceptT Text m Text +getBucket ini = requireKey s3BucketKey `inRequiredSection` cacheSectionDelimiter `fromIni''` ini + +getLocalCacheDir :: MonadIO m => Ini -> ExceptT Text m (Maybe Text) +getLocalCacheDir ini = optionalKey localCacheDirKey `inRequiredSection` cacheSectionDelimiter `fromIni''` ini getRepostiryMapEntries :: MonadIO m => Ini -> m [RomefileEntry] getRepostiryMapEntries = getRomefileEntries repositoryMapSectionDelimiter @@ -98,3 +116,15 @@ getRomefileEntries sectionDelimiter ini = do (FrameworkName . unpack . strip) (splitOn "," frameworkCommonNames))) (M.toList m) + +-- | Take a path and makes it absolute resolving ../ and ~ +-- See https://www.schoolofhaskell.com/user/dshevchenko/cookbook/transform-relative-path-to-an-absolute-path +absolutize :: FilePath -> IO FilePath +absolutize aPath + | "~" `isPrefixOf` pack aPath = do + homePath <- getHomeDirectory + return $ normalise $ addTrailingPathSeparator homePath + ++ Prelude.tail aPath + | otherwise = do + pathMaybeWithDots <- absolute_path aPath + return $ fromJust $ guess_dotdot pathMaybeWithDots diff --git a/src/Lib.hs b/src/Lib.hs index a0f7358..edb6fd1 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -23,13 +23,16 @@ import Control.Applicative ((<|>)) import Control.Lens hiding (List) import Control.Monad import Control.Monad.Except -import Control.Monad.Reader (ReaderT, ask, runReaderT) +import Control.Monad.Reader (ReaderT, ask, runReaderT, MonadReader) import Control.Monad.Trans (MonadIO, lift, liftIO) +import Control.Monad.Trans.Maybe import Control.Monad.Trans.Resource (runResourceT) import qualified Data.ByteString.Lazy as L import Data.Cartfile import Data.Char (isSpace) -import Data.Conduit.Binary (sinkLbs) +import Data.Conduit (($$)) +import Data.Conduit.Binary (sinkFile, sinkLbs, sourceFile, + sourceLbs) import Data.Ini as INI import Data.Ini.Utils as INI import qualified Data.Map.Strict as M @@ -44,21 +47,31 @@ import Network.AWS.S3 as S3 import Options.Applicative as Opts import System.Directory import System.Environment +import System.FilePath {- Types -} -type Config = (AWS.Env, Bool) +type UDCEnv = (AWS.Env{-, VerifyFlag-}, SkipLocalCacheFlag, Bool) type RomeMonad = ExceptT String IO type RepositoryMap = M.Map GitRepoName [FrameworkName] type InvertedRepositoryMap = M.Map FrameworkName GitRepoName -data RomeCommand = Upload [GitRepoName] - | Download [GitRepoName] +data RomeCommand = Upload RomeUDCPayload + | Download RomeUDCPayload | List ListMode deriving (Show, Eq) +data RomeUDCPayload = RomeUDCPayload { _payload :: [GitRepoName] + -- , _verifyFlag :: VerifyFlag + , _skipLocalCacheFlag :: SkipLocalCacheFlag + } + deriving (Show, Eq) + +-- newtype VerifyFlag = VerifyFlag { _verify :: Bool } deriving (Show, Eq) +newtype SkipLocalCacheFlag = SkipLocalCacheFlag { _skipLocalCache :: Bool } deriving (Show, Eq) + data ListMode = All | Missing | Present @@ -69,13 +82,26 @@ data RomeOptions = RomeOptions { romeCommand :: RomeCommand } +{- Constants -} +carthageBuildDirecotryiOS :: String +carthageBuildDirecotryiOS = "Carthage/Build/iOS/" + +{- Commnad line arguments parsing -} + +-- verifyParser :: Parser VerifyFlag +-- verifyParser = VerifyFlag <$> Opts.switch ( Opts.long "verify" <> Opts.help "Verify that the framework has the same hash as specified in the Cartfile.resolved.") + +skipLocalCacheParser :: Parser SkipLocalCacheFlag +skipLocalCacheParser = SkipLocalCacheFlag <$> Opts.switch ( Opts.long "skip-local-cache" <> Opts.help "Ignore the local cache when performing the operation.") + +udcPayloadParser :: Opts.Parser RomeUDCPayload +udcPayloadParser = RomeUDCPayload <$> Opts.many (Opts.argument (GitRepoName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are uploaded.")) {- <*> verifyParser-} <*> skipLocalCacheParser -{- Functions -} uploadParser :: Opts.Parser RomeCommand -uploadParser = pure Upload <*> Opts.many (Opts.argument (GitRepoName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are uploaded.")) +uploadParser = pure Upload <*> udcPayloadParser downloadParser :: Opts.Parser RomeCommand -downloadParser = pure Download <*> Opts.many (Opts.argument (GitRepoName <$> str) (Opts.metavar "FRAMEWORKS..." <> Opts.help "Zero or more framework names. If zero, all frameworks and dSYMs are downloaded.")) +downloadParser = pure Download <*> udcPayloadParser listParser :: Opts.Parser RomeCommand listParser = pure List <*> ( @@ -96,6 +122,8 @@ parseRomeOptions = RomeOptions <$> parseRomeCommand <*> Opts.switch ( Opts.short withInfo :: Opts.Parser a -> String -> Opts.ParserInfo a withInfo opts desc = Opts.info (Opts.helper <*> opts) $ Opts.progDesc desc +{- Functions -} + getCartfileEntires :: RomeMonad [CartfileEntry] getCartfileEntires = do eitherCartfileEntries <- liftIO $ parseCartfileResolved cartfileResolved @@ -106,34 +134,33 @@ getCartfileEntires = do getRomefileEntries :: RomeMonad RomeFileParseResult getRomefileEntries = parseRomefile romefile -runRomeWithOptions :: AWS.Env -> RomeOptions -> ExceptT String IO () +runRomeWithOptions :: AWS.Env -> RomeOptions -> RomeMonad () runRomeWithOptions env (RomeOptions options verbose) = do cartfileEntries <- getCartfileEntires RomeFileParseResult { .. } <- getRomefileEntries - let s3BucketName = S3.BucketName bucket let respositoryMap = toRomeFilesEntriesMap repositoryMapEntries let ignoreNames = concatMap frameworkCommonNames ignoreMapEntries case options of - Upload [] -> do + Upload (RomeUDCPayload [] {-shouldVerify-} shouldIgnoreLocalCache) -> do let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries respositoryMap `filterOutFrameworkNamesAndVersionsIfNotIn` ignoreNames - liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName frameworkAndVersions) (env, verbose) + liftIO $ runReaderT (uploadFrameworksAndDsymsToCaches cacheInfo frameworkAndVersions) (env{-, shouldVerify-}, shouldIgnoreLocalCache, verbose) - Upload gitRepoNames -> do + Upload (RomeUDCPayload gitRepoNames {-shouldVerify-} shouldIgnoreLocalCache) -> do let frameworkAndVersions = constructFrameworksAndVersionsFrom (filterCartfileEntriesByGitRepoNames gitRepoNames cartfileEntries) respositoryMap `filterOutFrameworkNamesAndVersionsIfNotIn` ignoreNames - liftIO $ runReaderT (uploadFrameworksAndDsymsToS3 s3BucketName frameworkAndVersions) (env, verbose) + liftIO $ runReaderT (uploadFrameworksAndDsymsToCaches cacheInfo frameworkAndVersions) (env{-, shouldVerify-}, shouldIgnoreLocalCache, verbose) - Download [] -> do + Download (RomeUDCPayload [] {-shouldVerify-} shouldIgnoreLocalCache) -> do let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries respositoryMap `filterOutFrameworkNamesAndVersionsIfNotIn` ignoreNames - liftIO $ runReaderT (downloadFrameworksAndDsymsFromS3 s3BucketName frameworkAndVersions) (env, verbose) + liftIO $ runReaderT (downloadFrameworksAndDsymsFromCaches cacheInfo frameworkAndVersions) (env{-, shouldVerify-}, shouldIgnoreLocalCache, verbose) - Download gitRepoNames -> do + Download (RomeUDCPayload gitRepoNames {-shouldVerify-} shouldIgnoreLocalCache) -> do let frameworkAndVersions = constructFrameworksAndVersionsFrom (filterCartfileEntriesByGitRepoNames gitRepoNames cartfileEntries) respositoryMap `filterOutFrameworkNamesAndVersionsIfNotIn` ignoreNames - liftIO $ runReaderT (downloadFrameworksAndDsymsFromS3 s3BucketName frameworkAndVersions) (env, verbose) + liftIO $ runReaderT (downloadFrameworksAndDsymsFromCaches cacheInfo frameworkAndVersions) (env{-, shouldVerify-}, shouldIgnoreLocalCache, verbose) List listMode -> do let frameworkAndVersions = constructFrameworksAndVersionsFrom cartfileEntries respositoryMap `filterOutFrameworkNamesAndVersionsIfNotIn` ignoreNames - existing <- liftIO $ runReaderT (probeForFrameworks s3BucketName frameworkAndVersions) (env, verbose) + existing <- liftIO $ runReaderT (probeCachesForFrameworks cacheInfo frameworkAndVersions) (env, verbose) let namesVersionAndExisting = replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults (toInvertedRomeFilesEntriesMap repositoryMapEntries) . filterAccordingToListMode listMode $ zip frameworkAndVersions existing liftIO $ mapM_ (printProbeResult listMode) namesVersionAndExisting @@ -141,7 +168,6 @@ runRomeWithOptions env (RomeOptions options verbose) = do constructFrameworksAndVersionsFrom :: [CartfileEntry] -> RepositoryMap -> [(FrameworkName, Version)] constructFrameworksAndVersionsFrom cartfileEntries repositoryMap = deriveFrameworkNamesAndVersion repositoryMap cartfileEntries - filterRepoMapByGitRepoNames :: RepositoryMap -> [GitRepoName] -> RepositoryMap filterRepoMapByGitRepoNames repoMap gitRepoNames = M.unions $ map (restrictRepositoryMapToGitRepoName repoMap) gitRepoNames @@ -157,29 +183,41 @@ filterOutFrameworkNamesAndVersionsIfNotIn favs fns = [fv | fv <- favs, fst fv restrictRepositoryMapToGitRepoName:: RepositoryMap -> GitRepoName -> RepositoryMap restrictRepositoryMapToGitRepoName repoMap repoName = maybe M.empty (M.singleton repoName) $ repoName `M.lookup` repoMap -uploadFrameworksAndDsymsToS3 :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO () -uploadFrameworksAndDsymsToS3 s3Bucket = mapM_ (uploadFrameworkAndDsymToS3 s3Bucket) +uploadFrameworksAndDsymsToCaches :: RomeCacheInfo -> [(FrameworkName, Version)] -> ReaderT UDCEnv IO () +uploadFrameworksAndDsymsToCaches cacheInfo = mapM_ (uploadFrameworkAndDsymToCaches cacheInfo) -uploadFrameworkAndDsymToS3 :: BucketName -> (FrameworkName, Version) -> ReaderT (AWS.Env, Bool) IO () -uploadFrameworkAndDsymToS3 s3BucketName fv@(framework@(FrameworkName fwn), version) = do - (env, verbose) <- ask +uploadFrameworkAndDsymToCaches :: RomeCacheInfo -> (FrameworkName, Version) -> ReaderT UDCEnv IO () +uploadFrameworkAndDsymToCaches (RomeCacheInfo bucketName localCacheDir) fv@(f@(FrameworkName fwn), version) = do + readerEnv@(env {-, shouldVerify-}, SkipLocalCacheFlag skipLocalCache, verbose) <- ask frameworkExists <- liftIO $ doesDirectoryExist frameworkDirectory dSymExists <- liftIO $ doesDirectoryExist dSYMdirectory + when frameworkExists $ do when verbose $ sayLnWithTime $ "Staring to zip: " <> frameworkDirectory frameworkArchive <- zipDir frameworkDirectory verbose - uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) remoteFrameworkUploadPath fwn + runMaybeT $ + MaybeT (return localCacheDir) + >>= \dir -> liftIO $ + unless skipLocalCache $ saveBinaryToLocalCache dir (Zip.fromArchive frameworkArchive) remoteFrameworkUploadPath fwn verbose + runReaderT (uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) remoteFrameworkUploadPath fwn) (env, verbose) + when dSymExists $ do when verbose $ sayLnWithTime $ "Staring to zip: " <> dSYMdirectory dSYMArchive <- zipDir dSYMdirectory verbose - uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) remoteDsymUploadPath (fwn ++ ".dSYM") + runMaybeT $ + MaybeT (return localCacheDir) + >>= \dir -> liftIO $ + unless skipLocalCache $ saveBinaryToLocalCache dir (Zip.fromArchive dSYMArchive) remoteDsymUploadPath dSYMNameWithDSYMExtension verbose + runReaderT (uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) remoteDsymUploadPath (fwn ++ ".dSYM")) (env, verbose) + where - carthageBuildDirecotryiOS = "Carthage/Build/iOS/" - frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo framework + + s3BucketName = S3.BucketName bucketName + frameworkNameWithFrameworkExtension = appendFrameworkExtensionTo f frameworkDirectory = carthageBuildDirecotryiOS ++ frameworkNameWithFrameworkExtension - remoteFrameworkUploadPath = fwn ++ "/" ++ frameworkArchiveName fv + remoteFrameworkUploadPath = remoteFrameworkPath f version dSYMNameWithDSYMExtension = frameworkNameWithFrameworkExtension ++ ".dSYM" dSYMdirectory = carthageBuildDirecotryiOS ++ dSYMNameWithDSYMExtension remoteDsymUploadPath = fwn ++ "/" ++ dSYMArchiveName fv @@ -195,51 +233,135 @@ uploadBinary s3BucketName binaryZip destinationPath objectName = do sayFunc $ "Started uploading " <> objectName <> " to: " <> destinationPath rs <- AWS.trying AWS._Error (AWS.send $ S3.putObject s3BucketName objectKey body) case rs of - Left e -> sayFunc $ "Error uploading " <> objectName <> " : " <> errorString e + Left e -> sayFunc $ "Error uploading " <> objectName <> ": " <> errorString e Right _ -> sayFunc $ "Uploaded " <> objectName <> " to: " <> destinationPath -downloadFrameworksAndDsymsFromS3 :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO () -downloadFrameworksAndDsymsFromS3 s3BucketName = mapM_ (downloadFrameworkAndDsymFromS3 s3BucketName) +saveBinaryToLocalCache :: MonadIO m => FilePath -> L.ByteString -> FilePath -> String -> Bool -> m () +saveBinaryToLocalCache cachePath binaryZip destinationPath objectName verbose = do + when verbose $ + sayLnWithTime $ "Copying " <> objectName <> " to: " <> finalPath + liftIO $ createDirectoryIfMissing True (dropFileName finalPath) + liftIO . runResourceT $ sourceLbs binaryZip $$ sinkFile finalPath + where + finalPath = cachePath destinationPath + +downloadFrameworksAndDsymsFromCaches :: RomeCacheInfo -> [(FrameworkName, Version)] -> ReaderT UDCEnv IO () +downloadFrameworksAndDsymsFromCaches cacheInfo = mapM_ (downloadFrameworkAndDsymFromCaches cacheInfo) + +downloadFrameworkAndDsymFromCaches :: RomeCacheInfo -> (FrameworkName, Version) -> ReaderT UDCEnv IO () +downloadFrameworkAndDsymFromCaches (RomeCacheInfo bucketName localCacheDir) fv@(f@(FrameworkName fwn), version) = do + readerEnv@(env{-, shouldVerify-}, SkipLocalCacheFlag skipLocalCache, verbose) <- ask + let sayFunc = if verbose then sayLnWithTime else sayLn + case localCacheDir of + Just cacheDir -> do + + let frameworkLocalCachePath = cacheDir remoteFrameworkUploadPath + let dSYMLocalCachePath = cacheDir remotedSYMUploadPath + + when skipLocalCache $ do + eitherFrameworkBinary <- AWS.trying AWS._Error $ downloadBinary s3BucketName remoteFrameworkUploadPath fwn + case eitherFrameworkBinary of + Left e -> sayFunc $ "Error downloading " <> fwn <> " : " <> errorString e + Right frameworkBinary -> unzipBinary frameworkBinary fwn frameworkZipName verbose + + unless skipLocalCache $ do + frameworkExistsInLocalCache <- liftIO . doesFileExist $ frameworkLocalCachePath + + when frameworkExistsInLocalCache $ do + sayFunc $ "Found " <> fwn <> " in local cache at: " <> frameworkLocalCachePath + binary <- runResourceT $ sourceFile frameworkLocalCachePath $$ sinkLbs + unzipBinary binary fwn frameworkZipName verbose + + unless frameworkExistsInLocalCache $ do + eitherFrameworkBinary <- AWS.trying AWS._Error $ downloadBinary s3BucketName remoteFrameworkUploadPath fwn + case eitherFrameworkBinary of + Left e -> sayFunc $ "Error downloading " <> fwn <> " : " <> errorString e + Right frameworkBinary -> do + saveBinaryToLocalCache cacheDir frameworkBinary remoteFrameworkUploadPath fwn verbose + unzipBinary frameworkBinary fwn frameworkZipName verbose + + when skipLocalCache $ do + eitherdSYMBinary <- AWS.trying AWS._Error $ downloadBinary s3BucketName remotedSYMUploadPath dSYMName + case eitherdSYMBinary of + Left e -> sayFunc $ "Error downloading " <> dSYMName <> " : " <> errorString e + Right dSYMBinary -> unzipBinary dSYMBinary fwn dSYMZipName verbose + + unless skipLocalCache $ do + dSYMExistsInLocalCache <- liftIO . doesFileExist $ dSYMLocalCachePath + + when dSYMExistsInLocalCache $ do + sayFunc $ "Found " <> dSYMName <> " in local cache at: " <> dSYMLocalCachePath + binary <- runResourceT $ sourceFile dSYMLocalCachePath $$ sinkLbs + unzipBinary binary fwn dSYMZipName verbose + + unless dSYMExistsInLocalCache $ do + eitherdSYMBinary <- AWS.trying AWS._Error $ downloadBinary s3BucketName remotedSYMUploadPath dSYMName + case eitherdSYMBinary of + Left e -> sayFunc $ "Error downloading " <> dSYMName <> " : " <> errorString e + Right dSYMBinary -> do + saveBinaryToLocalCache cacheDir dSYMBinary remotedSYMUploadPath dSYMName verbose + unzipBinary dSYMBinary fwn dSYMZipName verbose + + Nothing -> do + eitherFrameworkBinary <- AWS.trying AWS._Error $ downloadBinary s3BucketName remoteFrameworkUploadPath fwn + case eitherFrameworkBinary of + Left e -> sayFunc $ "Error downloading " <> fwn <> " : " <> errorString e + Right frameworkBinary -> unzipBinary frameworkBinary fwn frameworkZipName verbose + + eitherdSYMBinary <- AWS.trying AWS._Error $ downloadBinary s3BucketName remotedSYMUploadPath (fwn ++ ".dSYM") + case eitherdSYMBinary of + Left e -> sayFunc $ "Error downloading " <> (fwn ++ ".dSYM") <> " : " <> errorString e + Right dSYMBinary -> unzipBinary dSYMBinary fwn dSYMZipName verbose -downloadFrameworkAndDsymFromS3 s3BucketName fv@(FrameworkName fwn, version) = do - downloadBinary s3BucketName remoteFrameworkUploadPath fwn frameworkZipName - downloadBinary s3BucketName remoteDsymUploadPath (fwn ++ ".dSYM") dSYMZipName where - frameworkZipName = frameworkArchiveName fv - remoteFrameworkUploadPath = fwn ++ "/" ++ frameworkArchiveName fv + s3BucketName = S3.BucketName bucketName + frameworkZipName = frameworkArchiveName f version + remoteFrameworkUploadPath = remoteFrameworkPath f version dSYMZipName = dSYMArchiveName fv - remoteDsymUploadPath = fwn ++ "/" ++ dSYMArchiveName fv + remotedSYMUploadPath = fwn ++ "/" ++ dSYMZipName + dSYMName = fwn ++ ".dSYM" -downloadBinary s3BucketName objectRemotePath objectName objectZipName = do - (env, verbose) <- ask + +downloadBinary s3BucketName objectRemotePath objectName = do + readerEnv@(env{-, shouldVerify-}, _, verbose) <- ask runResourceT . AWS.runAWS env $ do let sayFunc = if verbose then sayLnWithTime else sayLn when verbose $ sayFunc $ "Started downloading " <> objectName <> " from: " <> objectRemotePath - rs <- AWS.trying AWS._Error (AWS.send $ S3.getObject s3BucketName objectKey) - case rs of - Left e -> sayFunc $ "Error downloading " <> objectName <> " : " <> errorString e - Right goResponse -> do - lbs <- lift $ view S3.gorsBody goResponse `AWS.sinkBody` sinkLbs - sayFunc $ "Downloaded " <> objectName <> " from: " <> objectRemotePath - when verbose $ - sayFunc $ "Staring to unzip " <> objectZipName - liftIO $ Zip.extractFilesFromArchive (zipOptions verbose) (Zip.toArchive lbs) - sayFunc $ "Unzipped " <> objectName <> " from: " <> objectZipName + rs <- AWS.send $ S3.getObject s3BucketName objectKey + binary <- view S3.gorsBody rs `AWS.sinkBody` sinkLbs + sayFunc $ "Downloaded " <> objectName <> " from: " <> objectRemotePath + return binary + where objectKey = S3.ObjectKey . T.pack $ objectRemotePath -probeForFrameworks :: BucketName -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO [Bool] -probeForFrameworks s3BucketName = mapM (probeForFramework s3BucketName) +unzipBinary :: MonadIO m => L.ByteString -> String -> String -> Bool -> m () +unzipBinary objectBinary objectName objectZipName verbose = do + when verbose $ + sayLnWithTime $ "Staring to unzip " <> objectZipName + liftIO $ Zip.extractFilesFromArchive (zipOptions verbose) (Zip.toArchive objectBinary) + when verbose $ + sayLnWithTime $ "Unzipped " <> objectName <> " from: " <> objectZipName -probeForFramework :: BucketName -> (FrameworkName, Version) -> ReaderT (AWS.Env, Bool) IO Bool -probeForFramework s3BucketName fv@(FrameworkName fwn, version) = do + + +remoteFrameworkPath :: FrameworkName -> Version -> String +remoteFrameworkPath f@(FrameworkName fwn) v = fwn ++ "/" ++ frameworkArchiveName f v + +probeCachesForFrameworks :: RomeCacheInfo -> [(FrameworkName, Version)] -> ReaderT (AWS.Env, Bool) IO [Bool] +probeCachesForFrameworks cacheInfo = mapM (probeCachesForFramework cacheInfo) + +probeCachesForFramework :: RomeCacheInfo -> (FrameworkName, Version) -> ReaderT (AWS.Env, Bool) IO Bool +probeCachesForFramework (RomeCacheInfo bucketName localCacheDir) (f@(FrameworkName fwn), v) = do (env, verbose) <- ask runResourceT . AWS.runAWS env $ checkIfFrameworkExistsInBucket s3BucketName frameworkObjectKey verbose where - frameworkZipName = frameworkArchiveName fv + s3BucketName = S3.BucketName bucketName + frameworkZipName = frameworkArchiveName f v frameworkObjectKey = S3.ObjectKey . T.pack $ fwn ++ "/" ++ frameworkZipName +checkIfFrameworkExistsInBucket :: AWS.MonadAWS m => BucketName -> ObjectKey -> Bool -> m Bool checkIfFrameworkExistsInBucket s3BucketName frameworkObjectKey verbose = do rs <- AWS.trying AWS._Error (AWS.send $ S3.headObject s3BucketName frameworkObjectKey) case rs of @@ -283,8 +405,8 @@ filterCartfileEntriesByGitRepoNames repoNames cartfileEntries = [c | c <- cartfi appendFrameworkExtensionTo :: FrameworkName -> String appendFrameworkExtensionTo (FrameworkName a) = a ++ ".framework" -frameworkArchiveName :: (FrameworkName, Version) -> String -frameworkArchiveName (fwn, Version v) = appendFrameworkExtensionTo fwn ++ "-" ++ v ++ ".zip" +frameworkArchiveName :: FrameworkName -> Version -> String +frameworkArchiveName f (Version v) = appendFrameworkExtensionTo f ++ "-" ++ v ++ ".zip" dSYMArchiveName :: (FrameworkName, Version) -> String dSYMArchiveName (fwn, Version v) = appendFrameworkExtensionTo fwn ++ ".dSYM" ++ "-" ++ v ++ ".zip" @@ -294,7 +416,7 @@ splitWithSeparator a as = map T.unpack (T.split (== a) $ T.pack as) printProbeResult :: MonadIO m => ListMode -> ((String, Version), Bool) -> m () printProbeResult listMode ((frameworkName, Version v), present) | listMode == Missing || listMode == Present = sayLn frameworkName - | otherwise = sayLn $ frameworkName <> " " <> v <> " " <> printProbeStringForBool present + | otherwise = sayLn $ frameworkName <> " " <> v <> " " <> printProbeStringForBool present printProbeStringForBool :: Bool -> String printProbeStringForBool True = green <> "✔︎" <> noColor @@ -320,9 +442,9 @@ replaceKnownFrameworkNamesWitGitRepoNamesInProbeResults reverseRomeMap = map (re replaceResultIfFrameworkNameIsInMap :: InvertedRepositoryMap -> ((FrameworkName, Version), Bool) -> ((String, Version), Bool) replaceResultIfFrameworkNameIsInMap reverseRomeMap ((frameworkName@(FrameworkName fwn), version), present) = ((maybe fwn unGitRepoName (M.lookup frameworkName reverseRomeMap), version), present) -s3ConfigFile :: (MonadIO m) => m FilePath +s3ConfigFile :: MonadIO m => m FilePath s3ConfigFile = (++ p) `liftM` liftIO getHomeDirectory - where + where p = "/.aws/config" discoverRegion :: RomeMonad AWS.Region @@ -343,7 +465,6 @@ getRegionFromFile f profile = do Left e -> throwError e Right r -> return r - toRomeFilesEntriesMap :: [RomefileEntry] -> RepositoryMap toRomeFilesEntriesMap = M.fromList . map romeFileEntryToTuple