Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Objects.hs @ 07e68848

History | View | Annotate | Download (23.7 kB)

1
{-# LANGUAGE TemplateHaskell #-}
2

    
3
{-| Implementation of the Ganeti config objects.
4

    
5
Some object fields are not implemented yet, and as such they are
6
commented out below.
7

    
8
-}
9

    
10
{-
11

    
12
Copyright (C) 2011, 2012, 2013 Google Inc.
13

    
14
This program is free software; you can redistribute it and/or modify
15
it under the terms of the GNU General Public License as published by
16
the Free Software Foundation; either version 2 of the License, or
17
(at your option) any later version.
18

    
19
This program is distributed in the hope that it will be useful, but
20
WITHOUT ANY WARRANTY; without even the implied warranty of
21
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
22
General Public License for more details.
23

    
24
You should have received a copy of the GNU General Public License
25
along with this program; if not, write to the Free Software
26
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27
02110-1301, USA.
28

    
29
-}
30

    
31
module Ganeti.Objects
32
  ( HvParams
33
  , OsParams
34
  , PartialNicParams(..)
35
  , FilledNicParams(..)
36
  , fillNicParams
37
  , allNicParamFields
38
  , PartialNic(..)
39
  , FileDriver(..)
40
  , DiskLogicalId(..)
41
  , Disk(..)
42
  , includesLogicalId
43
  , DiskTemplate(..)
44
  , PartialBeParams(..)
45
  , FilledBeParams(..)
46
  , fillBeParams
47
  , allBeParamFields
48
  , Instance(..)
49
  , toDictInstance
50
  , PartialNDParams(..)
51
  , FilledNDParams(..)
52
  , fillNDParams
53
  , allNDParamFields
54
  , Node(..)
55
  , AllocPolicy(..)
56
  , FilledISpecParams(..)
57
  , PartialISpecParams(..)
58
  , fillISpecParams
59
  , allISpecParamFields
60
  , MinMaxISpecs(..)
61
  , FilledIPolicy(..)
62
  , PartialIPolicy(..)
63
  , fillIPolicy
64
  , DiskParams
65
  , NodeGroup(..)
66
  , IpFamily(..)
67
  , ipFamilyToVersion
68
  , fillDict
69
  , ClusterHvParams
70
  , OsHvParams
71
  , ClusterBeParams
72
  , ClusterOsParams
73
  , ClusterNicParams
74
  , Cluster(..)
75
  , ConfigData(..)
76
  , TimeStampObject(..)
77
  , UuidObject(..)
78
  , SerialNoObject(..)
79
  , TagsObject(..)
80
  , DictObject(..) -- re-exported from THH
81
  , TagSet -- re-exported from THH
82
  , Network(..)
83
  , Ip4Address(..)
84
  , Ip4Network(..)
85
  , readIp4Address
86
  , nextIp4Address
87
  ) where
88

    
89
import Control.Applicative
90
import Data.List (foldl')
91
import Data.Maybe
92
import qualified Data.Map as Map
93
import qualified Data.Set as Set
94
import Data.Word
95
import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
96
import qualified Text.JSON as J
97

    
98
import qualified AutoConf
99
import qualified Ganeti.Constants as C
100
import qualified Ganeti.ConstantUtils as ConstantUtils
101
import Ganeti.JSON
102
import Ganeti.Types
103
import Ganeti.THH
104
import Ganeti.Utils (sepSplit, tryRead)
105

    
106
-- * Generic definitions
107

    
108
-- | Fills one map with keys from the other map, if not already
109
-- existing. Mirrors objects.py:FillDict.
110
fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v
111
fillDict defaults custom skip_keys =
112
  let updated = Map.union custom defaults
113
  in foldl' (flip Map.delete) updated skip_keys
114

    
115
-- | The hypervisor parameter type. This is currently a simple map,
116
-- without type checking on key/value pairs.
117
type HvParams = Container JSValue
118

    
119
-- | The OS parameters type. This is, and will remain, a string
120
-- container, since the keys are dynamically declared by the OSes, and
121
-- the values are always strings.
122
type OsParams = Container String
123

    
124
-- | Class of objects that have timestamps.
125
class TimeStampObject a where
126
  cTimeOf :: a -> Double
127
  mTimeOf :: a -> Double
128

    
129
-- | Class of objects that have an UUID.
130
class UuidObject a where
131
  uuidOf :: a -> String
132

    
133
-- | Class of object that have a serial number.
134
class SerialNoObject a where
135
  serialOf :: a -> Int
136

    
137
-- | Class of objects that have tags.
138
class TagsObject a where
139
  tagsOf :: a -> Set.Set String
140

    
141
-- * Network definitions
142

    
143
-- ** Ipv4 types
144

    
145
-- | Custom type for a simple IPv4 address.
146
data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
147
                  deriving Eq
148

    
149
instance Show Ip4Address where
150
  show (Ip4Address a b c d) = show a ++ "." ++ show b ++ "." ++
151
                              show c ++ "." ++ show d
152

    
153
-- | Parses an IPv4 address from a string.
154
readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address
155
readIp4Address s =
156
  case sepSplit '.' s of
157
    [a, b, c, d] -> Ip4Address <$>
158
                      tryRead "first octect" a <*>
159
                      tryRead "second octet" b <*>
160
                      tryRead "third octet"  c <*>
161
                      tryRead "fourth octet" d
162
    _ -> fail $ "Can't parse IPv4 address from string " ++ s
163

    
164
-- | JSON instance for 'Ip4Address'.
165
instance JSON Ip4Address where
166
  showJSON = showJSON . show
167
  readJSON (JSString s) = readIp4Address (fromJSString s)
168
  readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address"
169

    
170
-- | \"Next\" address implementation for IPv4 addresses.
171
--
172
-- Note that this loops! Note also that this is a very dumb
173
-- implementation.
174
nextIp4Address :: Ip4Address -> Ip4Address
175
nextIp4Address (Ip4Address a b c d) =
176
  let inc xs y = if all (==0) xs then y + 1 else y
177
      d' = d + 1
178
      c' = inc [d'] c
179
      b' = inc [c', d'] b
180
      a' = inc [b', c', d'] a
181
  in Ip4Address a' b' c' d'
182

    
183
-- | Custom type for an IPv4 network.
184
data Ip4Network = Ip4Network Ip4Address Word8
185
                  deriving Eq
186

    
187
instance Show Ip4Network where
188
  show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask
189

    
190
-- | JSON instance for 'Ip4Network'.
191
instance JSON Ip4Network where
192
  showJSON = showJSON . show
193
  readJSON (JSString s) =
194
    case sepSplit '/' (fromJSString s) of
195
      [ip, nm] -> do
196
        ip' <- readIp4Address ip
197
        nm' <- tryRead "parsing netmask" nm
198
        if nm' >= 0 && nm' <= 32
199
          then return $ Ip4Network ip' nm'
200
          else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++
201
                      fromJSString s
202
      _ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s
203
  readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network"
204

    
205
-- ** Ganeti \"network\" config object.
206

    
207
-- FIXME: Not all types might be correct here, since they
208
-- haven't been exhaustively deduced from the python code yet.
209
$(buildObject "Network" "network" $
210
  [ simpleField "name"             [t| NonEmptyString |]
211
  , optionalField $
212
    simpleField "mac_prefix"       [t| String |]
213
  , simpleField "network"          [t| Ip4Network |]
214
  , optionalField $
215
    simpleField "network6"         [t| String |]
216
  , optionalField $
217
    simpleField "gateway"          [t| Ip4Address |]
218
  , optionalField $
219
    simpleField "gateway6"         [t| String |]
220
  , optionalField $
221
    simpleField "reservations"     [t| String |]
222
  , optionalField $
223
    simpleField "ext_reservations" [t| String |]
224
  ]
225
  ++ uuidFields
226
  ++ timeStampFields
227
  ++ serialFields
228
  ++ tagsFields)
229

    
230
instance SerialNoObject Network where
231
  serialOf = networkSerial
232

    
233
instance TagsObject Network where
234
  tagsOf = networkTags
235

    
236
instance UuidObject Network where
237
  uuidOf = networkUuid
238

    
239
instance TimeStampObject Network where
240
  cTimeOf = networkCtime
241
  mTimeOf = networkMtime
242

    
243
-- * NIC definitions
244

    
245
$(buildParam "Nic" "nicp"
246
  [ simpleField "mode" [t| NICMode |]
247
  , simpleField "link" [t| String  |]
248
  , simpleField "vlan" [t| String |]
249
  ])
250

    
251
$(buildObject "PartialNic" "nic" $
252
  [ simpleField "mac" [t| String |]
253
  , optionalField $ simpleField "ip" [t| String |]
254
  , simpleField "nicparams" [t| PartialNicParams |]
255
  , optionalField $ simpleField "network" [t| String |]
256
  , optionalField $ simpleField "name" [t| String |]
257
  ] ++ uuidFields)
258

    
259
instance UuidObject PartialNic where
260
  uuidOf = nicUuid
261

    
262
-- * Disk definitions
263

    
264
-- | Constant for the dev_type key entry in the disk config.
265
devType :: String
266
devType = "dev_type"
267

    
268
-- | The disk configuration type. This includes the disk type itself,
269
-- for a more complete consistency. Note that since in the Python
270
-- code-base there's no authoritative place where we document the
271
-- logical id, this is probably a good reference point.
272
data DiskLogicalId
273
  = LIDPlain String String  -- ^ Volume group, logical volume
274
  | LIDDrbd8 String String Int Int Int String
275
  -- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret
276
  | LIDFile FileDriver String -- ^ Driver, path
277
  | LIDSharedFile FileDriver String -- ^ Driver, path
278
  | LIDBlockDev BlockDriver String -- ^ Driver, path (must be under /dev)
279
  | LIDRados String String -- ^ Unused, path
280
  | LIDExt String String -- ^ ExtProvider, unique name
281
    deriving (Show, Eq)
282

    
283
-- | Mapping from a logical id to a disk type.
284
lidDiskType :: DiskLogicalId -> DiskTemplate
285
lidDiskType (LIDPlain {}) = DTPlain
286
lidDiskType (LIDDrbd8 {}) = DTDrbd8
287
lidDiskType (LIDFile  {}) = DTFile
288
lidDiskType (LIDSharedFile  {}) = DTSharedFile
289
lidDiskType (LIDBlockDev {}) = DTBlock
290
lidDiskType (LIDRados {}) = DTRbd
291
lidDiskType (LIDExt {}) = DTExt
292

    
293
-- | Builds the extra disk_type field for a given logical id.
294
lidEncodeType :: DiskLogicalId -> [(String, JSValue)]
295
lidEncodeType v = [(devType, showJSON . lidDiskType $ v)]
296

    
297
-- | Custom encoder for DiskLogicalId (logical id only).
298
encodeDLId :: DiskLogicalId -> JSValue
299
encodeDLId (LIDPlain vg lv) = JSArray [showJSON vg, showJSON lv]
300
encodeDLId (LIDDrbd8 nodeA nodeB port minorA minorB key) =
301
  JSArray [ showJSON nodeA, showJSON nodeB, showJSON port
302
          , showJSON minorA, showJSON minorB, showJSON key ]
303
encodeDLId (LIDRados pool name) = JSArray [showJSON pool, showJSON name]
304
encodeDLId (LIDFile driver name) = JSArray [showJSON driver, showJSON name]
305
encodeDLId (LIDSharedFile driver name) =
306
  JSArray [showJSON driver, showJSON name]
307
encodeDLId (LIDBlockDev driver name) = JSArray [showJSON driver, showJSON name]
308
encodeDLId (LIDExt extprovider name) =
309
  JSArray [showJSON extprovider, showJSON name]
310

    
311
-- | Custom encoder for DiskLogicalId, composing both the logical id
312
-- and the extra disk_type field.
313
encodeFullDLId :: DiskLogicalId -> (JSValue, [(String, JSValue)])
314
encodeFullDLId v = (encodeDLId v, lidEncodeType v)
315

    
316
-- | Custom decoder for DiskLogicalId. This is manual for now, since
317
-- we don't have yet automation for separate-key style fields.
318
decodeDLId :: [(String, JSValue)] -> JSValue -> J.Result DiskLogicalId
319
decodeDLId obj lid = do
320
  dtype <- fromObj obj devType
321
  case dtype of
322
    DTDrbd8 ->
323
      case lid of
324
        JSArray [nA, nB, p, mA, mB, k] -> do
325
          nA' <- readJSON nA
326
          nB' <- readJSON nB
327
          p'  <- readJSON p
328
          mA' <- readJSON mA
329
          mB' <- readJSON mB
330
          k'  <- readJSON k
331
          return $ LIDDrbd8 nA' nB' p' mA' mB' k'
332
        _ -> fail "Can't read logical_id for DRBD8 type"
333
    DTPlain ->
334
      case lid of
335
        JSArray [vg, lv] -> do
336
          vg' <- readJSON vg
337
          lv' <- readJSON lv
338
          return $ LIDPlain vg' lv'
339
        _ -> fail "Can't read logical_id for plain type"
340
    DTFile ->
341
      case lid of
342
        JSArray [driver, path] -> do
343
          driver' <- readJSON driver
344
          path'   <- readJSON path
345
          return $ LIDFile driver' path'
346
        _ -> fail "Can't read logical_id for file type"
347
    DTSharedFile ->
348
      case lid of
349
        JSArray [driver, path] -> do
350
          driver' <- readJSON driver
351
          path'   <- readJSON path
352
          return $ LIDSharedFile driver' path'
353
        _ -> fail "Can't read logical_id for shared file type"
354
    DTBlock ->
355
      case lid of
356
        JSArray [driver, path] -> do
357
          driver' <- readJSON driver
358
          path'   <- readJSON path
359
          return $ LIDBlockDev driver' path'
360
        _ -> fail "Can't read logical_id for blockdev type"
361
    DTRbd ->
362
      case lid of
363
        JSArray [driver, path] -> do
364
          driver' <- readJSON driver
365
          path'   <- readJSON path
366
          return $ LIDRados driver' path'
367
        _ -> fail "Can't read logical_id for rdb type"
368
    DTExt ->
369
      case lid of
370
        JSArray [extprovider, name] -> do
371
          extprovider' <- readJSON extprovider
372
          name'   <- readJSON name
373
          return $ LIDExt extprovider' name'
374
        _ -> fail "Can't read logical_id for extstorage type"
375
    DTDiskless ->
376
      fail "Retrieved 'diskless' disk."
377

    
378
-- | Disk data structure.
379
--
380
-- This is declared manually as it's a recursive structure, and our TH
381
-- code currently can't build it.
382
data Disk = Disk
383
  { diskLogicalId  :: DiskLogicalId
384
  , diskChildren   :: [Disk]
385
  , diskIvName     :: String
386
  , diskSize       :: Int
387
  , diskMode       :: DiskMode
388
  , diskName       :: Maybe String
389
  , diskSpindles   :: Maybe Int
390
  , diskUuid       :: String
391
  } deriving (Show, Eq)
392

    
393
$(buildObjectSerialisation "Disk" $
394
  [ customField 'decodeDLId 'encodeFullDLId ["dev_type"] $
395
      simpleField "logical_id"    [t| DiskLogicalId   |]
396
  , defaultField  [| [] |] $ simpleField "children" [t| [Disk] |]
397
  , defaultField [| "" |] $ simpleField "iv_name" [t| String |]
398
  , simpleField "size" [t| Int |]
399
  , defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |]
400
  , optionalField $ simpleField "name" [t| String |]
401
  , optionalField $ simpleField "spindles" [t| Int |]
402
  ]
403
  ++ uuidFields)
404

    
405
instance UuidObject Disk where
406
  uuidOf = diskUuid
407

    
408
-- | Determines whether a disk or one of his children has the given logical id
409
-- (determined by the volume group name and by the logical volume name).
410
-- This can be true only for DRBD or LVM disks.
411
includesLogicalId :: String -> String -> Disk -> Bool
412
includesLogicalId vg_name lv_name disk =
413
  case diskLogicalId disk of
414
    LIDPlain vg lv -> vg_name == vg && lv_name == lv
415
    LIDDrbd8 {} ->
416
      any (includesLogicalId vg_name lv_name) $ diskChildren disk
417
    _ -> False
418

    
419
-- * Instance definitions
420

    
421
$(buildParam "Be" "bep"
422
  [ simpleField "minmem"       [t| Int  |]
423
  , simpleField "maxmem"       [t| Int  |]
424
  , simpleField "vcpus"        [t| Int  |]
425
  , simpleField "auto_balance" [t| Bool |]
426
  ])
427

    
428
$(buildObject "Instance" "inst" $
429
  [ simpleField "name"           [t| String             |]
430
  , simpleField "primary_node"   [t| String             |]
431
  , simpleField "os"             [t| String             |]
432
  , simpleField "hypervisor"     [t| Hypervisor         |]
433
  , simpleField "hvparams"       [t| HvParams           |]
434
  , simpleField "beparams"       [t| PartialBeParams    |]
435
  , simpleField "osparams"       [t| OsParams           |]
436
  , simpleField "admin_state"    [t| AdminState         |]
437
  , simpleField "nics"           [t| [PartialNic]       |]
438
  , simpleField "disks"          [t| [Disk]             |]
439
  , simpleField "disk_template"  [t| DiskTemplate       |]
440
  , simpleField "disks_active"   [t| Bool               |]
441
  , optionalField $ simpleField "network_port" [t| Int  |]
442
  ]
443
  ++ timeStampFields
444
  ++ uuidFields
445
  ++ serialFields
446
  ++ tagsFields)
447

    
448
instance TimeStampObject Instance where
449
  cTimeOf = instCtime
450
  mTimeOf = instMtime
451

    
452
instance UuidObject Instance where
453
  uuidOf = instUuid
454

    
455
instance SerialNoObject Instance where
456
  serialOf = instSerial
457

    
458
instance TagsObject Instance where
459
  tagsOf = instTags
460

    
461
-- * IPolicy definitions
462

    
463
$(buildParam "ISpec" "ispec"
464
  [ simpleField ConstantUtils.ispecMemSize     [t| Int |]
465
  , simpleField ConstantUtils.ispecDiskSize    [t| Int |]
466
  , simpleField ConstantUtils.ispecDiskCount   [t| Int |]
467
  , simpleField ConstantUtils.ispecCpuCount    [t| Int |]
468
  , simpleField ConstantUtils.ispecNicCount    [t| Int |]
469
  , simpleField ConstantUtils.ispecSpindleUse  [t| Int |]
470
  ])
471

    
472
$(buildObject "MinMaxISpecs" "mmis"
473
  [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |]
474
  , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |]
475
  ])
476

    
477
-- | Custom partial ipolicy. This is not built via buildParam since it
478
-- has a special 2-level inheritance mode.
479
$(buildObject "PartialIPolicy" "ipolicy"
480
  [ optionalField . renameField "MinMaxISpecsP" $
481
    simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
482
  , optionalField . renameField "StdSpecP" $
483
    simpleField "std" [t| PartialISpecParams |]
484
  , optionalField . renameField "SpindleRatioP" $
485
    simpleField "spindle-ratio" [t| Double |]
486
  , optionalField . renameField "VcpuRatioP" $
487
    simpleField "vcpu-ratio" [t| Double |]
488
  , optionalField . renameField "DiskTemplatesP" $
489
    simpleField "disk-templates" [t| [DiskTemplate] |]
490
  ])
491

    
492
-- | Custom filled ipolicy. This is not built via buildParam since it
493
-- has a special 2-level inheritance mode.
494
$(buildObject "FilledIPolicy" "ipolicy"
495
  [ renameField "MinMaxISpecs" $
496
    simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
497
  , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
498
  , simpleField "spindle-ratio"  [t| Double |]
499
  , simpleField "vcpu-ratio"     [t| Double |]
500
  , simpleField "disk-templates" [t| [DiskTemplate] |]
501
  ])
502

    
503
-- | Custom filler for the ipolicy types.
504
fillIPolicy :: FilledIPolicy -> PartialIPolicy -> FilledIPolicy
505
fillIPolicy (FilledIPolicy { ipolicyMinMaxISpecs  = fminmax
506
                           , ipolicyStdSpec       = fstd
507
                           , ipolicySpindleRatio  = fspindleRatio
508
                           , ipolicyVcpuRatio     = fvcpuRatio
509
                           , ipolicyDiskTemplates = fdiskTemplates})
510
            (PartialIPolicy { ipolicyMinMaxISpecsP  = pminmax
511
                            , ipolicyStdSpecP       = pstd
512
                            , ipolicySpindleRatioP  = pspindleRatio
513
                            , ipolicyVcpuRatioP     = pvcpuRatio
514
                            , ipolicyDiskTemplatesP = pdiskTemplates}) =
515
  FilledIPolicy { ipolicyMinMaxISpecs  = fromMaybe fminmax pminmax
516
                , ipolicyStdSpec       = case pstd of
517
                                         Nothing -> fstd
518
                                         Just p -> fillISpecParams fstd p
519
                , ipolicySpindleRatio  = fromMaybe fspindleRatio pspindleRatio
520
                , ipolicyVcpuRatio     = fromMaybe fvcpuRatio pvcpuRatio
521
                , ipolicyDiskTemplates = fromMaybe fdiskTemplates
522
                                         pdiskTemplates
523
                }
524
-- * Node definitions
525

    
526
$(buildParam "ND" "ndp"
527
  [ simpleField "oob_program"   [t| String |]
528
  , simpleField "spindle_count" [t| Int    |]
529
  , simpleField "exclusive_storage" [t| Bool |]
530
  , simpleField "ovs"           [t| Bool |]
531
  , simpleField "ovs_name"       [t| String |]
532
  , simpleField "ovs_link"       [t| String |]
533
  ])
534

    
535
$(buildObject "Node" "node" $
536
  [ simpleField "name"             [t| String |]
537
  , simpleField "primary_ip"       [t| String |]
538
  , simpleField "secondary_ip"     [t| String |]
539
  , simpleField "master_candidate" [t| Bool   |]
540
  , simpleField "offline"          [t| Bool   |]
541
  , simpleField "drained"          [t| Bool   |]
542
  , simpleField "group"            [t| String |]
543
  , simpleField "master_capable"   [t| Bool   |]
544
  , simpleField "vm_capable"       [t| Bool   |]
545
  , simpleField "ndparams"         [t| PartialNDParams |]
546
  , simpleField "powered"          [t| Bool   |]
547
  ]
548
  ++ timeStampFields
549
  ++ uuidFields
550
  ++ serialFields
551
  ++ tagsFields)
552

    
553
instance TimeStampObject Node where
554
  cTimeOf = nodeCtime
555
  mTimeOf = nodeMtime
556

    
557
instance UuidObject Node where
558
  uuidOf = nodeUuid
559

    
560
instance SerialNoObject Node where
561
  serialOf = nodeSerial
562

    
563
instance TagsObject Node where
564
  tagsOf = nodeTags
565

    
566
-- * NodeGroup definitions
567

    
568
-- | The disk parameters type.
569
type DiskParams = Container (Container JSValue)
570

    
571
-- | A mapping from network UUIDs to nic params of the networks.
572
type Networks = Container PartialNicParams
573

    
574
$(buildObject "NodeGroup" "group" $
575
  [ simpleField "name"         [t| String |]
576
  , defaultField [| [] |] $ simpleField "members" [t| [String] |]
577
  , simpleField "ndparams"     [t| PartialNDParams |]
578
  , simpleField "alloc_policy" [t| AllocPolicy     |]
579
  , simpleField "ipolicy"      [t| PartialIPolicy  |]
580
  , simpleField "diskparams"   [t| DiskParams      |]
581
  , simpleField "networks"     [t| Networks        |]
582
  ]
583
  ++ timeStampFields
584
  ++ uuidFields
585
  ++ serialFields
586
  ++ tagsFields)
587

    
588
instance TimeStampObject NodeGroup where
589
  cTimeOf = groupCtime
590
  mTimeOf = groupMtime
591

    
592
instance UuidObject NodeGroup where
593
  uuidOf = groupUuid
594

    
595
instance SerialNoObject NodeGroup where
596
  serialOf = groupSerial
597

    
598
instance TagsObject NodeGroup where
599
  tagsOf = groupTags
600

    
601
-- | IP family type
602
$(declareIADT "IpFamily"
603
  [ ("IpFamilyV4", 'AutoConf.pyAfInet4)
604
  , ("IpFamilyV6", 'AutoConf.pyAfInet6)
605
  ])
606
$(makeJSONInstance ''IpFamily)
607

    
608
-- | Conversion from IP family to IP version. This is needed because
609
-- Python uses both, depending on context.
610
ipFamilyToVersion :: IpFamily -> Int
611
ipFamilyToVersion IpFamilyV4 = C.ip4Version
612
ipFamilyToVersion IpFamilyV6 = C.ip6Version
613

    
614
-- | Cluster HvParams (hvtype to hvparams mapping).
615
type ClusterHvParams = Container HvParams
616

    
617
-- | Cluster Os-HvParams (os to hvparams mapping).
618
type OsHvParams = Container ClusterHvParams
619

    
620
-- | Cluser BeParams.
621
type ClusterBeParams = Container FilledBeParams
622

    
623
-- | Cluster OsParams.
624
type ClusterOsParams = Container OsParams
625

    
626
-- | Cluster NicParams.
627
type ClusterNicParams = Container FilledNicParams
628

    
629
-- | Cluster UID Pool, list (low, high) UID ranges.
630
type UidPool = [(Int, Int)]
631

    
632
-- * Cluster definitions
633
$(buildObject "Cluster" "cluster" $
634
  [ simpleField "rsahostkeypub"           [t| String           |]
635
  , optionalField $
636
    simpleField "dsahostkeypub"           [t| String           |]
637
  , simpleField "highest_used_port"       [t| Int              |]
638
  , simpleField "tcpudp_port_pool"        [t| [Int]            |]
639
  , simpleField "mac_prefix"              [t| String           |]
640
  , optionalField $
641
    simpleField "volume_group_name"       [t| String           |]
642
  , simpleField "reserved_lvs"            [t| [String]         |]
643
  , optionalField $
644
    simpleField "drbd_usermode_helper"    [t| String           |]
645
  , simpleField "master_node"             [t| String           |]
646
  , simpleField "master_ip"               [t| String           |]
647
  , simpleField "master_netdev"           [t| String           |]
648
  , simpleField "master_netmask"          [t| Int              |]
649
  , simpleField "use_external_mip_script" [t| Bool             |]
650
  , simpleField "cluster_name"            [t| String           |]
651
  , simpleField "file_storage_dir"        [t| String           |]
652
  , simpleField "shared_file_storage_dir" [t| String           |]
653
  , simpleField "enabled_hypervisors"     [t| [Hypervisor]     |]
654
  , simpleField "hvparams"                [t| ClusterHvParams  |]
655
  , simpleField "os_hvp"                  [t| OsHvParams       |]
656
  , simpleField "beparams"                [t| ClusterBeParams  |]
657
  , simpleField "osparams"                [t| ClusterOsParams  |]
658
  , simpleField "nicparams"               [t| ClusterNicParams |]
659
  , simpleField "ndparams"                [t| FilledNDParams   |]
660
  , simpleField "diskparams"              [t| DiskParams       |]
661
  , simpleField "candidate_pool_size"     [t| Int              |]
662
  , simpleField "modify_etc_hosts"        [t| Bool             |]
663
  , simpleField "modify_ssh_setup"        [t| Bool             |]
664
  , simpleField "maintain_node_health"    [t| Bool             |]
665
  , simpleField "uid_pool"                [t| UidPool          |]
666
  , simpleField "default_iallocator"      [t| String           |]
667
  , simpleField "hidden_os"               [t| [String]         |]
668
  , simpleField "blacklisted_os"          [t| [String]         |]
669
  , simpleField "primary_ip_family"       [t| IpFamily         |]
670
  , simpleField "prealloc_wipe_disks"     [t| Bool             |]
671
  , simpleField "ipolicy"                 [t| FilledIPolicy    |]
672
  , simpleField "enabled_disk_templates"  [t| [DiskTemplate]   |]
673
 ]
674
 ++ timeStampFields
675
 ++ uuidFields
676
 ++ serialFields
677
 ++ tagsFields)
678

    
679
instance TimeStampObject Cluster where
680
  cTimeOf = clusterCtime
681
  mTimeOf = clusterMtime
682

    
683
instance UuidObject Cluster where
684
  uuidOf = clusterUuid
685

    
686
instance SerialNoObject Cluster where
687
  serialOf = clusterSerial
688

    
689
instance TagsObject Cluster where
690
  tagsOf = clusterTags
691

    
692
-- * ConfigData definitions
693

    
694
$(buildObject "ConfigData" "config" $
695
--  timeStampFields ++
696
  [ simpleField "version"    [t| Int                 |]
697
  , simpleField "cluster"    [t| Cluster             |]
698
  , simpleField "nodes"      [t| Container Node      |]
699
  , simpleField "nodegroups" [t| Container NodeGroup |]
700
  , simpleField "instances"  [t| Container Instance  |]
701
  , simpleField "networks"   [t| Container Network   |]
702
  ]
703
  ++ serialFields)
704

    
705
instance SerialNoObject ConfigData where
706
  serialOf = configSerial