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.Exception
( catch,
throwIO,
)
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.Function (on)
import Data.List as X
import Data.Maybe as X
import Data.Monoid as X
import Data.Version as X
import Paths_b9 (version)
import System.Directory (removeFile)
import System.Exit as X
( ExitCode (..),
exitWith,
)
import System.FilePath as X
( (<.>),
(</>),
replaceExtension,
takeDirectory,
takeFileName,
)
import System.IO.B9Extras as X
import System.IO.Error (isDoesNotExistError)
import Text.Printf as X
( printf,
)
import Text.Show.Pretty as X
( ppShow,
)
b9Version :: Version
b9Version = version
b9VersionString :: String
b9VersionString = showVersion version
runShowVersion :: MonadIO m => m ()
runShowVersion = liftIO $ putStrLn b9VersionString
runBuildArtifacts :: [FilePath] -> B9ConfigAction String
runBuildArtifacts buildFiles = do
generators <- mapM consult buildFiles
runB9 (buildArtifacts (mconcat generators))
runFormatBuildFiles :: MonadIO m => [FilePath] -> m ()
runFormatBuildFiles buildFiles = liftIO $ do
generators <- mapM consult buildFiles
let generatorsFormatted = map ppShow (generators :: [ArtifactGenerator])
putStrLn `mapM_` generatorsFormatted
zipWithM_ writeFile buildFiles generatorsFormatted
runPush :: SharedImageName -> B9ConfigAction ()
runPush name = localB9Config (keepTempDirs .~ False) $ runB9 $ do
conf <- getConfig
if isNothing (conf ^. repository)
then
errorExitL
"No repository specified! Use '-r' to specify a repo BEFORE 'push'."
else pushSharedImageLatestVersion name
runPull :: Maybe SharedImageName -> B9ConfigAction ()
runPull mName =
localB9Config
(keepTempDirs .~ False)
(runB9 (pullRemoteRepos >> maybePullImage))
where
maybePullImage =
mapM_
( \name -> pullLatestImage name >>= maybe (failPull name) (const (return ()))
)
mName
failPull name = errorExitL (printf "failed to pull: %s" (show name))
runRun :: SharedImageName -> [String] -> B9ConfigAction String
runRun (SharedImageName name) cmdAndArgs =
localB9Config
((keepTempDirs .~ False) . (interactive .~ True))
(runB9 (buildArtifacts runCmdAndArgs))
where
runCmdAndArgs =
Artifact
(IID ("run-" ++ name))
( VmImages
[ImageTarget Transient (From name KeepSize) (MountPoint "/")]
( VmScript
X86_64
[SharedDirectory "." (MountPoint "/mnt/CWD")]
(Run (head cmdAndArgs') (tail cmdAndArgs'))
)
)
where
cmdAndArgs' = if null cmdAndArgs then ["/usr/bin/zsh"] else cmdAndArgs
runGcLocalRepoCache :: B9ConfigAction ()
runGcLocalRepoCache = localB9Config (keepTempDirs .~ False) (runB9 impl)
where
impl = do
toDelete <-
obsoleteSharedmages . map snd
<$> lookupSharedImages
(== Cache)
(const True)
imgDir <- getSharedImagesCacheDir
let filesToDelete = (imgDir </>) <$> (infoFiles ++ imgFiles)
infoFiles = sharedImageFileName <$> toDelete
imgFiles = imageFileName . sharedImageImage <$> toDelete
if null filesToDelete
then liftIO $ putStrLn "\n\nNO IMAGES TO DELETE\n"
else liftIO $ do
putStrLn "DELETING FILES:"
putStrLn (unlines filesToDelete)
mapM_ removeIfExists filesToDelete
where
obsoleteSharedmages :: [SharedImage] -> [SharedImage]
obsoleteSharedmages =
concatMap (tail . reverse) . filter ((> 1) . length)
. groupBy
((==) `on` sharedImageName)
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `catch` handleExists
where
handleExists e
| isDoesNotExistError e = return ()
| otherwise = throwIO e
runGcRemoteRepoCache :: B9ConfigAction ()
runGcRemoteRepoCache =
localB9Config
(keepTempDirs .~ False)
( runB9
( do
repos <- getSelectedRepos
cache <- getRepoCache
mapM_ (cleanRemoteRepo cache) repos
)
)
runListSharedImages :: B9ConfigAction [SharedImage]
runListSharedImages =
localB9Config
(keepTempDirs .~ False)
( runB9
( do
MkSelectedRemoteRepo remoteRepo <- getSelectedRemoteRepo
let repoPred = maybe (== Cache) ((==) . toRemoteRepository) remoteRepo
allRepos <- getRemoteRepos
if isNothing remoteRepo
then liftIO $ do
putStrLn "Showing local shared images only.\n"
putStrLn "To view the contents of a remote repo add"
putStrLn "the '-r' switch with one of the remote"
putStrLn "repository ids."
else
liftIO $
putStrLn
( "Showing shared images on: "
++ remoteRepoRepoId (fromJust remoteRepo)
)
unless (null allRepos) $ liftIO $ do
putStrLn "\nAvailable remote repositories:"
mapM_ (putStrLn . (" * " ++) . remoteRepoRepoId) allRepos
imgs <- lookupSharedImages repoPred (const True)
if null imgs
then liftIO $ putStrLn "\n\nNO SHARED IMAGES\n"
else liftIO $ do
putStrLn ""
putStrLn $ prettyPrintSharedImages $ map snd imgs
return (map snd imgs)
)
)
runAddRepo :: RemoteRepo -> B9ConfigAction ()
runAddRepo repo = do
repo' <- remoteRepoCheckSshPrivKey repo
modifyPermanentConfig
( Endo
( remoteRepos
%~ ( mappend [repo']
. filter ((== remoteRepoRepoId repo') . remoteRepoRepoId)
)
)
)
runLookupLocalSharedImage ::
SharedImageName -> B9ConfigAction (Maybe SharedImageBuildId)
runLookupLocalSharedImage n = runB9 $ do
traceL (printf "Searching for cached image: %s" (show n))
imgs <- lookupSharedImages isAvailableOnLocalHost hasTheDesiredName
traceL "Candidate images: "
traceL (printf "%s\n" (prettyPrintSharedImages (map snd imgs)))
let res = extractNewestImageFromResults imgs
traceL (printf "Returning result: %s" (show res))
return res
where
extractNewestImageFromResults =
listToMaybe . map toBuildId . take 1 . reverse . map snd
where
toBuildId (SharedImage _ _ i _ _) = i
isAvailableOnLocalHost = (Cache ==)
hasTheDesiredName (SharedImage n' _ _ _ _) = n == n'