1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
{-# 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
, dataFiles :: 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 "files" 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
|
