{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module B9.Artifact.Readable
( ArtifactGenerator(..)
, InstanceId(..)
, ArtifactTarget(..)
, CloudInitType(..)
, ArtifactAssembly(..)
, AssembledArtifact(..)
, AssemblyOutput(..)
, instanceIdKey
, buildIdKey
, buildDateKey
, getAssemblyOutput
, ArtifactSource(..)
, getArtifactSourceFiles
) where
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Hashable
import Data.Semigroup as Sem
import GHC.Generics (Generic)
import System.FilePath ((<.>))
import B9.Artifact.Readable.Source
import B9.DiskImages
import B9.QCUtil
import B9.Vm
import Test.QuickCheck
data ArtifactGenerator
= Sources [ArtifactSource]
[ArtifactGenerator]
| Let [(String, String)]
[ArtifactGenerator]
| LetX [(String, [String])]
[ArtifactGenerator]
| Each [(String, [String])]
[ArtifactGenerator]
| EachT [String]
[[String]]
[ArtifactGenerator]
| Artifact InstanceId
ArtifactAssembly
| EmptyArtifact
deriving (Read, Show, Eq, Data, Typeable, Generic)
instance NFData ArtifactGenerator
instance Sem.Semigroup ArtifactGenerator where
(Let [] []) <> x = x
x <> (Let [] []) = x
x <> y = Let [] [x, y]
instance Monoid ArtifactGenerator where
mempty = Let [] []
mappend = (Sem.<>)
newtype InstanceId =
IID String
deriving (Read, Show, Typeable, Data, Eq, NFData, Binary, Hashable)
instanceIdKey :: String
instanceIdKey = "instance_id"
buildIdKey :: String
buildIdKey = "build_id"
buildDateKey :: String
buildDateKey = "build_date"
data ArtifactAssembly
= CloudInit [CloudInitType]
FilePath
| VmImages [ImageTarget]
VmScript
deriving (Read, Show, Typeable, Data, Eq, Generic)
instance Hashable ArtifactAssembly
instance Binary ArtifactAssembly
instance NFData ArtifactAssembly
data AssembledArtifact =
AssembledArtifact InstanceId
[ArtifactTarget]
deriving (Read, Show, Typeable, Data, Eq, Generic)
instance Hashable AssembledArtifact
instance Binary AssembledArtifact
instance NFData AssembledArtifact
data ArtifactTarget
= CloudInitTarget CloudInitType
FilePath
| VmImagesTarget
deriving (Read, Show, Typeable, Data, Eq, Generic)
instance Hashable ArtifactTarget
instance Binary ArtifactTarget
instance NFData ArtifactTarget
data CloudInitType
= CI_ISO
| CI_VFAT
| CI_DIR
deriving (Read, Show, Typeable, Data, Eq, Generic)
instance Hashable CloudInitType
instance Binary CloudInitType
instance NFData CloudInitType
data AssemblyOutput
= AssemblyGeneratesOutputFiles [FilePath]
| AssemblyCopiesSourcesToDirectory FilePath
deriving (Read, Show, Typeable, Data, Eq, Generic)
getAssemblyOutput :: ArtifactAssembly -> [AssemblyOutput]
getAssemblyOutput (VmImages ts _) = AssemblyGeneratesOutputFiles . getImageDestinationOutputFiles <$> ts
getAssemblyOutput (CloudInit ts o) = getCloudInitOutputFiles o <$> ts
where
getCloudInitOutputFiles baseName t =
case t of
CI_ISO -> AssemblyGeneratesOutputFiles [baseName <.> "iso"]
CI_VFAT -> AssemblyGeneratesOutputFiles [baseName <.> "vfat"]
CI_DIR -> AssemblyCopiesSourcesToDirectory baseName
instance Arbitrary ArtifactGenerator where
arbitrary =
oneof
[ Sources <$> halfSize arbitrary <*> halfSize arbitrary
, Let <$> halfSize arbitraryEnv <*> halfSize arbitrary
, halfSize arbitraryEachT <*> halfSize arbitrary
, halfSize arbitraryEach <*> halfSize arbitrary
, Artifact <$> smaller arbitrary <*> smaller arbitrary
, pure EmptyArtifact
]
arbitraryEachT :: Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEachT =
sized $ \n ->
EachT <$> vectorOf n (halfSize (listOf1 (choose ('a', 'z')))) <*>
oneof [listOf (vectorOf n (halfSize arbitrary)), listOf1 (listOf (halfSize arbitrary))]
arbitraryEach :: Gen ([ArtifactGenerator] -> ArtifactGenerator)
arbitraryEach =
sized $ \n ->
Each <$> listOf ((,) <$> listOf1 (choose ('a', 'z')) <*> vectorOf n (halfSize (listOf1 (choose ('a', 'z')))))
instance Arbitrary InstanceId where
arbitrary = IID <$> arbitraryFilePath
instance Arbitrary ArtifactAssembly where
arbitrary = oneof [CloudInit <$> arbitrary <*> arbitraryFilePath, VmImages <$> smaller arbitrary <*> pure NoVmScript]
instance Arbitrary CloudInitType where
arbitrary = elements [CI_ISO, CI_VFAT, CI_DIR]