module B9
( b9Version,
b9VersionString,
runShowVersion,
runBuildArtifacts,
runFormatBuildFiles,
runPush,
runPull,
runRun,
runGcLocalRepoCache,
runGcRemoteRepoCache,
runListSharedImages,
runAddRepo,
runLookupLocalSharedImage,
module X,
)
where
import B9.Artifact.Content as X
import B9.Artifact.Content.AST as X
import B9.Artifact.Content.CloudConfigYaml as X
import B9.Artifact.Content.ErlTerms as X
import B9.Artifact.Content.ErlangPropList as X
import B9.Artifact.Content.Readable as X
import B9.Artifact.Content.StringTemplate as X
import B9.Artifact.Content.YamlObject as X
import B9.Artifact.Readable as X
import B9.Artifact.Readable.Interpreter as X
import B9.B9Config as X
import B9.B9Error as X
import B9.B9Exec as X
import B9.B9Logging as X
import B9.B9Monad as X
import B9.BuildInfo as X
import B9.DiskImageBuilder as X
import B9.DiskImages as X
import B9.Environment as X
import B9.ExecEnv as X
import B9.QCUtil as X
import B9.Repository as X
import B9.RepositoryIO as X
import B9.ShellScript as X
import B9.Text as X
import B9.Vm as X
import B9.VmBuilder as X
import Control.Applicative as X
import Control.Lens as X
( (%~),
(&),
(.~),
Lens,
(^.),
)
import Control.Monad as X
import Control.Monad.IO.Class as X
import Control.Monad.Reader as X
( ReaderT,
ask,
local,
)
import Data.Foldable (fold)
import Data.List as X
import Data.Maybe as X
import Data.Monoid as X
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Version as X
import Paths_b9 (version)
import System.Exit as X
( ExitCode (..),
exitWith,
)
import System.FilePath as X
( (<.>),
(</>),
replaceExtension,
takeDirectory,
takeFileName,
)
import System.IO.B9Extras as X
import Text.Printf as X
( printf,
)
import Text.Show.Pretty as X
( ppShow,
)
b9Version :: Version
b9Version :: Version
b9Version = Version
version
b9VersionString :: String
b9VersionString :: String
b9VersionString = Version -> String
showVersion Version
version
runShowVersion :: MonadIO m => m ()
runShowVersion :: m ()
runShowVersion = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
b9VersionString
runBuildArtifacts :: [FilePath] -> B9ConfigAction String
runBuildArtifacts :: [String] -> B9ConfigAction String
runBuildArtifacts [String]
buildFiles = do
[ArtifactGenerator]
generators <- (String
-> Eff
'[B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO]
ArtifactGenerator)
-> [String]
-> Eff
'[B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO]
[ArtifactGenerator]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String
-> Eff
'[B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO]
ArtifactGenerator
forall (m :: * -> *) a. (MonadIO m, Read a) => String -> m a
consult [String]
buildFiles
B9 String -> B9ConfigAction String
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9 (ArtifactGenerator -> B9 String
buildArtifacts ([ArtifactGenerator] -> ArtifactGenerator
forall a. Monoid a => [a] -> a
mconcat [ArtifactGenerator]
generators))
runFormatBuildFiles :: MonadIO m => [FilePath] -> m ()
runFormatBuildFiles :: [String] -> m ()
runFormatBuildFiles [String]
buildFiles = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[ArtifactGenerator]
generators <- (String -> IO ArtifactGenerator)
-> [String] -> IO [ArtifactGenerator]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO ArtifactGenerator
forall (m :: * -> *) a. (MonadIO m, Read a) => String -> m a
consult [String]
buildFiles
let generatorsFormatted :: [String]
generatorsFormatted = (ArtifactGenerator -> String) -> [ArtifactGenerator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ArtifactGenerator -> String
forall a. Show a => a -> String
ppShow ([ArtifactGenerator]
generators :: [ArtifactGenerator])
String -> IO ()
putStrLn (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [String]
generatorsFormatted
(String -> String -> IO ()) -> [String] -> [String] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ String -> String -> IO ()
writeFile [String]
buildFiles [String]
generatorsFormatted
runPush :: SharedImageName -> B9ConfigAction ()
runPush :: SharedImageName -> B9ConfigAction ()
runPush SharedImageName
name = (B9Config -> B9Config) -> B9ConfigAction () -> B9ConfigAction ()
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config ((Bool -> Identity Bool) -> B9Config -> Identity B9Config
Lens' B9Config Bool
keepTempDirs ((Bool -> Identity Bool) -> B9Config -> Identity B9Config)
-> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False) (B9ConfigAction () -> B9ConfigAction ())
-> B9ConfigAction () -> B9ConfigAction ()
forall a b. (a -> b) -> a -> b
$ B9 () -> B9ConfigAction ()
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9 (B9 () -> B9ConfigAction ()) -> B9 () -> B9ConfigAction ()
forall a b. (a -> b) -> a -> b
$ do
B9Config
conf <- Eff B9Eff B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getConfig
if Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (B9Config
conf B9Config
-> Getting (Maybe String) B9Config (Maybe String) -> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) B9Config (Maybe String)
Lens' B9Config (Maybe String)
repository)
then
String -> B9 ()
forall (e :: [* -> *]) a.
(CommandIO e, Member ExcB9 e) =>
String -> Eff e a
errorExitL
String
"No repository specified! Use '-r' to specify a repo BEFORE 'push'."
else SharedImageName -> B9 ()
forall (e :: [* -> *]).
(Lifted IO e, CommandIO e,
'[SelectedRemoteRepoReader, RepoCacheReader, ExcB9] <:: e) =>
SharedImageName -> Eff e ()
pushSharedImageLatestVersion SharedImageName
name
runPull :: Maybe SharedImageName -> B9ConfigAction ()
runPull :: Maybe SharedImageName -> B9ConfigAction ()
runPull Maybe SharedImageName
mName =
(B9Config -> B9Config) -> B9ConfigAction () -> B9ConfigAction ()
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config
((Bool -> Identity Bool) -> B9Config -> Identity B9Config
Lens' B9Config Bool
keepTempDirs ((Bool -> Identity Bool) -> B9Config -> Identity B9Config)
-> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False)
(B9 () -> B9ConfigAction ()
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9 (B9 ()
forall (e :: [* -> *]).
(HasCallStack, Member ExcB9 e, Lifted IO e, CommandIO e,
'[SelectedRemoteRepoReader, RepoCacheReader] <:: e) =>
Eff e ()
pullRemoteRepos B9 () -> B9 () -> B9 ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> B9 ()
maybePullImage))
where
maybePullImage :: B9 ()
maybePullImage =
(SharedImageName -> B9 ()) -> Maybe SharedImageName -> B9 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
( \SharedImageName
name -> SharedImageName -> Eff B9Eff (Maybe SharedImageBuildId)
forall (e :: [* -> *]).
(HasCallStack, Lifted IO e, CommandIO e,
'[ExcB9, RepoCacheReader, SelectedRemoteRepoReader] <:: e) =>
SharedImageName -> Eff e (Maybe SharedImageBuildId)
pullLatestImage SharedImageName
name Eff B9Eff (Maybe SharedImageBuildId)
-> (Maybe SharedImageBuildId -> B9 ()) -> B9 ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= B9 ()
-> (SharedImageBuildId -> B9 ())
-> Maybe SharedImageBuildId
-> B9 ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SharedImageName -> B9 ()
forall a (e :: [* -> *]) (m :: * -> *) a.
(Show a, MonadBaseControl IO (Eff e), MonadIO m, FindElem ExcB9 e,
FindElem B9ConfigReader e, FindElem (Reader Logger) e,
SetMember Lift (Lift m) e) =>
a -> Eff e a
failPull SharedImageName
name) (B9 () -> SharedImageBuildId -> B9 ()
forall a b. a -> b -> a
const (() -> B9 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
)
Maybe SharedImageName
mName
failPull :: a -> Eff e a
failPull a
name = String -> Eff e a
forall (e :: [* -> *]) a.
(CommandIO e, Member ExcB9 e) =>
String -> Eff e a
errorExitL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"failed to pull: %s" (a -> String
forall a. Show a => a -> String
show a
name))
runRun :: SharedImageName -> [String] -> B9ConfigAction String
runRun :: SharedImageName -> [String] -> B9ConfigAction String
runRun (SharedImageName String
name) [String]
cmdAndArgs =
(B9Config -> B9Config)
-> B9ConfigAction String -> B9ConfigAction String
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config
(((Bool -> Identity Bool) -> B9Config -> Identity B9Config
Lens' B9Config Bool
keepTempDirs ((Bool -> Identity Bool) -> B9Config -> Identity B9Config)
-> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False) (B9Config -> B9Config)
-> (B9Config -> B9Config) -> B9Config -> B9Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe LogLevel -> Identity (Maybe LogLevel))
-> B9Config -> Identity B9Config
Lens' B9Config (Maybe LogLevel)
verbosity ((Maybe LogLevel -> Identity (Maybe LogLevel))
-> B9Config -> Identity B9Config)
-> Maybe LogLevel -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogTrace))
(B9 String -> B9ConfigAction String
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9Interactive (ArtifactGenerator -> B9 String
buildArtifacts ArtifactGenerator
runCmdAndArgs))
where
runCmdAndArgs :: ArtifactGenerator
runCmdAndArgs =
InstanceId -> ArtifactAssembly -> ArtifactGenerator
Artifact
(String -> InstanceId
IID (String
"run-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name))
( [ImageTarget] -> VmScript -> ArtifactAssembly
VmImages
[ImageDestination -> ImageSource -> MountPoint -> ImageTarget
ImageTarget ImageDestination
Transient (String -> ImageResize -> ImageSource
From String
name ImageResize
KeepSize) (String -> MountPoint
MountPoint String
"/")]
( CPUArch -> [SharedDirectory] -> Script -> VmScript
VmScript
CPUArch
X86_64
[String -> MountPoint -> SharedDirectory
SharedDirectory String
"." (String -> MountPoint
MountPoint String
"/mnt/CWD")]
(String -> [String] -> Script
Run ([String] -> String
forall a. [a] -> a
head [String]
cmdAndArgs') ([String] -> [String]
forall a. [a] -> [a]
tail [String]
cmdAndArgs'))
)
)
where
cmdAndArgs' :: [String]
cmdAndArgs' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdAndArgs then [String
"/usr/bin/zsh"] else [String]
cmdAndArgs
runGcLocalRepoCache :: B9ConfigAction ()
runGcLocalRepoCache :: B9ConfigAction ()
runGcLocalRepoCache = (B9Config -> B9Config) -> B9ConfigAction () -> B9ConfigAction ()
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config ((Bool -> Identity Bool) -> B9Config -> Identity B9Config
Lens' B9Config Bool
keepTempDirs ((Bool -> Identity Bool) -> B9Config -> Identity B9Config)
-> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False) (B9 () -> B9ConfigAction ()
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9 B9 ()
forall (e :: [* -> *]).
('[RepoCacheReader, ExcB9] <:: e, Lifted IO e, CommandIO e) =>
Eff e ()
cleanLocalRepoCache)
runGcRemoteRepoCache :: B9ConfigAction ()
runGcRemoteRepoCache :: B9ConfigAction ()
runGcRemoteRepoCache =
(B9Config -> B9Config) -> B9ConfigAction () -> B9ConfigAction ()
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config
((Bool -> Identity Bool) -> B9Config -> Identity B9Config
Lens' B9Config Bool
keepTempDirs ((Bool -> Identity Bool) -> B9Config -> Identity B9Config)
-> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False)
( B9 () -> B9ConfigAction ()
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9
( do
Set RemoteRepo
repos <- Eff B9Eff (Set RemoteRepo)
forall (e :: [* -> *]).
('[B9ConfigReader, SelectedRemoteRepoReader] <:: e) =>
Eff e (Set RemoteRepo)
getSelectedRepos
RepoCache
cache <- Eff B9Eff RepoCache
forall (e :: [* -> *]). Member RepoCacheReader e => Eff e RepoCache
getRepoCache
(RemoteRepo -> B9 ()) -> Set RemoteRepo -> B9 ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RepoCache -> RemoteRepo -> B9 ()
forall (m :: * -> *). MonadIO m => RepoCache -> RemoteRepo -> m ()
cleanRemoteRepo RepoCache
cache) Set RemoteRepo
repos
)
)
runListSharedImages :: B9ConfigAction (Set SharedImage)
runListSharedImages :: B9ConfigAction (Set SharedImage)
runListSharedImages =
(B9Config -> B9Config)
-> B9ConfigAction (Set SharedImage)
-> B9ConfigAction (Set SharedImage)
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config
((Bool -> Identity Bool) -> B9Config -> Identity B9Config
Lens' B9Config Bool
keepTempDirs ((Bool -> Identity Bool) -> B9Config -> Identity B9Config)
-> Bool -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False)
( B9 (Set SharedImage) -> B9ConfigAction (Set SharedImage)
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9
( do
MkSelectedRemoteRepo Maybe RemoteRepo
remoteRepo <- Eff B9Eff SelectedRemoteRepo
forall (e :: [* -> *]).
Member SelectedRemoteRepoReader e =>
Eff e SelectedRemoteRepo
getSelectedRemoteRepo
let repoPred :: Repository -> Bool
repoPred = (Repository -> Bool)
-> (RemoteRepo -> Repository -> Bool)
-> Maybe RemoteRepo
-> Repository
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Repository -> Repository -> Bool
forall a. Eq a => a -> a -> Bool
== Repository
Cache) (Repository -> Repository -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Repository -> Repository -> Bool)
-> (RemoteRepo -> Repository) -> RemoteRepo -> Repository -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> Repository
toRemoteRepository) Maybe RemoteRepo
remoteRepo
Set RemoteRepo
allRepos <- Eff B9Eff (Set RemoteRepo)
forall (e :: [* -> *]).
Member B9ConfigReader e =>
Eff e (Set RemoteRepo)
getRemoteRepos
if Maybe RemoteRepo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe RemoteRepo
remoteRepo
then IO () -> B9 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> B9 ()) -> IO () -> B9 ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"Showing local shared images only.\n"
String -> IO ()
putStrLn String
"To view the contents of a remote repo add"
String -> IO ()
putStrLn String
"the '-r' switch with one of the remote"
String -> IO ()
putStrLn String
"repository ids."
else
IO () -> B9 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> B9 ()) -> IO () -> B9 ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn
( String
"Showing shared images on: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ RemoteRepo -> String
remoteRepoRepoId (Maybe RemoteRepo -> RemoteRepo
forall a. HasCallStack => Maybe a -> a
fromJust Maybe RemoteRepo
remoteRepo)
)
Bool -> B9 () -> B9 ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set RemoteRepo -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set RemoteRepo
allRepos) (B9 () -> B9 ()) -> B9 () -> B9 ()
forall a b. (a -> b) -> a -> b
$ IO () -> B9 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> B9 ()) -> IO () -> B9 ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"\nAvailable remote repositories:"
(RemoteRepo -> IO ()) -> Set RemoteRepo -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> (RemoteRepo -> String) -> RemoteRepo -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (RemoteRepo -> String) -> RemoteRepo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> String
remoteRepoRepoId) Set RemoteRepo
allRepos
Set SharedImage
imgs <-
Map Repository (Set SharedImage) -> Set SharedImage
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
(Map Repository (Set SharedImage) -> Set SharedImage)
-> (Map Repository (Set SharedImage)
-> Map Repository (Set SharedImage))
-> Map Repository (Set SharedImage)
-> Set SharedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repository -> Bool)
-> (SharedImage -> Bool)
-> Map Repository (Set SharedImage)
-> Map Repository (Set SharedImage)
filterRepoImagesMap Repository -> Bool
repoPred (Bool -> SharedImage -> Bool
forall a b. a -> b -> a
const Bool
True)
(Map Repository (Set SharedImage) -> Set SharedImage)
-> Eff B9Eff (Map Repository (Set SharedImage))
-> B9 (Set SharedImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff B9Eff (Map Repository (Set SharedImage))
forall (e :: [* -> *]).
(HasCallStack, CommandIO e, Lifted IO e,
Member RepoCacheReader e) =>
Eff e (Map Repository (Set SharedImage))
getSharedImages
if Set SharedImage -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set SharedImage
imgs
then IO () -> B9 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> B9 ()) -> IO () -> B9 ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"\n\nNO SHARED IMAGES\n"
else IO () -> B9 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> B9 ()) -> IO () -> B9 ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Set SharedImage -> String
prettyPrintSharedImages Set SharedImage
imgs
Set SharedImage -> B9 (Set SharedImage)
forall (m :: * -> *) a. Monad m => a -> m a
return Set SharedImage
imgs
)
)
runAddRepo :: RemoteRepo -> B9ConfigAction ()
runAddRepo :: RemoteRepo -> B9ConfigAction ()
runAddRepo RemoteRepo
repo = do
RemoteRepo
repo' <- RemoteRepo
-> Eff
'[B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO]
RemoteRepo
forall (m :: * -> *). MonadIO m => RemoteRepo -> m RemoteRepo
remoteRepoCheckSshPrivKey RemoteRepo
repo
Endo B9Config -> B9ConfigAction ()
forall (e :: [* -> *]).
(HasCallStack, Member B9ConfigWriter e) =>
Endo B9Config -> Eff e ()
modifyPermanentConfig
( (B9Config -> B9Config) -> Endo B9Config
forall a. (a -> a) -> Endo a
Endo
( (Set RemoteRepo -> Identity (Set RemoteRepo))
-> B9Config -> Identity B9Config
Lens' B9Config (Set RemoteRepo)
remoteRepos
((Set RemoteRepo -> Identity (Set RemoteRepo))
-> B9Config -> Identity B9Config)
-> (Set RemoteRepo -> Set RemoteRepo) -> B9Config -> B9Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( Set RemoteRepo -> Set RemoteRepo -> Set RemoteRepo
forall a. Monoid a => a -> a -> a
mappend (RemoteRepo -> Set RemoteRepo
forall a. a -> Set a
Set.singleton RemoteRepo
repo')
(Set RemoteRepo -> Set RemoteRepo)
-> (Set RemoteRepo -> Set RemoteRepo)
-> Set RemoteRepo
-> Set RemoteRepo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRepo -> Bool) -> Set RemoteRepo -> Set RemoteRepo
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteRepo -> String
remoteRepoRepoId RemoteRepo
repo') (String -> Bool) -> (RemoteRepo -> String) -> RemoteRepo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> String
remoteRepoRepoId)
)
)
)
runLookupLocalSharedImage ::
SharedImageName -> B9ConfigAction (Maybe SharedImageBuildId)
runLookupLocalSharedImage :: SharedImageName -> B9ConfigAction (Maybe SharedImageBuildId)
runLookupLocalSharedImage SharedImageName
n = Eff B9Eff (Maybe SharedImageBuildId)
-> B9ConfigAction (Maybe SharedImageBuildId)
forall a. HasCallStack => B9 a -> B9ConfigAction a
runB9 (Eff B9Eff (Maybe SharedImageBuildId)
-> B9ConfigAction (Maybe SharedImageBuildId))
-> Eff B9Eff (Maybe SharedImageBuildId)
-> B9ConfigAction (Maybe SharedImageBuildId)
forall a b. (a -> b) -> a -> b
$ do
String -> B9 ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Searching for cached image: %s" (SharedImageName -> String
forall a. Show a => a -> String
show SharedImageName
n))
Set SharedImage
imgs <- SharedImageName
-> Map Repository (Set SharedImage) -> Set SharedImage
lookupCachedImages SharedImageName
n (Map Repository (Set SharedImage) -> Set SharedImage)
-> Eff B9Eff (Map Repository (Set SharedImage))
-> B9 (Set SharedImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff B9Eff (Map Repository (Set SharedImage))
forall (e :: [* -> *]).
(HasCallStack, CommandIO e, Lifted IO e,
Member RepoCacheReader e) =>
Eff e (Map Repository (Set SharedImage))
getSharedImages
String -> B9 ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL String
"Candidate images: "
String -> B9 ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s\n" (Set SharedImage -> String
prettyPrintSharedImages Set SharedImage
imgs))
let res :: Maybe SharedImageBuildId
res = if Set SharedImage -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set SharedImage
imgs then Maybe SharedImageBuildId
forall a. Maybe a
Nothing else SharedImageBuildId -> Maybe SharedImageBuildId
forall a. a -> Maybe a
Just (SharedImage -> SharedImageBuildId
sharedImageBuildId (Set SharedImage -> SharedImage
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Set SharedImage
imgs))
String -> B9 ()
forall (e :: [* -> *]). CommandIO e => String -> Eff e ()
traceL (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Returning result: %s" (Maybe SharedImageBuildId -> String
forall a. Show a => a -> String
show Maybe SharedImageBuildId
res))
Maybe SharedImageBuildId -> Eff B9Eff (Maybe SharedImageBuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SharedImageBuildId
res