{-# 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 qualified Data.Text as T
import Control.Lens
import Data.Aeson.Lens
import System.IO (withFile, IOMode(ReadMode))
data Image = Image
{ image :: Text
, 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 . T.lines . toS) <$> Process.readCreateProcess procSpec ""