{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Docker
(dockerCmdName
,dockerHelpOptName
,dockerPullCmdName
,entrypoint
,preventInContainer
,pull
,reset
,reExecArgName
,StackDockerException(..)
,getProjectRoot
,runContainerAndExit
) where
import Stack.Prelude
import qualified Crypto.Hash as Hash (Digest, MD5, hash)
import Pantry.Internal.AesonExtended (FromJSON(..),(.:),(.:?),(.!=),eitherDecode)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Char (isAscii,isDigit)
import Data.Conduit.List (sinkNull)
import Data.Conduit.Process.Typed hiding (proc)
import Data.List (dropWhileEnd,isPrefixOf,isInfixOf)
import Data.List.Extra (trim)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (UTCTime)
import qualified Data.Version (showVersion, parseVersion)
import Distribution.Version (mkVersion, mkVersion')
import Path
import Path.Extra (toFilePathNoTrailingSep)
import Path.IO hiding (canonicalizePath)
import qualified Paths_stack as Meta
import Stack.Config (getInContainer)
import Stack.Constants
import Stack.Constants.Config
import Stack.Setup (ensureDockerStackExe)
import Stack.Storage.User (loadDockerImageExeCache,saveDockerImageExeCache)
import Stack.Types.Version
import Stack.Types.Config
import Stack.Types.Docker
import System.Environment (getEnv,getEnvironment,getProgName,getArgs,getExecutablePath)
import qualified System.FilePath as FP
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe (unsafePerformIO)
import qualified System.PosixCompat.User as User
import qualified System.PosixCompat.Files as Files
import System.Terminal (hIsTerminalDeviceOrMinTTY)
import Text.ParserCombinators.ReadP (readP_to_S)
import RIO.Process
import qualified RIO.Directory
#ifndef WINDOWS
import System.Posix.Signals
import qualified System.Posix.User as PosixUser
#endif
getCmdArgs
:: HasConfig env
=> DockerOpts
-> Inspect
-> Bool
-> RIO env (FilePath,[String],[(String,String)],[Mount])
getCmdArgs :: DockerOpts
-> Inspect
-> Bool
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
getCmdArgs docker :: DockerOpts
docker imageInfo :: Inspect
imageInfo isRemoteDocker :: Bool
isRemoteDocker = do
Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
Maybe DockerUser
deUser <-
if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Bool
not Bool
isRemoteDocker) (DockerOpts -> Maybe Bool
dockerSetUser DockerOpts
docker)
then IO (Maybe DockerUser) -> RIO env (Maybe DockerUser)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DockerUser) -> RIO env (Maybe DockerUser))
-> IO (Maybe DockerUser) -> RIO env (Maybe DockerUser)
forall a b. (a -> b) -> a -> b
$ do
UserID
duUid <- IO UserID
User.getEffectiveUserID
GroupID
duGid <- IO GroupID
User.getEffectiveGroupID
[GroupID]
duGroups <- [GroupID] -> [GroupID]
forall a. Ord a => [a] -> [a]
nubOrd ([GroupID] -> [GroupID]) -> IO [GroupID] -> IO [GroupID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [GroupID]
User.getGroups
FileMode
duUmask <- FileMode -> IO FileMode
Files.setFileCreationMask 0o022
FileMode
_ <- FileMode -> IO FileMode
Files.setFileCreationMask FileMode
duUmask
Maybe DockerUser -> IO (Maybe DockerUser)
forall (m :: * -> *) a. Monad m => a -> m a
return (DockerUser -> Maybe DockerUser
forall a. a -> Maybe a
Just DockerUser :: UserID -> GroupID -> [GroupID] -> FileMode -> DockerUser
DockerUser{..})
else Maybe DockerUser -> RIO env (Maybe DockerUser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DockerUser
forall a. Maybe a
Nothing
[FilePath]
args <-
([FilePath] -> [FilePath])
-> RIO env [FilePath] -> RIO env [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(["--" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
reExecArgName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
Data.Version.showVersion Version
Meta.version
,"--" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dockerEntrypointArgName
,DockerEntrypoint -> FilePath
forall a. Show a => a -> FilePath
show DockerEntrypoint :: Maybe DockerUser -> DockerEntrypoint
DockerEntrypoint{..}] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++)
(IO [FilePath] -> RIO env [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getArgs)
case DockerOpts -> Maybe DockerStackExe
dockerStackExe (Config -> DockerOpts
configDocker Config
config) of
Just DockerStackExeHost
| Config -> Platform
configPlatform Config
config Platform -> Platform -> Bool
forall a. Eq a => a -> a -> Bool
== Platform
dockerContainerPlatform -> do
Path Abs File
exePath <- FilePath -> RIO env (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' (FilePath -> RIO env (Path Abs File))
-> RIO env FilePath -> RIO env (Path Abs File)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath -> RIO env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
[FilePath]
-> Path Abs File
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall (m :: * -> *) b b a.
Monad m =>
b -> Path b File -> m (FilePath, b, [a], [Mount])
cmdArgs [FilePath]
args Path Abs File
exePath
| Bool
otherwise -> StackDockerException
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO StackDockerException
UnsupportedStackExeHostPlatformException
Just DockerStackExeImage -> do
FilePath
progName <- IO FilePath -> RIO env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getProgName
(FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
FP.takeBaseName FilePath
progName, [FilePath]
args, [], [])
Just (DockerStackExePath path :: Path Abs File
path) -> do
[FilePath]
-> Path Abs File
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall (m :: * -> *) b b a.
Monad m =>
b -> Path b File -> m (FilePath, b, [a], [Mount])
cmdArgs [FilePath]
args Path Abs File
path
Just DockerStackExeDownload -> [FilePath]
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall env b a.
HasConfig env =>
b -> RIO env (FilePath, b, [a], [Mount])
exeDownload [FilePath]
args
Nothing
| Config -> Platform
configPlatform Config
config Platform -> Platform -> Bool
forall a. Eq a => a -> a -> Bool
== Platform
dockerContainerPlatform -> do
(exePath :: Path Abs File
exePath,exeTimestamp :: UTCTime
exeTimestamp,misCompatible :: Maybe Bool
misCompatible) <-
do Path Abs File
exePath <- FilePath -> RIO env (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' (FilePath -> RIO env (Path Abs File))
-> RIO env FilePath -> RIO env (Path Abs File)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath -> RIO env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
UTCTime
exeTimestamp <- Path Abs File -> RIO env UTCTime
forall (m :: * -> *) b t. MonadIO m => Path b t -> m UTCTime
getModificationTime Path Abs File
exePath
Maybe Bool
isKnown <-
Text -> Path Abs File -> UTCTime -> RIO env (Maybe Bool)
forall env.
(HasConfig env, HasLogFunc env) =>
Text -> Path Abs File -> UTCTime -> RIO env (Maybe Bool)
loadDockerImageExeCache
(Inspect -> Text
iiId Inspect
imageInfo)
Path Abs File
exePath
UTCTime
exeTimestamp
(Path Abs File, UTCTime, Maybe Bool)
-> RIO env (Path Abs File, UTCTime, Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File
exePath, UTCTime
exeTimestamp, Maybe Bool
isKnown)
case Maybe Bool
misCompatible of
Just True -> [FilePath]
-> Path Abs File
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall (m :: * -> *) b b a.
Monad m =>
b -> Path b File -> m (FilePath, b, [a], [Mount])
cmdArgs [FilePath]
args Path Abs File
exePath
Just False -> [FilePath]
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall env b a.
HasConfig env =>
b -> RIO env (FilePath, b, [a], [Mount])
exeDownload [FilePath]
args
Nothing -> do
Either ExitCodeException ((), ())
e <-
RIO env ((), ()) -> RIO env (Either ExitCodeException ((), ()))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (RIO env ((), ()) -> RIO env (Either ExitCodeException ((), ())))
-> RIO env ((), ()) -> RIO env (Either ExitCodeException ((), ()))
forall a b. (a -> b) -> a -> b
$
FilePath
-> [FilePath]
-> ConduitM ByteString Void (RIO env) ()
-> ConduitM ByteString Void (RIO env) ()
-> RIO env ((), ())
forall e o env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath
-> [FilePath]
-> ConduitM ByteString Void (RIO env) e
-> ConduitM ByteString Void (RIO env) o
-> RIO env (e, o)
sinkProcessStderrStdout
"docker"
[ "run"
, "-v"
, Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
exePath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/tmp/stack"
, Text -> FilePath
T.unpack (Inspect -> Text
iiId Inspect
imageInfo)
, "/tmp/stack"
, "--version"]
ConduitM ByteString Void (RIO env) ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
sinkNull
ConduitM ByteString Void (RIO env) ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
sinkNull
let compatible :: Bool
compatible =
case Either ExitCodeException ((), ())
e of
Left ExitCodeException{} -> Bool
False
Right _ -> Bool
True
Text -> Path Abs File -> UTCTime -> Bool -> RIO env ()
forall env.
(HasConfig env, HasLogFunc env) =>
Text -> Path Abs File -> UTCTime -> Bool -> RIO env ()
saveDockerImageExeCache
(Inspect -> Text
iiId Inspect
imageInfo)
Path Abs File
exePath
UTCTime
exeTimestamp
Bool
compatible
if Bool
compatible
then [FilePath]
-> Path Abs File
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall (m :: * -> *) b b a.
Monad m =>
b -> Path b File -> m (FilePath, b, [a], [Mount])
cmdArgs [FilePath]
args Path Abs File
exePath
else [FilePath]
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall env b a.
HasConfig env =>
b -> RIO env (FilePath, b, [a], [Mount])
exeDownload [FilePath]
args
Nothing -> [FilePath]
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall env b a.
HasConfig env =>
b -> RIO env (FilePath, b, [a], [Mount])
exeDownload [FilePath]
args
where
exeDownload :: b -> RIO env (FilePath, b, [a], [Mount])
exeDownload args :: b
args = do
Path Abs File
exePath <- Platform -> RIO env (Path Abs File)
forall env. HasConfig env => Platform -> RIO env (Path Abs File)
ensureDockerStackExe Platform
dockerContainerPlatform
b -> Path Abs File -> RIO env (FilePath, b, [a], [Mount])
forall (m :: * -> *) b b a.
Monad m =>
b -> Path b File -> m (FilePath, b, [a], [Mount])
cmdArgs b
args Path Abs File
exePath
cmdArgs :: b -> Path b File -> m (FilePath, b, [a], [Mount])
cmdArgs args :: b
args exePath :: Path b File
exePath = do
#if MIN_VERSION_path(0, 7, 0)
let exeBase :: Path b File
exeBase =
case Path b File -> Either SomeException (Path b File, FilePath)
forall (m :: * -> *) b.
MonadThrow m =>
Path b File -> m (Path b File, FilePath)
splitExtension Path b File
exePath of
Left _ -> Path b File
exePath
Right (x :: Path b File
x, _) -> Path b File
x
#else
exeBase <- exePath -<.> ""
#endif
let mountPath :: FilePath
mountPath = FilePath
hostBinDir FilePath -> FilePath -> FilePath
FP.</> Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path b File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path b File
exeBase)
(FilePath, b, [a], [Mount]) -> m (FilePath, b, [a], [Mount])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
mountPath, b
args, [], [FilePath -> FilePath -> Mount
Mount (Path b File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path b File
exePath) FilePath
mountPath])
preventInContainer :: MonadIO m => m () -> m ()
preventInContainer :: m () -> m ()
preventInContainer inner :: m ()
inner =
do Bool
inContainer <- m Bool
forall (m :: * -> *). MonadIO m => m Bool
getInContainer
if Bool
inContainer
then StackDockerException -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO StackDockerException
OnlyOnHostException
else m ()
inner
runContainerAndExit :: HasConfig env => RIO env void
runContainerAndExit :: RIO env void
runContainerAndExit = do
Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
let docker :: DockerOpts
docker = Config -> DockerOpts
configDocker Config
config
DockerOpts -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env) =>
DockerOpts -> RIO env ()
checkDockerVersion DockerOpts
docker
(env :: [(FilePath, FilePath)]
env,isStdinTerminal :: Bool
isStdinTerminal,isStderrTerminal :: Bool
isStderrTerminal,homeDir :: Path Abs Dir
homeDir) <- IO ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir)
-> RIO env ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir)
-> RIO env ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
-> IO ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir)
-> RIO env ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir)
forall a b. (a -> b) -> a -> b
$
(,,,)
([(FilePath, FilePath)]
-> Bool
-> Bool
-> Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
-> IO [(FilePath, FilePath)]
-> IO
(Bool
-> Bool
-> Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(FilePath, FilePath)]
getEnvironment
IO
(Bool
-> Bool
-> Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
-> IO Bool
-> IO
(Bool
-> Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> IO Bool
forall (m :: * -> *). MonadIO m => Handle -> m Bool
hIsTerminalDeviceOrMinTTY Handle
stdin
IO
(Bool
-> Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
-> IO Bool
-> IO
(Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Handle -> IO Bool
forall (m :: * -> *). MonadIO m => Handle -> m Bool
hIsTerminalDeviceOrMinTTY Handle
stderr
IO
(Path Abs Dir
-> ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir))
-> IO (Path Abs Dir)
-> IO ([(FilePath, FilePath)], Bool, Bool, Path Abs Dir)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
Bool
isStdoutTerminal <- Getting Bool env Bool -> RIO env Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool env Bool
forall env. HasRunner env => Lens' env Bool
terminalL
let dockerHost :: Maybe FilePath
dockerHost = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "DOCKER_HOST" [(FilePath, FilePath)]
env
dockerCertPath :: Maybe FilePath
dockerCertPath = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "DOCKER_CERT_PATH" [(FilePath, FilePath)]
env
bamboo :: Maybe FilePath
bamboo = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "bamboo_buildKey" [(FilePath, FilePath)]
env
jenkins :: Maybe FilePath
jenkins = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "JENKINS_HOME" [(FilePath, FilePath)]
env
msshAuthSock :: Maybe FilePath
msshAuthSock = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "SSH_AUTH_SOCK" [(FilePath, FilePath)]
env
muserEnv :: Maybe FilePath
muserEnv = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "USER" [(FilePath, FilePath)]
env
isRemoteDocker :: Bool
isRemoteDocker = Bool -> (FilePath -> Bool) -> Maybe FilePath -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "tcp://") Maybe FilePath
dockerHost
Maybe FilePath
mstackYaml <- Maybe FilePath
-> (FilePath -> RIO env FilePath) -> RIO env (Maybe FilePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "STACK_YAML" [(FilePath, FilePath)]
env) FilePath -> RIO env FilePath
forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
RIO.Directory.makeAbsolute
FilePath
image <- (SomeException -> RIO env FilePath)
-> (FilePath -> RIO env FilePath)
-> Either SomeException FilePath
-> RIO env FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> RIO env FilePath
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO FilePath -> RIO env FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DockerOpts -> Either SomeException FilePath
dockerImage DockerOpts
docker)
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isRemoteDocker Bool -> Bool -> Bool
&&
Bool -> (FilePath -> Bool) -> Maybe FilePath -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf "boot2docker") Maybe FilePath
dockerCertPath)
(Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn "Warning: Using boot2docker is NOT supported, and not likely to perform well.")
Maybe Inspect
maybeImageInfo <- FilePath -> RIO env (Maybe Inspect)
forall env.
(HasProcessContext env, HasLogFunc env) =>
FilePath -> RIO env (Maybe Inspect)
inspect FilePath
image
imageInfo :: Inspect
imageInfo@Inspect{..} <- case Maybe Inspect
maybeImageInfo of
Just ii :: Inspect
ii -> Inspect -> RIO env Inspect
forall (m :: * -> *) a. Monad m => a -> m a
return Inspect
ii
Nothing
| DockerOpts -> Bool
dockerAutoPull DockerOpts
docker ->
do DockerOpts -> FilePath -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env) =>
DockerOpts -> FilePath -> RIO env ()
pullImage DockerOpts
docker FilePath
image
Maybe Inspect
mii2 <- FilePath -> RIO env (Maybe Inspect)
forall env.
(HasProcessContext env, HasLogFunc env) =>
FilePath -> RIO env (Maybe Inspect)
inspect FilePath
image
case Maybe Inspect
mii2 of
Just ii2 :: Inspect
ii2 -> Inspect -> RIO env Inspect
forall (m :: * -> *) a. Monad m => a -> m a
return Inspect
ii2
Nothing -> StackDockerException -> RIO env Inspect
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> StackDockerException
InspectFailedException FilePath
image)
| Bool
otherwise -> StackDockerException -> RIO env Inspect
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> StackDockerException
NotPulledException FilePath
image)
Path Abs Dir
projectRoot <- RIO env (Path Abs Dir)
forall env. HasConfig env => RIO env (Path Abs Dir)
getProjectRoot
Path Abs Dir
sandboxDir <- Path Abs Dir -> RIO env (Path Abs Dir)
forall env (m :: * -> *).
(MonadReader env m, HasConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
projectDockerSandboxDir Path Abs Dir
projectRoot
let ImageConfig {..} = ImageConfig
iiConfig
imageEnvVars :: [(FilePath, FilePath)]
imageEnvVars = (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=')) [FilePath]
icEnv
platformVariant :: FilePath
platformVariant = Digest MD5 -> FilePath
forall a. Show a => a -> FilePath
show (Digest MD5 -> FilePath) -> Digest MD5 -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Digest MD5
hashRepoName FilePath
image
stackRoot :: Path Abs Dir
stackRoot = Getting (Path Abs Dir) Config (Path Abs Dir)
-> Config -> Path Abs Dir
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) Config (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL Config
config
sandboxHomeDir :: Path Abs Dir
sandboxHomeDir = Path Abs Dir
sandboxDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
homeDirName
isTerm :: Bool
isTerm = Bool -> Bool
not (DockerOpts -> Bool
dockerDetach DockerOpts
docker) Bool -> Bool -> Bool
&&
Bool
isStdinTerminal Bool -> Bool -> Bool
&&
Bool
isStdoutTerminal Bool -> Bool -> Bool
&&
Bool
isStderrTerminal
keepStdinOpen :: Bool
keepStdinOpen = Bool -> Bool
not (DockerOpts -> Bool
dockerDetach DockerOpts
docker) Bool -> Bool -> Bool
&&
(Bool
isTerm Bool -> Bool -> Bool
|| (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
bamboo Bool -> Bool -> Bool
&& Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
jenkins))
let mpath :: Maybe Text
mpath = FilePath -> Text
T.pack (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a. Eq a => a -> [(a, FilePath)] -> Maybe FilePath
lookupImageEnv "PATH" [(FilePath, FilePath)]
imageEnvVars
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
mpath) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn "The Docker image does not set the PATH env var"
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn "This will likely fail, see https://github.com/commercialhaskell/stack/issues/2742"
Text
newPathEnv <- (ProcessException -> RIO env Text)
-> (Text -> RIO env Text)
-> Either ProcessException Text
-> RIO env Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ProcessException -> RIO env Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Text -> RIO env Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ProcessException Text -> RIO env Text)
-> Either ProcessException Text -> RIO env Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe Text -> Either ProcessException Text
augmentPath
[ FilePath
hostBinDir
, Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir
sandboxHomeDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirDotLocal Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBin)]
Maybe Text
mpath
(cmnd :: FilePath
cmnd,args :: [FilePath]
args,envVars :: [(FilePath, FilePath)]
envVars,extraMount :: [Mount]
extraMount) <- DockerOpts
-> Inspect
-> Bool
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
forall env.
HasConfig env =>
DockerOpts
-> Inspect
-> Bool
-> RIO env (FilePath, [FilePath], [(FilePath, FilePath)], [Mount])
getCmdArgs DockerOpts
docker Inspect
imageInfo Bool
isRemoteDocker
Path Abs Dir
pwd <- RIO env (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ (Path Abs Dir -> IO ()) -> [Path Abs Dir] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir [Path Abs Dir
sandboxHomeDir, Path Abs Dir
stackRoot]
let sshDir :: Path Abs Dir
sshDir = Path Abs Dir
homeDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
sshRelDir
Bool
sshDirExists <- Path Abs Dir -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
sshDir
Bool
sshSandboxDirExists <-
IO Bool -> RIO env Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(FilePath -> IO Bool
Files.fileExist
(Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep (Path Abs Dir
sandboxHomeDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
sshRelDir)))
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
sshDirExists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sshSandboxDirExists)
(IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(FilePath -> FilePath -> IO ()
Files.createSymbolicLink
(Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
sshDir)
(Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep (Path Abs Dir
sandboxHomeDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
sshRelDir))))
let mountSuffix :: FilePath
mountSuffix = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (DockerOpts -> Maybe FilePath
dockerMountMode DockerOpts
docker)
FilePath
containerID <- FilePath -> RIO env FilePath -> RIO env FilePath
forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
FilePath -> m a -> m a
withWorkingDir (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
projectRoot) (RIO env FilePath -> RIO env FilePath)
-> RIO env FilePath -> RIO env FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
trim (FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
decodeUtf8 (ByteString -> FilePath) -> RIO env ByteString -> RIO env FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> RIO env ByteString
forall env.
(HasProcessContext env, HasLogFunc env) =>
[FilePath] -> RIO env ByteString
readDockerProcess
([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[["create"
,"--net=host"
,"-e",FilePath
inContainerEnvVar FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "=1"
,"-e",FilePath
stackRootEnvVar FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
stackRoot
,"-e",FilePath
platformVariantEnvVar FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "=dk" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
platformVariant
,"-e","HOME=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
sandboxHomeDir
,"-e","PATH=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
newPathEnv
,"-e","PWD=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
pwd
,"-v",Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
homeDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
homeDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mountSuffix
,"-v",Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
stackRoot FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
stackRoot FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mountSuffix
,"-v",Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
projectRoot FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
projectRoot FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mountSuffix
,"-v",Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
sandboxHomeDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
sandboxHomeDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mountSuffix
,"-w",Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
pwd]
,case Maybe FilePath
muserEnv of
Nothing -> []
Just userEnv :: FilePath
userEnv -> ["-e","USER=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
userEnv]
,case Maybe FilePath
msshAuthSock of
Nothing -> []
Just sshAuthSock :: FilePath
sshAuthSock ->
["-e","SSH_AUTH_SOCK=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sshAuthSock
,"-v",FilePath
sshAuthSock FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sshAuthSock]
,case Maybe FilePath
mstackYaml of
Nothing -> []
Just stackYaml :: FilePath
stackYaml ->
["-e","STACK_YAML=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
stackYaml
,"-v",FilePath
stackYamlFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
stackYaml FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":ro"]
,["--entrypoint=/usr/bin/env"
| Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a. Eq a => a -> [(a, FilePath)] -> Maybe FilePath
lookupImageEnv FilePath
oldSandboxIdEnvVar [(FilePath, FilePath)]
imageEnvVars) Bool -> Bool -> Bool
&&
([FilePath]
icEntrypoint [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== ["/usr/local/sbin/docker-entrypoint"] Bool -> Bool -> Bool
||
[FilePath]
icEntrypoint [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== ["/root/entrypoint.sh"])]
,((FilePath, FilePath) -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(k :: FilePath
k,v :: FilePath
v) -> ["-e", FilePath
k FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
v]) [(FilePath, FilePath)]
envVars
,(Mount -> [FilePath]) -> [Mount] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath -> Mount -> [FilePath]
mountArg FilePath
mountSuffix) ([Mount]
extraMount [Mount] -> [Mount] -> [Mount]
forall a. [a] -> [a] -> [a]
++ DockerOpts -> [Mount]
dockerMount DockerOpts
docker)
,(FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\nv :: FilePath
nv -> ["-e", FilePath
nv]) (DockerOpts -> [FilePath]
dockerEnv DockerOpts
docker)
,case DockerOpts -> Maybe FilePath
dockerContainerName DockerOpts
docker of
Just name :: FilePath
name -> ["--name=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name]
Nothing -> []
,["-t" | Bool
isTerm]
,["-i" | Bool
keepStdinOpen]
,DockerOpts -> [FilePath]
dockerRunArgs DockerOpts
docker
,[FilePath
image]
,[FilePath
cmnd]
,[FilePath]
args])
#ifndef WINDOWS
RIO env () -> IO ()
run <- RIO env (RIO env () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
[(CInt, Handler)]
oldHandlers <- [CInt]
-> (CInt -> RIO env (CInt, Handler)) -> RIO env [(CInt, Handler)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CInt
sigINT,CInt
sigABRT,CInt
sigHUP,CInt
sigPIPE,CInt
sigTERM,CInt
sigUSR1,CInt
sigUSR2] ((CInt -> RIO env (CInt, Handler)) -> RIO env [(CInt, Handler)])
-> (CInt -> RIO env (CInt, Handler)) -> RIO env [(CInt, Handler)]
forall a b. (a -> b) -> a -> b
$ \sig :: CInt
sig -> do
let sigHandler :: IO ()
sigHandler = RIO env () -> IO ()
run (RIO env () -> IO ()) -> RIO env () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "docker" ["kill","--signal=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
sig,FilePath
containerID]
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
sig CInt -> [CInt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CInt
sigTERM,CInt
sigABRT]) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
Int -> RIO env ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay 30000000
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "docker" ["kill",FilePath
containerID]
Handler
oldHandler <- IO Handler -> RIO env Handler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handler -> RIO env Handler) -> IO Handler -> RIO env Handler
forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sig (IO () -> Handler
Catch IO ()
sigHandler) Maybe SignalSet
forall a. Maybe a
Nothing
(CInt, Handler) -> RIO env (CInt, Handler)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
sig, Handler
oldHandler)
#endif
let args' :: [FilePath]
args' = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [["start"]
,["-a" | Bool -> Bool
not (DockerOpts -> Bool
dockerDetach DockerOpts
docker)]
,["-i" | Bool
keepStdinOpen]
,[FilePath
containerID]]
Either ExitCodeException ()
e <- RIO env () -> RIO env (Either ExitCodeException ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (FilePath
-> [FilePath]
-> (ProcessConfig () () () -> RIO env ())
-> RIO env ()
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc "docker" [FilePath]
args' ((ProcessConfig () () () -> RIO env ()) -> RIO env ())
-> (ProcessConfig () () () -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> RIO env ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (ProcessConfig () () () -> RIO env ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDelegateCtlc Bool
False)
RIO env (Either ExitCodeException ())
-> RIO env () -> RIO env (Either ExitCodeException ())
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally`
(do Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DockerOpts -> Bool
dockerPersist DockerOpts
docker Bool -> Bool -> Bool
|| DockerOpts -> Bool
dockerDetach DockerOpts
docker) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "docker" ["rm","-f",FilePath
containerID]
RIO env () -> (ExitCodeException -> RIO env ()) -> RIO env ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(ExitCodeException
_::ExitCodeException) -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
#ifndef WINDOWS
[(CInt, Handler)]
-> ((CInt, Handler) -> RIO env Handler) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(CInt, Handler)]
oldHandlers (((CInt, Handler) -> RIO env Handler) -> RIO env ())
-> ((CInt, Handler) -> RIO env Handler) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \(sig :: CInt
sig,oldHandler :: Handler
oldHandler) ->
IO Handler -> RIO env Handler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handler -> RIO env Handler) -> IO Handler -> RIO env Handler
forall a b. (a -> b) -> a -> b
$ CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sig Handler
oldHandler Maybe SignalSet
forall a. Maybe a
Nothing
#endif
)
case Either ExitCodeException ()
e of
Left ExitCodeException{ExitCode
eceExitCode :: ExitCodeException -> ExitCode
eceExitCode :: ExitCode
eceExitCode} -> ExitCode -> RIO env void
forall (m :: * -> *) a. MonadIO m => ExitCode -> m a
exitWith ExitCode
eceExitCode
Right () -> RIO env void
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess
where
hashRepoName :: String -> Hash.Digest Hash.MD5
hashRepoName :: FilePath -> Digest MD5
hashRepoName = ByteString -> Digest MD5
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash (ByteString -> Digest MD5)
-> (FilePath -> ByteString) -> FilePath -> Digest MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BS.pack (FilePath -> ByteString)
-> (FilePath -> FilePath) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ':' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '@')
lookupImageEnv :: a -> [(a, FilePath)] -> Maybe FilePath
lookupImageEnv name :: a
name vars :: [(a, FilePath)]
vars =
case a -> [(a, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
name [(a, FilePath)]
vars of
Just ('=':val :: FilePath
val) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
val
_ -> Maybe FilePath
forall a. Maybe a
Nothing
mountArg :: FilePath -> Mount -> [FilePath]
mountArg mountSuffix :: FilePath
mountSuffix (Mount host :: FilePath
host container :: FilePath
container) =
["-v",FilePath
host FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
container FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mountSuffix]
sshRelDir :: Path Rel Dir
sshRelDir = Path Rel Dir
relDirDotSsh
inspect :: (HasProcessContext env, HasLogFunc env)
=> String -> RIO env (Maybe Inspect)
inspect :: FilePath -> RIO env (Maybe Inspect)
inspect image :: FilePath
image =
do Map Text Inspect
results <- [FilePath] -> RIO env (Map Text Inspect)
forall env.
(HasProcessContext env, HasLogFunc env) =>
[FilePath] -> RIO env (Map Text Inspect)
inspects [FilePath
image]
case Map Text Inspect -> [(Text, Inspect)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Inspect
results of
[] -> Maybe Inspect -> RIO env (Maybe Inspect)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Inspect
forall a. Maybe a
Nothing
[(_,i :: Inspect
i)] -> Maybe Inspect -> RIO env (Maybe Inspect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Inspect -> Maybe Inspect
forall a. a -> Maybe a
Just Inspect
i)
_ -> StackDockerException -> RIO env (Maybe Inspect)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FilePath -> StackDockerException
InvalidInspectOutputException "expect a single result")
inspects :: (HasProcessContext env, HasLogFunc env)
=> [String] -> RIO env (Map Text Inspect)
inspects :: [FilePath] -> RIO env (Map Text Inspect)
inspects [] = Map Text Inspect -> RIO env (Map Text Inspect)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Inspect
forall k a. Map k a
Map.empty
inspects images :: [FilePath]
images =
do Either ExitCodeException ByteString
maybeInspectOut <-
RIO env ByteString -> RIO env (Either ExitCodeException ByteString)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> RIO env (ByteString, ByteString) -> RIO env ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> [FilePath]
-> (ProcessConfig () () () -> RIO env (ByteString, ByteString))
-> RIO env (ByteString, ByteString)
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc "docker" ("inspect" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
images) ProcessConfig () () () -> RIO env (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_)
case Either ExitCodeException ByteString
maybeInspectOut of
Right inspectOut :: ByteString
inspectOut ->
case ByteString -> Either FilePath [Inspect]
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode (FilePath -> ByteString
LBS.pack ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAscii (ByteString -> FilePath
decodeUtf8 ByteString
inspectOut))) of
Left msg :: FilePath
msg -> StackDockerException -> RIO env (Map Text Inspect)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FilePath -> StackDockerException
InvalidInspectOutputException FilePath
msg)
Right results :: [Inspect]
results -> Map Text Inspect -> RIO env (Map Text Inspect)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Inspect)] -> Map Text Inspect
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Inspect -> (Text, Inspect)) -> [Inspect] -> [(Text, Inspect)]
forall a b. (a -> b) -> [a] -> [b]
map (\r :: Inspect
r -> (Inspect -> Text
iiId Inspect
r,Inspect
r)) [Inspect]
results))
Left ece :: ExitCodeException
ece
| (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
`LBS.isPrefixOf` ExitCodeException -> ByteString
eceStderr ExitCodeException
ece) [ByteString]
missingImagePrefixes -> Map Text Inspect -> RIO env (Map Text Inspect)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Inspect
forall k a. Map k a
Map.empty
Left e :: ExitCodeException
e -> ExitCodeException -> RIO env (Map Text Inspect)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ExitCodeException
e
where missingImagePrefixes :: [ByteString]
missingImagePrefixes = ["Error: No such image", "Error: No such object:"]
pull :: HasConfig env => RIO env ()
pull :: RIO env ()
pull =
do Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
let docker :: DockerOpts
docker = Config -> DockerOpts
configDocker Config
config
DockerOpts -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env) =>
DockerOpts -> RIO env ()
checkDockerVersion DockerOpts
docker
(SomeException -> RIO env ())
-> (FilePath -> RIO env ())
-> Either SomeException FilePath
-> RIO env ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (DockerOpts -> FilePath -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env) =>
DockerOpts -> FilePath -> RIO env ()
pullImage DockerOpts
docker) (DockerOpts -> Either SomeException FilePath
dockerImage DockerOpts
docker)
pullImage :: (HasProcessContext env, HasLogFunc env)
=> DockerOpts -> String -> RIO env ()
pullImage :: DockerOpts -> FilePath -> RIO env ()
pullImage docker :: DockerOpts
docker image :: FilePath
image =
do Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo ("Pulling image from registry: '" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString FilePath
image Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> "'")
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DockerOpts -> Bool
dockerRegistryLogin DockerOpts
docker)
(do Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "You may need to log in."
FilePath
-> [FilePath]
-> (ProcessConfig () () () -> RIO env ())
-> RIO env ()
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc
"docker"
([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[["login"]
,[FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\n :: FilePath
n -> ["--username=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n]) (DockerOpts -> Maybe FilePath
dockerRegistryUsername DockerOpts
docker)
,[FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\p :: FilePath
p -> ["--password=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p]) (DockerOpts -> Maybe FilePath
dockerRegistryPassword DockerOpts
docker)
,[(Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '/') FilePath
image]])
ProcessConfig () () () -> RIO env ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_)
ExitCode
ec <- FilePath
-> [FilePath]
-> (ProcessConfig () () () -> RIO env ExitCode)
-> RIO env ExitCode
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc "docker" ["pull", FilePath
image] ((ProcessConfig () () () -> RIO env ExitCode) -> RIO env ExitCode)
-> (ProcessConfig () () () -> RIO env ExitCode) -> RIO env ExitCode
forall a b. (a -> b) -> a -> b
$ \pc0 :: ProcessConfig () () ()
pc0 -> do
let pc :: ProcessConfig () () ()
pc = StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout (Handle -> StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
useHandleOpen Handle
stderr)
(ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr (Handle -> StreamSpec 'STOutput ()
forall (anyStreamType :: StreamType).
Handle -> StreamSpec anyStreamType ()
useHandleOpen Handle
stderr)
(ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
closed
ProcessConfig () () ()
pc0
ProcessConfig () () () -> RIO env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess ProcessConfig () () ()
pc
case ExitCode
ec of
ExitSuccess -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure _ -> StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FilePath -> StackDockerException
PullFailedException FilePath
image)
checkDockerVersion
:: (HasProcessContext env, HasLogFunc env)
=> DockerOpts -> RIO env ()
checkDockerVersion :: DockerOpts -> RIO env ()
checkDockerVersion docker :: DockerOpts
docker =
do Bool
dockerExists <- FilePath -> RIO env Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
FilePath -> m Bool
doesExecutableExist "docker"
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dockerExists (StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO StackDockerException
DockerNotInstalledException)
ByteString
dockerVersionOut <- [FilePath] -> RIO env ByteString
forall env.
(HasProcessContext env, HasLogFunc env) =>
[FilePath] -> RIO env ByteString
readDockerProcess ["--version"]
case FilePath -> [FilePath]
words (ByteString -> FilePath
decodeUtf8 ByteString
dockerVersionOut) of
(_:_:v :: FilePath
v:_) ->
case (Version -> Version) -> Maybe Version -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Version
mkVersion' (Maybe Version -> Maybe Version) -> Maybe Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Version
parseVersion' (FilePath -> Maybe Version) -> FilePath -> Maybe Version
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
stripVersion FilePath
v of
Just v' :: Version
v'
| Version
v' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
minimumDockerVersion ->
StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Version -> Version -> StackDockerException
DockerTooOldException Version
minimumDockerVersion Version
v')
| Version
v' Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version]
forall a. [a]
prohibitedDockerVersions ->
StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ([Version] -> Version -> StackDockerException
DockerVersionProhibitedException [Version]
forall a. [a]
prohibitedDockerVersions Version
v')
| Bool -> Bool
not (Version
v' Version -> VersionRange -> Bool
`withinRange` DockerOpts -> VersionRange
dockerRequireDockerVersion DockerOpts
docker) ->
StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (VersionRange -> Version -> StackDockerException
BadDockerVersionException (DockerOpts -> VersionRange
dockerRequireDockerVersion DockerOpts
docker) Version
v')
| Bool
otherwise ->
() -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO StackDockerException
InvalidVersionOutputException
_ -> StackDockerException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO StackDockerException
InvalidVersionOutputException
where minimumDockerVersion :: Version
minimumDockerVersion = [Int] -> Version
mkVersion [1, 6, 0]
prohibitedDockerVersions :: [a]
prohibitedDockerVersions = []
stripVersion :: FilePath -> FilePath
stripVersion v :: FilePath
v = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '-') ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) FilePath
v)
parseVersion' :: FilePath -> Maybe Version
parseVersion' = ((Version, FilePath) -> Version)
-> Maybe (Version, FilePath) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version, FilePath) -> Version
forall a b. (a, b) -> a
fst (Maybe (Version, FilePath) -> Maybe Version)
-> (FilePath -> Maybe (Version, FilePath))
-> FilePath
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Version, FilePath)] -> Maybe (Version, FilePath)
forall a. [a] -> Maybe a
listToMaybe ([(Version, FilePath)] -> Maybe (Version, FilePath))
-> (FilePath -> [(Version, FilePath)])
-> FilePath
-> Maybe (Version, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Version, FilePath)] -> [(Version, FilePath)]
forall a. [a] -> [a]
reverse ([(Version, FilePath)] -> [(Version, FilePath)])
-> (FilePath -> [(Version, FilePath)])
-> FilePath
-> [(Version, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Version -> FilePath -> [(Version, FilePath)]
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
Data.Version.parseVersion
reset :: HasConfig env => Bool -> RIO env ()
reset :: Bool -> RIO env ()
reset keepHome :: Bool
keepHome = do
Path Abs Dir
projectRoot <- RIO env (Path Abs Dir)
forall env. HasConfig env => RIO env (Path Abs Dir)
getProjectRoot
Path Abs Dir
dockerSandboxDir <- Path Abs Dir -> RIO env (Path Abs Dir)
forall env (m :: * -> *).
(MonadReader env m, HasConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
projectDockerSandboxDir Path Abs Dir
projectRoot
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs Dir -> [Path Rel Dir] -> [Path Rel File] -> IO ()
removeDirectoryContents
Path Abs Dir
dockerSandboxDir
[Path Rel Dir
homeDirName | Bool
keepHome]
[])
entrypoint :: (HasProcessContext env, HasLogFunc env)
=> Config -> DockerEntrypoint -> RIO env ()
entrypoint :: Config -> DockerEntrypoint -> RIO env ()
entrypoint config :: Config
config@Config{..} DockerEntrypoint{..} =
MVar Bool -> (Bool -> RIO env Bool) -> RIO env ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar Bool
entrypointMVar ((Bool -> RIO env Bool) -> RIO env ())
-> (Bool -> RIO env Bool) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \alreadyRan :: Bool
alreadyRan -> do
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
alreadyRan (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
ProcessContext
envOverride <- Getting ProcessContext env ProcessContext -> RIO env ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
Path Abs Dir
homeDir <- IO (Path Abs Dir) -> RIO env (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs Dir) -> RIO env (Path Abs Dir))
-> IO (Path Abs Dir) -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir (FilePath -> IO (Path Abs Dir)) -> IO FilePath -> IO (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FilePath
getEnv "HOME"
Either () UserEntry
estackUserEntry0 <- IO (Either () UserEntry) -> RIO env (Either () UserEntry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either () UserEntry) -> RIO env (Either () UserEntry))
-> IO (Either () UserEntry) -> RIO env (Either () UserEntry)
forall a b. (a -> b) -> a -> b
$ (IOError -> Maybe ()) -> IO UserEntry -> IO (Either () UserEntry)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (IO UserEntry -> IO (Either () UserEntry))
-> IO UserEntry -> IO (Either () UserEntry)
forall a b. (a -> b) -> a -> b
$
FilePath -> IO UserEntry
User.getUserEntryForName FilePath
stackUserName
case Maybe DockerUser
deUser of
Nothing -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (DockerUser 0 _ _ _) -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just du :: DockerUser
du -> ProcessContext -> RIO env () -> RIO env ()
forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
envOverride (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Either () UserEntry -> Path Abs Dir -> DockerUser -> RIO env ()
forall env a b loc.
(HasProcessContext env, HasLogFunc env) =>
Either a b -> Path loc Dir -> DockerUser -> RIO env ()
updateOrCreateStackUser Either () UserEntry
estackUserEntry0 Path Abs Dir
homeDir DockerUser
du
case Either () UserEntry
estackUserEntry0 of
Left _ -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right ue :: UserEntry
ue -> do
Path Abs Dir
origStackHomeDir <- IO (Path Abs Dir) -> RIO env (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs Dir) -> RIO env (Path Abs Dir))
-> IO (Path Abs Dir) -> RIO env (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir (UserEntry -> FilePath
User.homeDirectory UserEntry
ue)
let origStackRoot :: Path Abs Dir
origStackRoot = Path Abs Dir
origStackHomeDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirDotStackProgName
Bool
buildPlanDirExists <- Path Abs Dir -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist (Path Abs Dir -> Path Abs Dir
buildPlanDir Path Abs Dir
origStackRoot)
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
buildPlanDirExists (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
(_, buildPlans :: [Path Abs File]
buildPlans) <- Path Abs Dir -> RIO env ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir (Path Abs Dir -> Path Abs Dir
buildPlanDir Path Abs Dir
origStackRoot)
[Path Abs File] -> (Path Abs File -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Abs File]
buildPlans ((Path Abs File -> RIO env ()) -> RIO env ())
-> (Path Abs File -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \srcBuildPlan :: Path Abs File
srcBuildPlan -> do
let destBuildPlan :: Path Abs File
destBuildPlan = Path Abs Dir -> Path Abs Dir
buildPlanDir (Getting (Path Abs Dir) Config (Path Abs Dir)
-> Config -> Path Abs Dir
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) Config (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL Config
config) Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
srcBuildPlan
Bool
exists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
destBuildPlan
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
Path Abs Dir -> RIO env ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
destBuildPlan)
Path Abs File -> Path Abs File -> RIO env ()
forall (m :: * -> *) b0 b1.
MonadIO m =>
Path b0 File -> Path b1 File -> m ()
copyFile Path Abs File
srcBuildPlan Path Abs File
destBuildPlan
Bool -> RIO env Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
where
updateOrCreateStackUser :: Either a b -> Path loc Dir -> DockerUser -> RIO env ()
updateOrCreateStackUser estackUserEntry :: Either a b
estackUserEntry homeDir :: Path loc Dir
homeDir DockerUser{..} = do
case Either a b
estackUserEntry of
Left _ -> do
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "groupadd"
["-o"
,"--gid",GroupID -> FilePath
forall a. Show a => a -> FilePath
show GroupID
duGid
,FilePath
stackUserName]
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "useradd"
["-oN"
,"--uid",UserID -> FilePath
forall a. Show a => a -> FilePath
show UserID
duUid
,"--gid",GroupID -> FilePath
forall a. Show a => a -> FilePath
show GroupID
duGid
,"--home",Path loc Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path loc Dir
homeDir
,FilePath
stackUserName]
Right _ -> do
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "usermod"
["-o"
,"--uid",UserID -> FilePath
forall a. Show a => a -> FilePath
show UserID
duUid
,"--home",Path loc Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path loc Dir
homeDir
,FilePath
stackUserName]
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "groupmod"
["-o"
,"--gid",GroupID -> FilePath
forall a. Show a => a -> FilePath
show GroupID
duGid
,FilePath
stackUserName]
[GroupID] -> (GroupID -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupID]
duGroups ((GroupID -> RIO env ()) -> RIO env ())
-> (GroupID -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \gid :: GroupID
gid -> do
FilePath -> [FilePath] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
FilePath -> [FilePath] -> RIO env ()
readProcessNull "groupadd"
["-o"
,"--gid",GroupID -> FilePath
forall a. Show a => a -> FilePath
show GroupID
gid
,"group" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ GroupID -> FilePath
forall a. Show a => a -> FilePath
show GroupID
gid]
IO () -> RIO env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
GroupID -> IO ()
User.setGroupID GroupID
duGid
#ifndef WINDOWS
[GroupID] -> IO ()
PosixUser.setGroups [GroupID]
duGroups
#endif
UserID -> IO ()
User.setUserID UserID
duUid
FileMode
_ <- FileMode -> IO FileMode
Files.setFileCreationMask FileMode
duUmask
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
stackUserName :: FilePath
stackUserName = "stack"::String
entrypointMVar :: MVar Bool
{-# NOINLINE entrypointMVar #-}
entrypointMVar :: MVar Bool
entrypointMVar = IO (MVar Bool) -> MVar Bool
forall a. IO a -> a
unsafePerformIO (Bool -> IO (MVar Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Bool
False)
removeDirectoryContents :: Path Abs Dir
-> [Path Rel Dir]
-> [Path Rel File]
-> IO ()
removeDirectoryContents :: Path Abs Dir -> [Path Rel Dir] -> [Path Rel File] -> IO ()
removeDirectoryContents path :: Path Abs Dir
path excludeDirs :: [Path Rel Dir]
excludeDirs excludeFiles :: [Path Rel File]
excludeFiles =
do Bool
isRootDir <- Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
path
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isRootDir
(do (lsd :: [Path Abs Dir]
lsd,lsf :: [Path Abs File]
lsf) <- Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
path
[Path Abs Dir] -> (Path Abs Dir -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Abs Dir]
lsd
(\d :: Path Abs Dir
d -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
d Path Rel Dir -> [Path Rel Dir] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path Rel Dir]
excludeDirs)
(Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur Path Abs Dir
d))
[Path Abs File] -> (Path Abs File -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Abs File]
lsf
(\f :: Path Abs File
f -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Abs File
f Path Rel File -> [Path Rel File] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Path Rel File]
excludeFiles)
(Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile Path Abs File
f)))
readDockerProcess
:: (HasProcessContext env, HasLogFunc env)
=> [String] -> RIO env BS.ByteString
readDockerProcess :: [FilePath] -> RIO env ByteString
readDockerProcess args :: [FilePath]
args = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> RIO env ByteString -> RIO env ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> [FilePath]
-> (ProcessConfig () () () -> RIO env ByteString)
-> RIO env ByteString
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc "docker" [FilePath]
args ProcessConfig () () () -> RIO env ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_
homeDirName :: Path Rel Dir
homeDirName :: Path Rel Dir
homeDirName = Path Rel Dir
relDirUnderHome
hostBinDir :: FilePath
hostBinDir :: FilePath
hostBinDir = "/opt/host/bin"
decodeUtf8 :: BS.ByteString -> String
decodeUtf8 :: ByteString -> FilePath
decodeUtf8 bs :: ByteString
bs = Text -> FilePath
T.unpack (ByteString -> Text
T.decodeUtf8 ByteString
bs)
getProjectRoot :: HasConfig env => RIO env (Path Abs Dir)
getProjectRoot :: RIO env (Path Abs Dir)
getProjectRoot = do
Maybe (Path Abs Dir)
mroot <- Getting (Maybe (Path Abs Dir)) env (Maybe (Path Abs Dir))
-> RIO env (Maybe (Path Abs Dir))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe (Path Abs Dir)) env (Maybe (Path Abs Dir))
-> RIO env (Maybe (Path Abs Dir)))
-> Getting (Maybe (Path Abs Dir)) env (Maybe (Path Abs Dir))
-> RIO env (Maybe (Path Abs Dir))
forall a b. (a -> b) -> a -> b
$ (Config -> Const (Maybe (Path Abs Dir)) Config)
-> env -> Const (Maybe (Path Abs Dir)) env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const (Maybe (Path Abs Dir)) Config)
-> env -> Const (Maybe (Path Abs Dir)) env)
-> ((Maybe (Path Abs Dir)
-> Const (Maybe (Path Abs Dir)) (Maybe (Path Abs Dir)))
-> Config -> Const (Maybe (Path Abs Dir)) Config)
-> Getting (Maybe (Path Abs Dir)) env (Maybe (Path Abs Dir))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Maybe (Path Abs Dir))
-> SimpleGetter Config (Maybe (Path Abs Dir))
forall s a. (s -> a) -> SimpleGetter s a
to Config -> Maybe (Path Abs Dir)
configProjectRoot
RIO env (Path Abs Dir)
-> (Path Abs Dir -> RIO env (Path Abs Dir))
-> Maybe (Path Abs Dir)
-> RIO env (Path Abs Dir)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StackDockerException -> RIO env (Path Abs Dir)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO StackDockerException
CannotDetermineProjectRootException) Path Abs Dir -> RIO env (Path Abs Dir)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
mroot
oldSandboxIdEnvVar :: String
oldSandboxIdEnvVar :: FilePath
oldSandboxIdEnvVar = "DOCKER_SANDBOX_ID"
data Inspect = Inspect
{Inspect -> ImageConfig
iiConfig :: ImageConfig
,Inspect -> UTCTime
iiCreated :: UTCTime
,Inspect -> Text
iiId :: Text
,Inspect -> Maybe Integer
iiVirtualSize :: Maybe Integer}
deriving (Int -> Inspect -> FilePath -> FilePath
[Inspect] -> FilePath -> FilePath
Inspect -> FilePath
(Int -> Inspect -> FilePath -> FilePath)
-> (Inspect -> FilePath)
-> ([Inspect] -> FilePath -> FilePath)
-> Show Inspect
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Inspect] -> FilePath -> FilePath
$cshowList :: [Inspect] -> FilePath -> FilePath
show :: Inspect -> FilePath
$cshow :: Inspect -> FilePath
showsPrec :: Int -> Inspect -> FilePath -> FilePath
$cshowsPrec :: Int -> Inspect -> FilePath -> FilePath
Show)
instance FromJSON Inspect where
parseJSON :: Value -> Parser Inspect
parseJSON v :: Value
v =
do Object
o <- Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
ImageConfig -> UTCTime -> Text -> Maybe Integer -> Inspect
Inspect (ImageConfig -> UTCTime -> Text -> Maybe Integer -> Inspect)
-> Parser ImageConfig
-> Parser (UTCTime -> Text -> Maybe Integer -> Inspect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ImageConfig
forall a. FromJSON a => Object -> Text -> Parser a
.: "Config"
Parser (UTCTime -> Text -> Maybe Integer -> Inspect)
-> Parser UTCTime -> Parser (Text -> Maybe Integer -> Inspect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: "Created"
Parser (Text -> Maybe Integer -> Inspect)
-> Parser Text -> Parser (Maybe Integer -> Inspect)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "Id"
Parser (Maybe Integer -> Inspect)
-> Parser (Maybe Integer) -> Parser Inspect
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "VirtualSize"
data ImageConfig = ImageConfig
{ImageConfig -> [FilePath]
icEnv :: [String]
,ImageConfig -> [FilePath]
icEntrypoint :: [String]}
deriving (Int -> ImageConfig -> FilePath -> FilePath
[ImageConfig] -> FilePath -> FilePath
ImageConfig -> FilePath
(Int -> ImageConfig -> FilePath -> FilePath)
-> (ImageConfig -> FilePath)
-> ([ImageConfig] -> FilePath -> FilePath)
-> Show ImageConfig
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ImageConfig] -> FilePath -> FilePath
$cshowList :: [ImageConfig] -> FilePath -> FilePath
show :: ImageConfig -> FilePath
$cshow :: ImageConfig -> FilePath
showsPrec :: Int -> ImageConfig -> FilePath -> FilePath
$cshowsPrec :: Int -> ImageConfig -> FilePath -> FilePath
Show)
instance FromJSON ImageConfig where
parseJSON :: Value -> Parser ImageConfig
parseJSON v :: Value
v =
do Object
o <- Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
[FilePath] -> [FilePath] -> ImageConfig
ImageConfig
([FilePath] -> [FilePath] -> ImageConfig)
-> Parser [FilePath] -> Parser ([FilePath] -> ImageConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Maybe [FilePath]) -> Maybe [FilePath])
-> Parser (Maybe (Maybe [FilePath])) -> Parser (Maybe [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe [FilePath]) -> Maybe [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Object
o Object -> Text -> Parser (Maybe (Maybe [FilePath]))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "Env") Parser (Maybe [FilePath]) -> [FilePath] -> Parser [FilePath]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
Parser ([FilePath] -> ImageConfig)
-> Parser [FilePath] -> Parser ImageConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe (Maybe [FilePath]) -> Maybe [FilePath])
-> Parser (Maybe (Maybe [FilePath])) -> Parser (Maybe [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe [FilePath]) -> Maybe [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Object
o Object -> Text -> Parser (Maybe (Maybe [FilePath]))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "Entrypoint") Parser (Maybe [FilePath]) -> [FilePath] -> Parser [FilePath]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []