{-# OPTIONS_GHC -fno-warn-type-defaults #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module ConfigFile where import Rebase.Prelude hiding (bool, hash, (<.>)) import Data.Yaml.Combinators import Development.Shake hiding (getEnv) import Development.Shake.Command () import qualified Rebase.Data.Set as Set import Rebase.Data.Text (pack, unpack) import Rebase.Data.Text.Encoding import qualified Rebase.Data.Vector as Vector {- Basic idea is to have a fs.yaml that specifies the build procedure. Analogous to stack.yaml, it should specify everything (every source) directly or indirectly. We want to make new images from CoW copies of old ones. We want to build these things incrementally, but still end up with something that will be reproducible from scratch. Anyway, what we'll have is a list of packages, which will be unpacked first. Then a list of debconf values, which will be applied. Then we will have the rest of the other, slower changes to the image (including dpkg --configure -a). Some changes can be assumed to produce the same results out of order. Oh right, and the zeroeth step is to generate the empty (or just initial) filesystem image. The initial filesystem image, if nonempty, is specified by filename (otherwise, by size), while the hash of the configuration determines the output filename. -- 'Parent' param should be a config file, not hash. The hash will only be used to determine whether we need to build it. -} newtype DebconfConfig = DebconfConfig Text deriving (Show, Read, Eq, Ord) newtype Package = Package Text deriving (Show, Read, Eq, Ord) data Patch = Patch deriving (Show, Read) data BaseImageSpecification = EmptyImageOfBytes Int64 | ParentImageConfigFile FilePath | SeededImage Int64 FilePath deriving (Show, Read) data DiskImageConfig = DiskImageConfig { initialImage :: BaseImageSpecification , packages :: Set Package , debconfConfig :: Maybe FilePath , unpackOnly :: Bool , unitFiles :: Vector Text , binaries :: Vector Text , optionalBinaries :: Vector Text , chrootCommands :: Vector Text , skelFiles :: Vector Text , optionalSkelFiles :: Vector Text , newSeededImgSize :: Maybe Int64 , installAptLists :: Bool } deriving (Show, Read) parsePackageName :: Text -> Package parsePackageName = Package -- TODO diskImageConfigParser :: Parser DiskImageConfig diskImageConfigParser = object $ DiskImageConfig <$> field "parent" ((EmptyImageOfBytes <$> integer) <> (ParentImageConfigFile . unpack <$> string)) <*> (Set.fromList . toList . fmap parsePackageName <$> defaultField "packages" Vector.empty (array string)) <*> (fmap unpack <$> optField "debconf" string) <*> defaultField "unpack-only" False bool <*> defaultField "unit-files" Vector.empty (array string) <*> defaultField "binaries" Vector.empty (array string) <*> defaultField "binaries-optional" Vector.empty (array string) <*> defaultField "chroot-commands" Vector.empty (array string) <*> defaultField "skel-files" Vector.empty (array string) <*> defaultField "skel-files-optional" Vector.empty (array string) <*> optField "seedme" integer <*> defaultField "apt-update" False bool convSeeded :: DiskImageConfig -> DiskImageConfig convSeeded x@(DiskImageConfig (ParentImageConfigFile f) _ _ _ _ _ _ _ _ _ (Just size) _) = x { initialImage = SeededImage size f } convSeeded x = x readCfg :: FilePath -> Action DiskImageConfig readCfg yaml = either error convSeeded . parse diskImageConfigParser . encodeUtf8 . pack <$> readFile' yaml