{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Podenv.Build
( prepare,
BuildEnv (..),
containerBuildRuntime,
nixRuntime,
)
where
import Control.Monad qualified
import Data.Digest.Pure.SHA qualified as SHA
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Podenv.Config qualified
import Podenv.Dhall
import Podenv.Prelude
import Podenv.Runtime (ImageName (..))
import Podenv.Runtime qualified
import System.Directory (doesDirectoryExist, renameFile)
import System.Exit (ExitCode (ExitSuccess))
import System.Process.Typed qualified as P
type AppRunner = Application -> IO ()
data BuildEnv = BuildEnv
{ BuildEnv -> Text
beInfos :: Text,
BuildEnv -> AppRunner -> IO ()
beEnsure :: AppRunner -> IO (),
BuildEnv -> AppRunner -> IO ()
beUpdate :: AppRunner -> IO ()
}
defaultBuildEnv :: Text -> BuildEnv
defaultBuildEnv :: Text -> BuildEnv
defaultBuildEnv Text
beInfos = BuildEnv :: Text -> (AppRunner -> IO ()) -> (AppRunner -> IO ()) -> BuildEnv
BuildEnv {Text
AppRunner -> IO ()
forall b. b -> IO ()
beUpdate :: forall b. b -> IO ()
beEnsure :: forall b. b -> IO ()
beInfos :: Text
beUpdate :: AppRunner -> IO ()
beEnsure :: AppRunner -> IO ()
beInfos :: Text
..}
where
beEnsure :: b -> IO ()
beEnsure = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
beUpdate :: b -> IO ()
beUpdate = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
prepare :: Podenv.Runtime.RuntimeEnv -> Application -> IO (BuildEnv, Application)
prepare :: RuntimeEnv -> Application -> IO (BuildEnv, Application)
prepare RuntimeEnv
re Application
app = case Application -> Runtime
runtime Application
app of
Image Text
name -> (BuildEnv, Application) -> IO (BuildEnv, Application)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> BuildEnv
defaultBuildEnv Text
name, Application -> Application
addArgs Application
app)
Container ContainerBuild
cb -> (BuildEnv, Application) -> IO (BuildEnv, Application)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContainerBuild -> BuildEnv
prepareContainer ContainerBuild
cb, Application -> Application
addArgs Application
app)
Rootfs Text
fp -> (BuildEnv, Application) -> IO (BuildEnv, Application)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> BuildEnv
defaultBuildEnv Text
fp, Application -> Application
addArgs Application
app)
Nix Flakes
expr -> RuntimeEnv -> Application -> Flakes -> IO (BuildEnv, Application)
prepareNix RuntimeEnv
re Application
app Flakes
expr
where
addArgs :: Application -> Application
addArgs = ([Text] -> Identity [Text]) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appCommand (([Text] -> Identity [Text])
-> Application -> Identity Application)
-> ([Text] -> [Text]) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> RuntimeEnv -> [Text]
Podenv.Runtime.extraArgs RuntimeEnv
re)
containerBuildRuntime :: ContainerBuild -> Podenv.Runtime.RuntimeContext
containerBuildRuntime :: ContainerBuild -> RuntimeContext
containerBuildRuntime = ImageName -> RuntimeContext
Podenv.Runtime.Container (ImageName -> RuntimeContext)
-> (ContainerBuild -> ImageName)
-> ContainerBuild
-> RuntimeContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContainerBuild -> ImageName
mkImageName
mkImageName :: ContainerBuild -> ImageName
mkImageName :: ContainerBuild -> ImageName
mkImageName ContainerBuild
containerBuild = Text -> ImageName
ImageName (Text -> ImageName) -> Text -> ImageName
forall a b. (a -> b) -> a -> b
$ Text
"localhost/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
where
name :: Text
name = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
imageHash (ContainerBuild
containerBuild ContainerBuild
-> FoldLike
(Maybe Text)
ContainerBuild
ContainerBuild
(Maybe Text)
(Maybe Text)
-> Maybe Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
(Maybe Text)
ContainerBuild
ContainerBuild
(Maybe Text)
(Maybe Text)
forall (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> ContainerBuild -> f ContainerBuild
cbImage_name)
imageHash :: Text
imageHash = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> String
forall t. Digest t -> String
SHA.showDigest (Digest SHA256State -> String)
-> (Text -> Digest SHA256State) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
SHA.sha256 (ByteString -> Digest SHA256State)
-> (Text -> ByteString) -> Text -> Digest SHA256State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ContainerBuild
containerBuild ContainerBuild
-> FoldLike Text ContainerBuild ContainerBuild Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text ContainerBuild ContainerBuild Text Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> ContainerBuild -> f ContainerBuild
cbContainerfile
prepareContainer :: ContainerBuild -> BuildEnv
prepareContainer :: ContainerBuild -> BuildEnv
prepareContainer ContainerBuild
containerBuild = BuildEnv :: Text -> (AppRunner -> IO ()) -> (AppRunner -> IO ()) -> BuildEnv
BuildEnv {Text
AppRunner -> IO ()
forall b. b -> IO ()
beUpdate :: forall b. b -> IO ()
beEnsure :: forall b. b -> IO ()
beInfos :: Text
beUpdate :: AppRunner -> IO ()
beEnsure :: AppRunner -> IO ()
beInfos :: Text
..}
where
beInfos :: Text
beInfos = Text
"# Containerfile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
imageName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fileContent
fileContent :: Text
fileContent = ContainerBuild
containerBuild ContainerBuild
-> FoldLike Text ContainerBuild ContainerBuild Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text ContainerBuild ContainerBuild Text Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> ContainerBuild -> f ContainerBuild
cbContainerfile
ImageName Text
imageName = ContainerBuild -> ImageName
mkImageName ContainerBuild
containerBuild
fileName :: String
fileName = String
"Containerfile_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString (Text -> Text
imageNameToFP Text
imageName)
where
imageNameToFP :: Text -> Text
imageNameToFP = Text -> Text -> Text -> Text
Text.replace Text
"/" Text
"_" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
Text.replace Text
":" Text
"-"
beEnsure :: b -> IO ()
beEnsure = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
imageReady <- Text -> IO Bool
checkImageExist Text
imageName
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
imageReady (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> String -> Text -> [Text] -> IO ()
buildImage Text
imageName String
fileName Text
fileContent (ContainerBuild
containerBuild ContainerBuild
-> FoldLike [Text] ContainerBuild ContainerBuild [Text] [Text]
-> [Text]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike [Text] ContainerBuild ContainerBuild [Text] [Text]
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> ContainerBuild -> f ContainerBuild
cbImage_volumes)
beUpdate :: b -> IO ()
beUpdate = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ case ContainerBuild
containerBuild ContainerBuild
-> FoldLike
(Maybe Text)
ContainerBuild
ContainerBuild
(Maybe Text)
(Maybe Text)
-> Maybe Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
(Maybe Text)
ContainerBuild
ContainerBuild
(Maybe Text)
(Maybe Text)
forall (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> ContainerBuild -> f ContainerBuild
cbImage_update of
Maybe Text
Nothing -> Text -> IO ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"The container is missing the `image_update` attribute"
Just Text
cmd -> do
Text -> String -> Text -> [Text] -> IO ()
buildImage
Text
imageName
(String
fileName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-update")
([Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines [Text
"FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
imageName, Text
"RUN " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd])
(ContainerBuild
containerBuild ContainerBuild
-> FoldLike [Text] ContainerBuild ContainerBuild [Text] [Text]
-> [Text]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike [Text] ContainerBuild ContainerBuild [Text] [Text]
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> ContainerBuild -> f ContainerBuild
cbImage_volumes)
nixRuntime :: Podenv.Runtime.RuntimeContext
nixRuntime :: RuntimeContext
nixRuntime = String -> RuntimeContext
Podenv.Runtime.Bubblewrap String
"/"
getCertLocation :: IO (Maybe FilePath)
getCertLocation :: IO (Maybe String)
getCertLocation = MaybeT IO String -> IO (Maybe String)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO String -> IO (Maybe String))
-> MaybeT IO String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ [MaybeT IO String] -> MaybeT IO String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Control.Monad.msum ([MaybeT IO String] -> MaybeT IO String)
-> [MaybeT IO String] -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ [MaybeT IO String
checkEnv] [MaybeT IO String] -> [MaybeT IO String] -> [MaybeT IO String]
forall a. Semigroup a => a -> a -> a
<> (String -> MaybeT IO String
checkPath (String -> MaybeT IO String) -> [String] -> [MaybeT IO String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
paths)
where
checkEnv :: MaybeT IO FilePath
checkEnv :: MaybeT IO String
checkEnv = do
Maybe String
env <- IO (Maybe String) -> MaybeT IO (Maybe String)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe String) -> MaybeT IO (Maybe String))
-> IO (Maybe String) -> MaybeT IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
lookupEnv String
"NIX_SSL_CERT_FILE"
case Maybe String
env of
Just String
fp -> String -> MaybeT IO String
checkPath String
fp
Maybe String
Nothing -> MaybeT IO String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
checkPath :: FilePath -> MaybeT IO FilePath
checkPath :: String -> MaybeT IO String
checkPath String
fp = do
Bool
exist <- IO Bool -> MaybeT IO Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesPathExist String
fp
Bool -> MaybeT IO () -> MaybeT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exist MaybeT IO ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
String -> MaybeT IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fp
paths :: [String]
paths =
[ String
"/etc/pki/tls/certs/ca-bundle.crt",
String
"/etc/ssl/certs/ca-certificates.crt",
String
"/etc/ssl/ca-bundle.pem",
String
"/etc/ssl/certs/ca-bundle.crt"
]
prepareNix :: Podenv.Runtime.RuntimeEnv -> Application -> Flakes -> IO (BuildEnv, Application)
prepareNix :: RuntimeEnv -> Application -> Flakes -> IO (BuildEnv, Application)
prepareNix RuntimeEnv
re Application
app Flakes
flakes = do
Text
certs <- String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> (Maybe String -> String) -> Maybe String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Text -> String
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Can't find ca-bundle") (Maybe String -> Text) -> IO (Maybe String) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
getCertLocation
(BuildEnv, Application) -> IO (BuildEnv, Application)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( BuildEnv :: Text -> (AppRunner -> IO ()) -> (AppRunner -> IO ()) -> BuildEnv
BuildEnv
{ beInfos :: Text
beInfos = Text
"# Nix expr:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords [Text]
nixArgs,
beEnsure :: AppRunner -> IO ()
beEnsure = Text -> AppRunner -> IO ()
forall a. Text -> (Application -> IO a) -> IO ()
beEnsure Text
certs,
beUpdate :: AppRunner -> IO ()
beUpdate = IO () -> AppRunner -> IO ()
forall a b. a -> b -> a
const (IO () -> AppRunner -> IO ()) -> IO () -> AppRunner -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Nix update is not implemented"
},
Text -> Application -> Application
updateApp Text
certs Application
app
)
where
name :: Text
name = Application
app Application
-> FoldLike Text Application Application Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Application Application Text Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Application -> f Application
appName
fileName :: String
fileName = Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"nix_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
nixStore :: String
nixStore = RuntimeEnv -> String
Podenv.Runtime.volumesDir RuntimeEnv
re String -> String -> String
</> String
"nix-store"
nixCommandProfile :: String
nixCommandProfile = String
"var/nix/profiles/nix-install"
nixCommandPath :: String
nixCommandPath = String
"/nix/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nixCommandProfile String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/bin/nix"
nixFlags :: [Text]
nixFlags = [Text
"--extra-experimental-features", Text
"nix-command flakes"]
nixExtraArgs :: [Text]
nixExtraArgs = case Flakes -> Maybe Text
nixpkgs Flakes
flakes of
Just Text
pin | Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
Text.isPrefixOf Text
pin) (Flakes -> [Text]
installables Flakes
flakes)) -> [Text
"--override-input", Text
"nixpkgs", Text
pin]
Maybe Text
_ -> []
nixArgs :: [Text]
nixArgs = [Text]
nixExtraArgs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Flakes -> [Text]
installables Flakes
flakes
beEnsure :: Text -> (Application -> IO a) -> IO ()
beEnsure Text
certs Application -> IO a
runApp = do
Bool
built <- String -> Text -> IO Bool
checkIfBuilt String
fileName ([Text] -> Text
forall b a. (Show a, IsString b) => a -> b
show [Text]
nixArgs)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
built (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
ensureNixInstalled
a
_ <- Application -> IO a
runApp (Text -> Application
buildApp Text
certs)
String
cacheDir <- IO String
getCacheDir
String -> Text -> IO ()
Text.writeFile (String
cacheDir String -> String -> String
</> String
fileName) ([Text] -> Text
forall b a. (Show a, IsString b) => a -> b
show [Text]
nixArgs)
debug :: String -> IO ()
debug = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RuntimeEnv -> Bool
Podenv.Runtime.verbose RuntimeEnv
re) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. Monoid a => a -> a -> a
mappend String
"[+] "
ensureNixInstalled :: IO ()
ensureNixInstalled = do
String -> IO ()
debug (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Checking if " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nixStore String -> String -> String
</> String
nixCommandProfile String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" exists"
Bool
nixInstalled <- String -> IO Bool
doesSymlinkExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
nixStore String -> String -> String
</> String
nixCommandProfile
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
nixInstalled (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
debug (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Checking if " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nixStore String -> String -> String
</> String
"store" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" exists"
Bool
storeExist <- String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
nixStore String -> String -> String
</> String
"store"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
storeExist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"existing nix-store is invalid, try removing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
nixStore
String
podenv <- IO String
getExecutablePath
String -> IO ()
debug (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"[+] Installing nix-store with " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
podenv String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" nix.setup"
ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
P.runProcess_ (ProcessConfig () () () -> IO ())
-> ProcessConfig () () () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
P.setDelegateCtlc Bool
True (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
P.proc String
podenv [String
"nix.setup"]
buildApp :: Text -> Application
buildApp Text
certs =
Application
Podenv.Config.defaultApp
{ $sel:runtime:Application :: Runtime
runtime = Text -> Runtime
Rootfs Text
"/",
$sel:name:Application :: Text
name = Text
"build-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name,
$sel:volumes:Application :: [Text]
volumes = [String -> Text
forall a. ToText a => a -> Text
toText String
nixStore Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":/nix", Text
"nix-setup-home:~/", Text
"nix-cache:~/.cache/nix"],
$sel:environ:Application :: [Text]
environ = [Text
"NIX_SSL_CERT_FILE=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
certs, Text
"LC_ALL=C.UTF-8", Text
"TERM=xterm"],
$sel:command:Application :: [Text]
command =
[String -> Text
forall a. ToText a => a -> Text
toText String
nixCommandPath, Text
"--verbose"]
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nixFlags
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"build", Text
"--no-link"]
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nixArgs
}
Application -> (Application -> Application) -> Application
forall a b. a -> (a -> b) -> b
& ((Capabilities -> Identity Capabilities)
-> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Capabilities -> f Capabilities) -> Application -> f Application
appCapabilities ((Capabilities -> Identity Capabilities)
-> Application -> Identity Application)
-> ((Bool -> Identity Bool)
-> Capabilities -> Identity Capabilities)
-> (Bool -> Identity Bool)
-> Application
-> Identity Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> Capabilities -> Identity Capabilities
forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Capabilities -> f Capabilities
capNetwork ((Bool -> Identity Bool) -> Application -> Identity Application)
-> Bool -> Application -> Application
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
runCommand :: [Text]
runCommand =
[String -> Text
forall a. ToText a => a -> Text
toText String
nixCommandPath] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nixFlags [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> case Application
app Application
-> FoldLike [Text] Application Application [Text] [Text] -> [Text]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike [Text] Application Application [Text] [Text]
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appCommand of
[] ->
[Text
"run"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nixArgs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> case RuntimeEnv -> [Text]
Podenv.Runtime.extraArgs RuntimeEnv
re of
[] -> []
[Text]
xs -> [Text
"--"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
xs
[Text]
appArgs -> [Text
"shell"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nixArgs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"--command"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
appArgs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> RuntimeEnv -> [Text]
Podenv.Runtime.extraArgs RuntimeEnv
re
addCommand :: Application -> Application
addCommand = ([Text] -> Identity [Text]) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appCommand (([Text] -> Identity [Text])
-> Application -> Identity Application)
-> [Text] -> Application -> Application
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text]
runCommand
addVolumes :: Application -> Application
addVolumes = ([Text] -> Identity [Text]) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appVolumes (([Text] -> Identity [Text])
-> Application -> Identity Application)
-> ([Text] -> [Text]) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [Text] -> [Text] -> [Text]
forall a. Monoid a => a -> a -> a
mappend [Text
"nix-store:/nix", Text
"nix-cache:~/.cache/nix", Text
"nix-config:~/.config/nix"]
addEnvirons :: Text -> Application -> Application
addEnvirons Text
certs =
([Text] -> Identity [Text]) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appEnviron
(([Text] -> Identity [Text])
-> Application -> Identity Application)
-> ([Text] -> [Text]) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [Text] -> [Text] -> [Text]
forall a. Monoid a => a -> a -> a
mappend
[ Text
"NIX_SSL_CERT_FILE=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
certs,
Text
"TERM=xterm",
Text
"LC_ALL=C.UTF-8",
Text
"PATH=/nix/var/nix/profiles/nix-install/bin:/bin"
]
updateApp :: Text -> Application -> Application
updateApp Text
certs = Application -> Application
addCommand (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> Application
addVolumes (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Application -> Application
addEnvirons Text
certs
buildImage :: Text -> FilePath -> Text -> [Text] -> IO ()
buildImage :: Text -> String -> Text -> [Text] -> IO ()
buildImage Text
imageName String
fileName Text
containerfile [Text]
volumes = do
UserID
uid <- IO UserID
getRealUserID
String
cacheDir <- IO String
getCacheDir
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
cacheDir
let want :: String
want = String
fileName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".want"
wantfp :: String
wantfp = String
cacheDir String -> String -> String
</> String
want
String -> Text -> IO ()
Text.writeFile String
wantfp Text
containerfile
[Text]
volumesArgs <- (Text -> IO Text) -> [Text] -> IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> Text -> IO Text
mkVolumeArg String
cacheDir) [Text]
volumes
let buildArgs :: [String]
buildArgs =
[String
"build"]
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"-t", Text -> String
forall a. ToString a => a -> String
toString Text
imageName]
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--build-arg", String
"USER_UID=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UserID -> String
forall b a. (Show a, IsString b) => a -> b
show UserID
uid]
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
forall a. ToString a => a -> String
toString [Text]
volumesArgs
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"-f", String
want, String
cacheDir]
cmd :: ProcessConfig () () ()
cmd = [String] -> ProcessConfig () () ()
Podenv.Runtime.podman [String]
buildArgs
ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
P.runProcess_ ProcessConfig () () ()
cmd
String -> String -> IO ()
renameFile String
wantfp (String
cacheDir String -> String -> String
</> String
fileName)
where
mkVolumeArg :: FilePath -> Text -> IO Text
mkVolumeArg :: String -> Text -> IO Text
mkVolumeArg String
cacheDir Text
volume = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
hostPath
Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text
"-v=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
hostPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
containerPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":Z"
where
(Text
p1, Text
p2) = (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
volume
hostPath :: String
hostPath = String
cacheDir String -> String -> String
</> Text -> String
forall a. ToString a => a -> String
toString Text
p1
containerPath :: Text
containerPath = Int -> Text -> Text
Text.drop Int
1 Text
p2
checkImageExist :: Text -> IO Bool
checkImageExist :: Text -> IO Bool
checkImageExist Text
imageName = do
ExitCode
res <- ProcessConfig () () () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
P.runProcess ([String] -> ProcessConfig () () ()
Podenv.Runtime.podman [String
"image", String
"exists", Text -> String
Text.unpack Text
imageName])
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ExitCode
res ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
checkIfBuilt :: FilePath -> Text -> IO Bool
checkIfBuilt :: String -> Text -> IO Bool
checkIfBuilt String
filename Text
expected = do
String
cacheDir <- IO String
getCacheDir
Text
current <- String -> IO Text
readFileM (String
cacheDir String -> String -> String
</> String
filename)
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text
current Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected