Skip to content

Commit

Permalink
sandwich-contexts-kubernetes: added tarball to image load tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@thomasjm
thomasjm committed Aug 1, 2024
1 parent 10f6d5a commit 889bfe6
Show file tree
Hide file tree
Showing 2 changed files with 125 additions and 66 deletions.
42 changes: 31 additions & 11 deletions sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KindCluster/Images.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ import Test.Sandwich.Contexts.Kubernetes.KindCluster.Setup
import Test.Sandwich.Contexts.Kubernetes.Types
import Test.Sandwich.Contexts.Kubernetes.Util.Aeson
import Test.Sandwich.Contexts.Kubernetes.Util.Images
import UnliftIO.Directory
import UnliftIO.Process
import UnliftIO.Temporary

Expand All @@ -43,16 +44,30 @@ loadImage :: (
loadImage kindBinary clusterName imageLoadSpec env = do
case imageLoadSpec of
ImageLoadSpecTarball image -> do
withSystemTempDirectory "kind-image-zip" $ \dir -> do
let archive = dir </> "test.tar"
_ <- readCreateProcessWithLogging (shell [i|tar -C #{image} --dereference --hard-dereference --xform s:'^./':: -c . > #{archive}|]) ""

debug [i|Made image archive: #{archive}|]
createProcessWithLogging (
(shell [i|#{kindBinary} load image-archive #{archive} --name #{clusterName}|]) {
env = env
}) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
readUncompressedImageName (toString image)
doesDirectoryExist (toString image) >>= \case
True ->
-- Uncompressed directory: tar it up (but don't zip).
-- TODO: don't depend on external tar binary
withSystemTempDirectory "kind-image-zip" $ \dir -> do
let tarFile = dir </> "test.tar"
_ <- readCreateProcessWithLogging (shell [i|tar -C #{image} --dereference --hard-dereference --xform s:'^./':: -c . > #{tarFile}|]) ""
imageLoad tarFile
readUncompressedImageName (toString image)

False -> case takeExtension (toString image) of
".tar" -> do
imageLoad (toString image)
readImageName (toString image)
".gz" -> do
withSystemTempDirectory "image-tarball" $ \tempDir -> do
let tarFile = tempDir </> "image.tar"
-- TODO: don't depend on external gzip binary
createProcessWithLogging (shell [i|cat "#{image}" | gzip -d > "#{tarFile}"|])
>>= waitForProcess >>= (`shouldBe` ExitSuccess)
imageLoad tarFile
readImageName (toString image)
_ -> expectationFailure [i|Unexpected image extension in #{image}. Wanted .tar, .tar.gz, or uncompressed directory.|]

ImageLoadSpecDocker image pullPolicy -> do
_ <- dockerPullIfNecessary image pullPolicy

Expand All @@ -68,7 +83,12 @@ loadImage kindBinary clusterName imageLoadSpec env = do
_ <- expectationFailure [i|Not implemented yet.|]

return image

where
imageLoad tarFile =
createProcessWithLogging (
(shell [i|#{kindBinary} load image-archive #{tarFile} --name #{clusterName}|]) {
env = env
}) >>= waitForProcess >>= (`shouldBe` ExitSuccess)

getLoadedImages :: (
HasCallStack, MonadUnliftIO m, MonadLogger m
Expand Down
149 changes: 94 additions & 55 deletions sandwich-contexts-kubernetes/test/Spec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,74 +35,101 @@ imageLoadSpecs = [
, ImageLoadSpecDocker "gcr.io/distroless/static-debian11:latest" IfNotPresent
]

tarballDerivations :: [(Text, Text)]
tarballDerivations = [
("busybox-tarball", busyboxDerivation)
]

imageLabel :: Label "image" Text
imageLabel = Label

imageLoadSpecLabel :: Label "imageLoadSpec" ImageLoadSpec
imageLoadSpecLabel = Label

opts :: NodeOptions
opts = defaultNodeOptions { nodeOptionsVisibilityThreshold = 50 }

loadImageTests :: (
MonadUnliftIO m
, HasBaseContext context, HasKubernetesClusterContext context, HasFile context "kubectl"
, HasBaseContext context, HasKubernetesClusterContext context, HasNixContext context, HasFile context "kubectl"
) => SpecFree context m ()
loadImageTests = do
it "prints the cluster info" $ do
kcc <- getContext kubernetesCluster
info [i|Got Kubernetes cluster context: #{kcc}|]

forM_ tarballDerivations $ \(name, derivation) ->
introduce' opts [i|#{name}|] imageLoadSpecLabel (ImageLoadSpecTarball <$> buildNixCallPackageDerivation derivation) (const $ return ()) $
introduce [i|#{name} load (tarball)|] imageLabel (getContext imageLoadSpecLabel >>= loadImage) (const $ return ()) $ do
loadImageTests'

forM_ imageLoadSpecs $ \ils ->
introduce' opts [i|#{ils}|] imageLoadSpecLabel (pure ils) (const $ return ()) $
introduce [i|#{ils} load|] imageLabel (loadImage ils) (const $ return ()) $ do
it "Doesn't transform Docker/Podman image names" $ do
image <- getContext imageLabel
case ils of
ImageLoadSpecTarball {} -> return ()
ImageLoadSpecDocker initialImage _ -> image `shouldBe` initialImage
ImageLoadSpecPodman initialImage _ -> image `shouldBe` initialImage

it "Cluster contains the image" $ do
images <- getLoadedImages
forM_ images $ \img ->
info [i|loaded image: #{img}|]

image <- getContext imageLabel
clusterContainsImage image >>= \case
False -> expectationFailure [i|Cluster didn't contain image '#{image}'|]
True -> return ()

it "Creates a pod and the cluster finds the image already present" $ do
image <- getContext imageLabel
podName <- ("test-pod-" <>) <$> randomAlpha 8

-- namespace <- ("test-namespace-" <>) <$> randomAlpha 8
-- withKubernetesNamespace' (toText namespace) $
let namespace = "default"

runWithKubectl $ \kubectlBinary env -> do
-- Wait for service account to exist; see
-- https://github.com/kubernetes/kubernetes/issues/66689
waitUntil 60 $
createProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "get", "serviceaccount", "default"
, "-o", "name"]) { env = Just env })
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

let deletePod = createProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "delete", "pod", podName]) { env = Just env })
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

flip finally deletePod $ do
createProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "run", podName
, "--image", toString image
, "--image-pull-policy=IfNotPresent"
, "--command", "--", "/bin/sh", "-c", "sleep infinity"
]) { env = Just env })
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

waitUntil 300 $ do
events <- readCreateProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "get", "events"
, "--field-selector", [i|involvedObject.kind=Pod,involvedObject.name=#{podName}|]
]) { env = Just env }) ""
info [i|events: #{events}|]
events `shouldContain` "already present on machine"
loadImageTests'

loadImageTests' :: (
MonadUnliftIO m
, HasBaseContext context
, HasKubernetesClusterContext context
, HasFile context "kubectl"
, HasLabel context "image" Text, HasLabel context "imageLoadSpec" ImageLoadSpec
) => SpecFree context m ()
loadImageTests' = do
it "Doesn't transform Docker/Podman image names" $ do
image <- getContext imageLabel
getContext imageLoadSpecLabel >>= \case
ImageLoadSpecTarball {} -> return ()
ImageLoadSpecDocker initialImage _ -> image `shouldBe` initialImage
ImageLoadSpecPodman initialImage _ -> image `shouldBe` initialImage

it "Cluster contains the image" $ do
images <- getLoadedImages
forM_ images $ \img ->
info [i|loaded image: #{img}|]

image <- getContext imageLabel
clusterContainsImage image >>= \case
False -> expectationFailure [i|Cluster didn't contain image '#{image}'|]
True -> return ()

it "Creates a pod and the cluster finds the image already present" $ do
image <- getContext imageLabel
podName <- ("test-pod-" <>) <$> randomAlpha 8

-- namespace <- ("test-namespace-" <>) <$> randomAlpha 8
-- withKubernetesNamespace' (toText namespace) $
let namespace = "default"

runWithKubectl $ \kubectlBinary env -> do
-- Wait for service account to exist; see
-- https://github.com/kubernetes/kubernetes/issues/66689
waitUntil 60 $
createProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "get", "serviceaccount", "default"
, "-o", "name"]) { env = Just env })
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

let deletePod = createProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "delete", "pod", podName]) { env = Just env })
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

flip finally deletePod $ do
createProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "run", podName
, "--image", toString image
, "--image-pull-policy=IfNotPresent"
, "--command", "--", "/bin/sh", "-c", "sleep infinity"
]) { env = Just env })
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

waitUntil 300 $ do
events <- readCreateProcessWithLogging ((proc kubectlBinary ["--namespace", namespace
, "get", "events"
, "--field-selector", [i|involvedObject.kind=Pod,involvedObject.name=#{podName}|]
]) { env = Just env }) ""
info [i|events: #{events}|]
events `shouldContain` "already present on machine"



Expand All @@ -111,6 +138,18 @@ randomAlpha len = liftIO $ do
gen <- R.newStdGen
return $ L.take len (R.randomRs ('a', 'z') gen)

busyboxDerivation :: Text
busyboxDerivation = [i|
{ dockerTools }:

dockerTools.pullImage {
imageName = "busybox";
imageDigest = "sha256:9ae97d36d26566ff84e8893c64a6dc4fe8ca6d1144bf5b87b2b85a32def253c7";
sha256 = "sha256-S4jXnRLZMZUyxjPku3jczd2PwCsFKR4TXRcIy3C/ym8=";
finalImageName = "busybox-tarball";
finalImageTag = "latest";
}
|]

main :: IO ()
main = runSandwichWithCommandLineArgs defaultOptions spec

0 comments on commit 889bfe6

Please sign in to comment.