Implement image loading, use it instead of arion-base

arion-compose.cabal

@@ -31,6 +31,8 @@ common deps
                    , async
                    , bytestring
                    , directory
+                   , lens
+                   , lens-aeson
                    , process
                    , process-extras
                    , temporary
@@ -46,6 +48,7 @@ library
   exposed-modules:     Arion.Nix
                        Arion.Aeson
                        Arion.DockerCompose
+                       Arion.Images
   other-modules:       Paths_arion_compose
   -- other-extensions:
   hs-source-dirs:      src/haskell/lib

nix/nixpkgs.nix

@@ -1,5 +1,5 @@
 # to update: $ nix-prefetch-url --unpack url
 builtins.fetchTarball {
-  url = "https://github.com/NixOS/nixpkgs/archive/be445a9074f139d63e704fa82610d25456562c3d.tar.gz";
+  url = "https://github.com/NixOS/nixpkgs/archive/bd5e8f35c2e9d1ddc9cd2fea7a23563336d54acb.tar.gz";
-  sha256 = "15dc7gdspimavcwyw9nif4s59v79gk18rwsafylffs9m1ld2dxwa";
+  sha256 = "1wnzqqijrwf797nb234q10zb1h7086njradkkrx3a15b303grsw4";
 }

src/haskell/exe/Main.hs

@@ -7,6 +7,7 @@ import Protolude hiding (Down)
 
 import           Arion.Nix
 import           Arion.Aeson
+import           Arion.Images (loadImages)
 import qualified Arion.DockerCompose as DockerCompose
 
 import Options.Applicative
@@ -141,7 +142,8 @@ runDC cmd (DockerComposeArgs args) opts = do
 runBuildAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO ()
 runBuildAndDC cmd dopts opts = do
   ea <- defaultEvaluationArgs opts
-  Arion.Nix.withBuiltComposition ea $ \path ->
+  Arion.Nix.withBuiltComposition ea $ \path -> do
+    loadImages path
     DockerCompose.run DockerCompose.Args
       { files = [path]
       , otherArgs = [cmd] ++ unDockerComposeArgs dopts

src/haskell/lib/Arion/Aeson.hs

@@ -1,6 +1,8 @@
 module Arion.Aeson where
 
+import Prelude ()
 import           Data.Aeson
+import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text.Lazy                as TL
 import qualified Data.Text.Lazy.IO             as TL
 import qualified Data.Text.Lazy.Builder        as TB
@@ -18,3 +20,10 @@ pretty =
     . TB.toLazyText
     . Data.Aeson.Encode.Pretty.encodePrettyToTextBuilder' config
   where config = defConfig { confCompare = compare, confTrailingNewline = True }
+
+decodeFile :: FromJSON a => FilePath -> IO a
+decodeFile fp = do
+  b <- BL.readFile fp
+  case eitherDecode b of
+    Left e -> panic (toS e)
+    Right v -> pure v

src/haskell/lib/Arion/Images.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Arion.Images 
+  ( loadImages
+  ) where
+
+import Prelude()
+import Protolude hiding (to)
+
+import qualified Data.Aeson as Aeson
+import           Arion.Aeson (decodeFile)
+import qualified Data.ByteString as BS
+import qualified System.Process as Process
+
+import Control.Lens
+import Data.Aeson.Lens
+import Data.String
+import System.IO (withFile, IOMode(ReadMode))
+
+
+data Image = Image
+  { image :: Text -- ^ file path
+  , imageName :: Text
+  , imageTag :: Text
+  } deriving (Generic, Aeson.ToJSON, Aeson.FromJSON, Show)
+
+type TaggedImage = Text
+
+loadImages :: FilePath -> IO ()
+loadImages fp = do
+
+  v <- decodeFile fp
+
+  loaded <- dockerImages
+
+  let
+    images :: [Image]
+    images = (v :: Aeson.Value) ^.. key "x-arion" . key "images" . _Array . traverse . _JSON
+
+    isNew i = (imageName i <> ":" <> imageTag i) `notElem` loaded
+
+  traverse_ loadImage . map (toS . image) . filter isNew $ images
+
+loadImage :: FilePath -> IO ()
+loadImage imgPath = withFile (imgPath) ReadMode $ \fileHandle -> do
+  let procSpec = (Process.proc "docker" [ "load" ]) {
+          Process.std_in = Process.UseHandle fileHandle
+        }
+  Process.withCreateProcess procSpec $ \_in _out _err procHandle -> do
+    e <- Process.waitForProcess procHandle 
+    case e of
+      ExitSuccess -> pass
+      ExitFailure code -> panic $ "docker load (" <> show code <> ") failed for " <> toS imgPath
+
+
+dockerImages :: IO [TaggedImage]
+dockerImages = do
+  let procSpec = Process.proc "docker" [ "images",  "--filter", "dangling=false", "--format", "{{.Repository}}:{{.Tag}}" ]
+  (map toS . lines) <$> Process.readCreateProcess procSpec ""

src/haskell/test/Arion/NixSpec.hs

@@ -32,12 +32,27 @@ spec = describe "evaluateComposition" $ it "matches an example" $ do
   expected <- T.readFile "src/haskell/testdata/Arion/NixSpec/arion-compose.json"
   censorPaths actual `shouldBe` censorPaths expected
 
-censorPaths :: Text -> Text
+censorPaths = censorImages . censorStorePaths
-censorPaths x = case T.breakOn "/nix/store/" x of
+--censorPaths = censorStorePaths
+
+censorStorePaths :: Text -> Text
+censorStorePaths x = case T.breakOn "/nix/store/" x of
   (prefix, tl) | (tl :: Text) == "" -> prefix
   (prefix, tl) -> prefix <> "<STOREPATH>" <> censorPaths
     (T.dropWhile isNixNameChar $ T.drop (T.length "/nix/store/") tl)
 
+-- Probably slow, due to not O(1) <>
+censorImages :: Text -> Text
+censorImages x = case T.break (\c -> c == ':' || c == '"') x of
+  (prefix, tl) | tl == "" -> prefix
+  (prefix, tl) | let imageId = T.take 33 (T.drop 1 tl)
+               , T.last imageId == '\"'
+                 -- Approximation of nix hash validation
+               , T.all (\c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'z')) (T.take 32 imageId)
+               -> prefix <> T.take 1 tl <> "<HASH>" <> censorImages (T.drop 33 tl)
+  (prefix, tl) -> prefix <> T.take 1 tl <> censorImages (T.drop 1 tl)
+
+
 -- | WARNING: THIS IS LIKELY WRONG: DON'T REUSE
 isNixNameChar :: Char -> Bool
 isNixNameChar c | c >= '0' && c <= '9' = True

src/haskell/testdata/Arion/NixSpec/arion-compose.json

@@ -1,9 +1,6 @@
 {
     "services": {
         "webserver": {
-            "build": {
-                "context": "/nix/store/l6jwin74n93d66ralxzb001c22yjii9x-arion-image"
-            },
             "command": [
                 "/nix/store/b9w61w4g8sqgrm3rid6ca22krslqghb3-nixos-system-unnamed-19.03.173100.e726e8291b2/init"
             ],
@@ -12,7 +9,7 @@
                 "PATH": "/usr/bin:/run/current-system/sw/bin/",
                 "container": "docker"
             },
-            "image": "arion-base",
+            "image": "webserver:<HASH>",
             "ports": [
                 "8000:80"
             ],
@@ -33,7 +30,13 @@
     },
     "version": "3.4",
     "x-arion": {
-        "images": [],
+        "images": [
+            {
+                "image": "<STOREPATH>",
+                "imageName": "webserver",
+                "imageTag": "<HASH>"
+            }
+        ],
         "serviceInfo": {
             "webserver": {
                 "defaultExec": [

src/nix/modules/service/host-store.nix

@@ -29,9 +29,14 @@ in
     };
   };
   config = mkIf config.service.useHostStore {
-    image.nixBuild = false; # no need to build and load
+    image.nixBuild = true;
-    service.image = "arion-base";
+    image.contents = [
-    service.build.context = "${../../../arion-image}";
+      (pkgs.runCommand "minimal-contents" {} ''
+        mkdir -p $out/bin $out/usr/bin
+        ln -s /run/system/bin/sh $out/bin/sh
+        ln -s /run/system/usr/bin/env $out/usr/bin/env
+      '')
+    ];
     service.environment.NIX_REMOTE = lib.optionalString config.service.useHostNixDaemon "daemon";
     service.volumes = [
       "${config.host.nixStorePrefix}/nix/store:/nix/store${lib.optionalString config.service.hostStoreAsReadOnly ":ro"}"