This commit is contained in:
Robert Hensing 2021-05-31 15:17:19 +02:00
parent e73710caf9
commit 2b46a9b5f6

View file

@ -1,7 +1,7 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Arion.Images module Arion.Images
( loadImages ( loadImages
) where ) where
@ -22,7 +22,7 @@ loadImages requestedImages = do
loaded <- getDockerImages loaded <- getDockerImages
let let
isNew i = isNew i =
-- On docker, the image name is unmodified -- On docker, the image name is unmodified
(imageName i <> ":" <> imageTag i) `notElem` loaded (imageName i <> ":" <> imageTag i) `notElem` loaded
-- -- On podman, you automatically get a localhost prefix -- -- On podman, you automatically get a localhost prefix
@ -31,19 +31,19 @@ loadImages requestedImages = do
traverse_ loadImage . filter isNew $ requestedImages traverse_ loadImage . filter isNew $ requestedImages
loadImage :: Image -> IO () loadImage :: Image -> IO ()
loadImage (Image { image = Just imgPath, imageName = name }) = loadImage Image { image = Just imgPath, imageName = name } =
withFile (toS imgPath) ReadMode $ \fileHandle -> do withFile (toS imgPath) ReadMode $ \fileHandle -> do
let procSpec = (Process.proc "docker" [ "load" ]) { let procSpec = (Process.proc "docker" [ "load" ]) {
Process.std_in = Process.UseHandle fileHandle Process.std_in = Process.UseHandle fileHandle
} }
Process.withCreateProcess procSpec $ \_in _out _err procHandle -> do Process.withCreateProcess procSpec $ \_in _out _err procHandle -> do
e <- Process.waitForProcess procHandle e <- Process.waitForProcess procHandle
case e of case e of
ExitSuccess -> pass ExitSuccess -> pass
ExitFailure code -> ExitFailure code ->
panic $ "docker load failed with exit code " <> show code <> " for image " <> name <> " from path " <> imgPath panic $ "docker load failed with exit code " <> show code <> " for image " <> name <> " from path " <> imgPath
loadImage (Image { imageExe = Just imgExe, imageName = name }) = do loadImage Image { imageExe = Just imgExe, imageName = name } = do
let loadSpec = (Process.proc "docker" [ "load" ]) { Process.std_in = Process.CreatePipe } let loadSpec = (Process.proc "docker" [ "load" ]) { Process.std_in = Process.CreatePipe }
Process.withCreateProcess loadSpec $ \(Just inHandle) _out _err loadProcHandle -> do Process.withCreateProcess loadSpec $ \(Just inHandle) _out _err loadProcHandle -> do
let streamSpec = Process.proc (toS imgExe) [] let streamSpec = Process.proc (toS imgExe) []
@ -61,11 +61,11 @@ loadImage (Image { imageExe = Just imgExe, imageName = name }) = do
_ -> pass _ -> pass
pass pass
loadImage (Image { imageName = name }) = do loadImage Image { imageName = name } = do
panic $ "image " <> name <> " doesn't specify an image file or imageExe executable" panic $ "image " <> name <> " doesn't specify an image file or imageExe executable"
getDockerImages :: IO [TaggedImage] getDockerImages :: IO [TaggedImage]
getDockerImages = do getDockerImages = do
let procSpec = Process.proc "docker" [ "images", "--filter", "dangling=false", "--format", "{{.Repository}}:{{.Tag}}" ] let procSpec = Process.proc "docker" [ "images", "--filter", "dangling=false", "--format", "{{.Repository}}:{{.Tag}}" ]
(map toS . T.lines . toS) <$> Process.readCreateProcess procSpec "" map toS . T.lines . toS <$> Process.readCreateProcess procSpec ""