codedownio/sandwich
1
1
Fork 0
mirror of https://github.com/codedownio/sandwich.git synced 2024-08-16 23:30:22 +03:00
Code Issues Projects Releases Wiki Activity

Trying to read image name for tarballs

Browse Source
This commit is contained in:
Tom McLaughlin 2024-04-28 01:20:16 -06:00
parent 4ae2cdf648
commit a1bdc525f6
4 changed files with 27 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
sandwich-contexts-docker/lib/Test/Sandwich/Contexts/Docker/Container.hs
View File

@ -10,8 +10,6 @@ module Test.Sandwich.Contexts.Docker.Container (
, containerNameToContainerId
, readUncompressedImageName
, waitForHealth
) where
@ -22,19 +20,15 @@ import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Retry
import Data.Aeson as A
import Data.Aeson.TH as A
import qualified Data.ByteString.Lazy as BL
import qualified Data.List as L
import qualified Data.Map as M
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Vector as V
import Network.Socket (PortNumber)
import Relude
import Safe
import System.Exit
import System.FilePath
import Test.Sandwich
import Test.Sandwich.Contexts.Util.Aeson (aesonLookup)
import qualified Text.Show
import UnliftIO.Process
@ -108,19 +102,3 @@ containerNameToContainerId containerSystem containerName = do
liftIO (readCreateProcessWithExitCode (shell cmd) "") >>= \case
(ExitSuccess, sout, _serr) -> return $ T.strip $ toText sout
(ExitFailure n, sout, serr) -> expectationFailure [i|Failed to obtain container ID for container named '#{containerName}'. Code: #{n}. Stdout: '#{sout}'. Stderr: '#{serr}'.|]
readUncompressedImageName :: (HasCallStack, MonadIO m) => FilePath -> m Text
readUncompressedImageName path = do
contents <- liftIO $ BL.readFile (path </> "manifest.json")
case A.eitherDecode contents of
Left err -> expectationFailure [i|Couldn't decode manifest.json: #{err}|]
Right (A.Array entries) -> case concatMap getRepoTags entries of
(x:_) -> pure x
[] -> expectationFailure [i|Didn't find a repo tag for image at #{path}|]
Right x -> expectationFailure [i|Unexpected manifest.json format: #{x}|]
where
getRepoTags :: A.Value -> [Text]
getRepoTags (A.Object (aesonLookup "RepoTags" -> Just (A.Array repoItems))) = [t | A.String t <- V.toList repoItems]
getRepoTags _ = []

2
sandwich-contexts-kubernetes/lib/Sandwich/Contexts/Kubernetes/MinikubeCluster/Images.hs
View File

@ -69,7 +69,7 @@ withLoadImages' kcc@(KubernetesClusterContext {kubernetesClusterType=(Kubernetes
|]
debug [i|withLoadImages': #{cmd}|]
createProcessWithLogging (shell cmd) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
tweak <$> readUncompressedImageName (toString image)
tweak <$> readImageName (toString image)
False -> do
let cmd = [iii|minikube image load #{image}

28
sandwich-contexts-kubernetes/lib/Sandwich/Contexts/Kubernetes/Util/Container.hs
View File

@ -10,12 +10,12 @@ module Sandwich.Contexts.Kubernetes.Util.Container (
, containerNameToContainerId
, readImageName
, readUncompressedImageName
, waitForHealth
) where
import Sandwich.Contexts.Kubernetes.Util.Aeson
import Control.Monad.Catch
import Control.Monad.IO.Unlift
import Control.Monad.Logger
@ -32,11 +32,14 @@ import qualified Data.Vector as V
import Network.Socket (PortNumber)
import Relude
import Safe
import Sandwich.Contexts.Kubernetes.Util.Aeson
import System.Exit
import System.FilePath
import Test.Sandwich
import qualified Text.Show
import UnliftIO.Directory
import UnliftIO.Process
import UnliftIO.Temporary
data ContainerSystem = ContainerSystemDocker | ContainerSystemPodman
@ -110,9 +113,28 @@ containerNameToContainerId containerSystem containerName = do
(ExitFailure n, sout, serr) -> expectationFailure [i|Failed to obtain container ID for container named '#{containerName}'. Code: #{n}. Stdout: '#{sout}'. Stderr: '#{serr}'.|]
readUncompressedImageName :: (HasCallStack, MonadIO m) => FilePath -> m Text
readUncompressedImageName path = do
contents <- liftIO $ BL.readFile (path </> "manifest.json")
readUncompressedImageName path = liftIO (BL.readFile (path </> "manifest.json")) >>= getImageNameFromManifestJson path
readImageName :: (HasCallStack, MonadUnliftIO m, MonadLogger m) => FilePath -> m Text
readImageName path = doesDirectoryExist path >>= \case
True -> readUncompressedImageName path
False -> case takeExtension path of
".tar" -> extractFromTarball
".gz" -> extractFromTarball
_ -> expectationFailure [i|readImageName: unexpected extension in #{path}. Wanted .tar, .tar.gz, or uncompressed directory.|]
where
extractFromTarball = do
files <- readCreateProcessWithLogging (proc "tar" ["tf", path]) ""
manifestFileName <- case headMay [t | t <- T.words (toText files), "manifest.json" `T.isInfixOf` t] of
Just f -> pure $ toString $ T.strip f
Nothing -> expectationFailure [i|readImageName: couldn't find manifest file in #{path}|]
withSystemTempDirectory "manifest.json" $ \dir -> do
_ <- readCreateProcessWithLogging ((proc "tar" ["xvf", path, manifestFileName]) { cwd = Just dir }) ""
liftIO (BL.readFile (dir </> "manifest.json")) >>= getImageNameFromManifestJson path
getImageNameFromManifestJson :: (HasCallStack, MonadIO m) => FilePath -> LByteString -> m Text
getImageNameFromManifestJson path contents = do
case A.eitherDecode contents of
Left err -> expectationFailure [i|Couldn't decode manifest.json: #{err}|]
Right (A.Array entries) -> case concatMap getRepoTags entries of

20
sandwich-contexts/lib/Test/Sandwich/Contexts/Util/Container.hs
View File

@ -10,8 +10,6 @@ module Test.Sandwich.Contexts.Util.Container (
, containerNameToContainerId
, readUncompressedImageName
, waitForHealth
) where
@ -30,10 +28,10 @@ import qualified Data.Vector as V
import Network.Socket (PortNumber)
import Relude
import Safe
import Test.Sandwich.Contexts.Util.Aeson
import System.Exit
import System.FilePath
import Test.Sandwich
import Test.Sandwich.Contexts.Util.Aeson
import qualified Text.Show
import UnliftIO.Process
@ -107,19 +105,3 @@ containerNameToContainerId containerSystem containerName = do
liftIO (readCreateProcessWithExitCode (shell cmd) "") >>= \case
(ExitSuccess, sout, _serr) -> return $ T.strip $ toText sout
(ExitFailure n, sout, serr) -> expectationFailure [i|Failed to obtain container ID for container named '#{containerName}'. Code: #{n}. Stdout: '#{sout}'. Stderr: '#{serr}'.|]
readUncompressedImageName :: (HasCallStack, MonadIO m) => FilePath -> m Text
readUncompressedImageName path = do
contents <- liftIO $ BL.readFile (path </> "manifest.json")
case A.eitherDecode contents of
Left err -> expectationFailure [i|Couldn't decode manifest.json: #{err}|]
Right (A.Array entries) -> case concatMap getRepoTags entries of
(x:_) -> pure x
[] -> expectationFailure [i|Didn't find a repo tag for image at #{path}|]
Right x -> expectationFailure [i|Unexpected manifest.json format: #{x}|]
where
getRepoTags :: A.Value -> [Text]
getRepoTags (A.Object (aesonLookup "RepoTags" -> Just (A.Array repoItems))) = [t | A.String t <- V.toList repoItems]
getRepoTags _ = []