{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | This modules contains logic to perform application runtime build
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

-- | Helper function to run a standalone app, usefull for local build
type AppRunner = Application -> IO ()

-- | A build env contains action to be performed before preparation and execution
data BuildEnv = BuildEnv
  { BuildEnv -> Text
beInfos :: Text,
    -- | Builds the runtime
    BuildEnv -> AppRunner -> IO ()
beEnsure :: AppRunner -> IO (),
    -- | Updates the runtime
    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 ()

-- | Create the build env
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
    -- The image name can be set by the container build,
    -- otherwise it default to the Containerfile hash
    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

-- | Container build env
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
    -- buildenv basic info:
    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)

-- | Nix runtime re-use the host root filesystem, prepareNix added the nix-store volume.
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
    -- Copied from profile.d/nix.sh
    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"
      ]

-- | Nix build env
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
  -- TODO: check howto re-use the host /nix
  (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

    -- The location where we expect to find the `nix` command
    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"]

    -- The nix command args
    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)

        -- save that the build succeeded
        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"]

    -- The Application to build the expression, it is executed in advance to separate build and execution
    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

-- | Build a container image
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
  -- podman build does not support regular volume, lets ensure absolute path
  [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
  -- putTextLn $ "Building " <> imageName <> " with " <> toText want <> ": " <> show cmd
  ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
P.runProcess_ ProcessConfig () () ()
cmd

  -- save that the build succeeded
  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