RepositoryIOSpec.hs

module B9.RepositoryIOSpec
  ( spec,
  )
where

import B9 (ppShow)
import B9.Artifact.Readable
import B9.Artifact.Readable.Interpreter (assemble)
import B9.B9Config
import B9.B9Error
import B9.B9Logging
import B9.B9Monad
import B9.BuildInfo
import B9.DiskImages
import B9.Repository
import B9.RepositoryIO
import B9.Vm
import Control.Concurrent (threadDelay)
import Control.Exception
import Control.Monad
import Data.Foldable
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.Directory
import System.Environment
import System.FilePath
import System.IO.B9Extras
import Test.Hspec
import Text.Printf

spec :: HasCallStack => Spec
spec = do
  let cleanCacheAndLookupImages mkCfg buildAction =
        withTempBuildDirs $ \cfgWithRepo -> do
          let cfg = overrideB9Config mkCfg cfgWithRepo
              buildCfg = overrideB9Config noCleanupCfg cfgWithRepo
          x <- buildAction buildCfg
          y <-
            allCachedSharedImages
              <$> b9Build
                cfg
                ( cleanLocalRepoCache
                    *> infoL "SEARCHING FOR SHARED IMAGES"
                    *> getSharedImages
                )
          return (x, y)
      shareAndLookupTestImages mkCfg =
        withTempBuildDirs $ \cfgWithRepo -> do
          let cfg = overrideB9Config mkCfg cfgWithRepo
          putStrLn (ppShow cfg)
          sharedImagesExpected <- shareTestImages cfg
          sharedImagesActual <-
            allCachedSharedImages
              <$> b9Build cfg getSharedImages
          return (sharedImagesExpected, sharedImagesActual)
      testBuilds3X2 =
        replicate
          3
          [ ( t,
              ImageTarget
                (Share t Raw KeepSize)
                (EmptyImage t Ext4 Raw (ImageSize 10 MB))
                NotMounted
            )
            | t <- ["testImg0", "testImg1"]
          ]
      shareTestImages cfg = fmap concat
        <$> forM testBuilds3X2
        $ \testTargets ->
          do
            threadDelay 1200000
            forM testTargets $ \(t, dest) ->
              b9Build
                cfg
                ( assemble
                    (Artifact (IID t) (VmImages [dest] NoVmScript))
                    *> ( SharedImage (SharedImageName t)
                           <$> (SharedImageDate <$> getBuildDate)
                           <*> (SharedImageBuildId <$> getBuildId)
                           <*> pure Raw
                           <*> pure Ext4
                       )
                )
  describe "shared_image_cache_cleanup" $ do
    context "_maxLocalSharedImageRevisions == Nothing" $ do
      context "no images in cache" $ do
        it "does nothing and returns no error" $
          cleanCacheAndLookupImages noCleanupCfg (const (return ()))
            >>= (`shouldBe` mempty) . snd
      context "two images names with each three versions" $ do
        it "removes ALL images" $
          cleanCacheAndLookupImages noCleanupCfg shareTestImages
            >>= (`shouldBe` mempty) . snd
    context "_maxLocalSharedImageRevisions == Just 1" $ do
      context "no images in cache" $ do
        it "does nothing and returns no error" $
          cleanCacheAndLookupImages
            (cleanupAfterBuildCfg 1)
            (const (return ()))
            >>= (`shouldBe` mempty) . snd
      context "two images names with each three versions" $ do
        it "retains the latest image of each subset with the same name (somehow they must procreate, right? ;)" $ do
          (generatedImages, actual) <-
            cleanCacheAndLookupImages
              (cleanupAfterBuildCfg 1)
              ( \c ->
                  shareTestImages c
                    *> (b9Build c (allCachedSharedImages <$> getSharedImages))
              )
          let expected =
                fold
                  ( Map.map
                      (Set.drop 2)
                      (groupBySharedImageName generatedImages)
                  )
          actual `shouldBe` expected
  -- TODO describe "pull shared images" $ do
  describe "create & share images" $ do
    describe "Without autmatic cleanup"
      $ it "returns all shared images that were built"
      $ do
        (sharedImagesExpected, sharedImagesActual) <-
          shareAndLookupTestImages noCleanupCfg
        sharedImagesActual `shouldBe` Set.fromList sharedImagesExpected
    describe "with automatic cleanup after build enabled in _maxLocalSharedImageRevisions" $ do
      describe "with an invalid parameter _maxLocalSharedImageRevisions == Just 0" $ do
        it "does nothing and exits with error" $
          shareAndLookupTestImages (cleanupAfterBuildCfg (-1))
            `shouldThrow` (const True :: Selector SomeException)
      describe "with an invalid parameter _maxLocalSharedImageRevisions == Just -1" $ do
        it "does nothing and exits with error" $
          shareAndLookupTestImages (cleanupAfterBuildCfg 0)
            `shouldThrow` (const True :: Selector B9Error)
      describe "with a valid parameter _maxLocalSharedImageRevisions == Just 1" $ do
        it "returns the latest of all shared images that were built" $ do
          (sharedImagesExpected, sharedImagesActual) <-
            shareAndLookupTestImages (cleanupAfterBuildCfg 1)
          sharedImagesActual `shouldBe` keepNLatestSharedImages 1 (Set.fromList sharedImagesExpected)
      describe "with a valid parameter _maxLocalSharedImageRevisions == Just 2" $ do
        it "returns the latest two of all shared images that were built" $ do
          (sharedImagesExpected, sharedImagesActual) <-
            shareAndLookupTestImages (cleanupAfterBuildCfg 2)
          sharedImagesActual `shouldBe` keepNLatestSharedImages 2 (Set.fromList sharedImagesExpected)
      describe "with a valid parameter _maxLocalSharedImageRevisions == Just 3000" $ do
        it "returns the latest 3000 of all shared images that were built" $ do
          (sharedImagesExpected, sharedImagesActual) <-
            shareAndLookupTestImages (cleanupAfterBuildCfg 3000)
          sharedImagesActual `shouldBe` Set.fromList sharedImagesExpected

noCleanupCfg :: B9Config -> B9Config
noCleanupCfg c =
  c {_maxLocalSharedImageRevisions = Nothing}

cleanupAfterBuildCfg :: Int -> B9Config -> B9Config
cleanupAfterBuildCfg n c =
  c {_maxLocalSharedImageRevisions = Just n}

b9Build :: HasCallStack => B9ConfigOverride -> B9 a -> IO a
b9Build cfg effect =
  runB9ConfigActionWithOverrides
    (runB9 effect)
    cfg

withTempBuildDirs :: HasCallStack => (B9ConfigOverride -> IO a) -> IO a
withTempBuildDirs k =
  bracket acquire release use
  where
    acquire = do
      nixOutDirEnv <- lookupEnv "NIX_BUILD_TOP"
      let rootDir = maybe InTempDir (((.) . (.)) Path (</>)) nixOutDirEnv
      repoRelPath <- printf "testsRepositoryIOSpec-test-repo-%U" <$> randomUUID
      buildRelPath <- printf "RepositoryIOSpec-root-%U" <$> randomUUID
      cfgRelPath <- printf "RepositoryIOSpec-b9cfg-%U" <$> randomUUID
      let tmpRepoPath = rootDir ("tests" </> repoRelPath)
          tmpBuildPath = rootDir ("tests" </> buildRelPath)
          tmpCfgPath = rootDir ("tests" </> cfgRelPath)
      ensureSystemPath tmpRepoPath
      ensureSystemPath tmpBuildPath
      tmpBuildPathFileName <- resolve tmpBuildPath
      return (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath)
    release (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) = do
      let cleanupTmpPath = removePathForcibly <=< resolve
      cleanupTmpPath tmpRepoPath
      cleanupTmpPath tmpCfgPath
      removePathForcibly tmpBuildPathFileName
    use (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) =
      let mkCfg cfgIn =
            cfgIn
              { _repositoryCache = Just tmpRepoPath,
                _projectRoot = Just tmpBuildPathFileName
              }
          oCfg =
            overrideB9Config
              mkCfg
              ( overrideWorkingDirectory
                  tmpBuildPathFileName
                  ( overrideDefaultB9ConfigPath
                      tmpCfgPath
                      noB9ConfigOverride
                  )
              )
       in k oCfg