{-# 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 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 -- | Subject to change 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 ""