{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module B9.ArtifactGenerator
(ArtifactGenerator(..), ArtifactSource(..), InstanceId(..),
ArtifactTarget(..), CloudInitType(..), ArtifactAssembly(..),
AssembledArtifact(..), AssemblyOutput(..), instanceIdKey, buildIdKey, buildDateKey,
getAssemblyOutput, getArtifactSourceFiles)
where
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Hashable
import GHC.Generics (Generic)
import Data.Semigroup as Sem
import System.FilePath ((<.>), (</>))
import B9.DiskImages
import B9.Vm
import B9.Content.StringTemplate
import B9.Content.Generator
import B9.QCUtil
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 Hashable ArtifactGenerator
instance Binary ArtifactGenerator
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.<>)
data ArtifactSource
= FromFile FilePath
SourceFile
|
FromContent FilePath
Content
|
SetPermissions Int
Int
Int
[ArtifactSource]
|
FromDirectory FilePath
[ArtifactSource]
|
IntoDirectory FilePath
[ArtifactSource]
|
Concatenation FilePath
[ArtifactSource]
deriving (Read,Show,Eq,Data,Typeable,Generic)
instance Hashable ArtifactSource
instance Binary ArtifactSource
instance NFData ArtifactSource
getArtifactSourceFiles :: ArtifactSource -> [FilePath]
getArtifactSourceFiles (Concatenation f _) = [f]
getArtifactSourceFiles (FromContent f _) = [f]
getArtifactSourceFiles (FromFile f _) = [f]
getArtifactSourceFiles (IntoDirectory pd as) =
(pd</>) <$> (as >>= getArtifactSourceFiles)
getArtifactSourceFiles (FromDirectory _ as) = as >>= getArtifactSourceFiles
getArtifactSourceFiles (SetPermissions _ _ _ as) =
as >>= getArtifactSourceFiles
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 ArtifactSource where
arbitrary =
oneof
[ FromFile <$> smaller arbitraryFilePath <*> smaller arbitrary
, FromContent <$> smaller arbitraryFilePath <*> smaller arbitrary
, SetPermissions <$> choose (0, 7) <*> choose (0, 7) <*>
choose (0, 7) <*>
smaller arbitrary
, FromDirectory <$> smaller arbitraryFilePath <*> smaller arbitrary
, IntoDirectory <$> smaller arbitraryFilePath <*> smaller arbitrary]
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]