Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Objects.hs @ b9202225

History | View | Annotate | Download (25.3 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
  , getDiskSizeRequirements
51
  , PartialNDParams(..)
52
  , FilledNDParams(..)
53
  , fillNDParams
54
  , allNDParamFields
55
  , Node(..)
56
  , AllocPolicy(..)
57
  , FilledISpecParams(..)
58
  , PartialISpecParams(..)
59
  , fillISpecParams
60
  , allISpecParamFields
61
  , MinMaxISpecs(..)
62
  , FilledIPolicy(..)
63
  , PartialIPolicy(..)
64
  , fillIPolicy
65
  , DiskParams
66
  , NodeGroup(..)
67
  , IpFamily(..)
68
  , ipFamilyToVersion
69
  , fillDict
70
  , ClusterHvParams
71
  , OsHvParams
72
  , ClusterBeParams
73
  , ClusterOsParams
74
  , ClusterNicParams
75
  , Cluster(..)
76
  , ConfigData(..)
77
  , TimeStampObject(..)
78
  , UuidObject(..)
79
  , SerialNoObject(..)
80
  , TagsObject(..)
81
  , DictObject(..) -- re-exported from THH
82
  , TagSet -- re-exported from THH
83
  , Network(..)
84
  , Ip4Address(..)
85
  , Ip4Network(..)
86
  , readIp4Address
87
  , nextIp4Address
88
  , IAllocatorParams
89
  ) where
90

    
91
import Control.Applicative
92
import Data.List (foldl')
93
import Data.Maybe
94
import qualified Data.Map as Map
95
import qualified Data.Set as Set
96
import Data.Word
97
import System.Time (ClockTime(..))
98
import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
99
import qualified Text.JSON as J
100

    
101
import qualified AutoConf
102
import qualified Ganeti.Constants as C
103
import qualified Ganeti.ConstantUtils as ConstantUtils
104
import Ganeti.JSON
105
import Ganeti.Types
106
import Ganeti.THH
107
import Ganeti.Utils (sepSplit, tryRead, parseUnitAssumeBinary)
108

    
109
-- * Generic definitions
110

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

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

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

    
127
-- | Class of objects that have timestamps.
128
class TimeStampObject a where
129
  cTimeOf :: a -> ClockTime
130
  mTimeOf :: a -> ClockTime
131

    
132
-- | Class of objects that have an UUID.
133
class UuidObject a where
134
  uuidOf :: a -> String
135

    
136
-- | Class of object that have a serial number.
137
class SerialNoObject a where
138
  serialOf :: a -> Int
139

    
140
-- | Class of objects that have tags.
141
class TagsObject a where
142
  tagsOf :: a -> Set.Set String
143

    
144
-- * Network definitions
145

    
146
-- ** Ipv4 types
147

    
148
-- | Custom type for a simple IPv4 address.
149
data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
150
                  deriving Eq
151

    
152
instance Show Ip4Address where
153
  show (Ip4Address a b c d) = show a ++ "." ++ show b ++ "." ++
154
                              show c ++ "." ++ show d
155

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

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

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

    
186
-- | Custom type for an IPv4 network.
187
data Ip4Network = Ip4Network Ip4Address Word8
188
                  deriving Eq
189

    
190
instance Show Ip4Network where
191
  show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask
192

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

    
208
-- ** Ganeti \"network\" config object.
209

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

    
233
instance SerialNoObject Network where
234
  serialOf = networkSerial
235

    
236
instance TagsObject Network where
237
  tagsOf = networkTags
238

    
239
instance UuidObject Network where
240
  uuidOf = networkUuid
241

    
242
instance TimeStampObject Network where
243
  cTimeOf = networkCtime
244
  mTimeOf = networkMtime
245

    
246
-- * NIC definitions
247

    
248
$(buildParam "Nic" "nicp"
249
  [ simpleField "mode" [t| NICMode |]
250
  , simpleField "link" [t| String  |]
251
  , simpleField "vlan" [t| String |]
252
  ])
253

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

    
262
instance UuidObject PartialNic where
263
  uuidOf = nicUuid
264

    
265
-- * Disk definitions
266

    
267
-- | Constant for the dev_type key entry in the disk config.
268
devType :: String
269
devType = "dev_type"
270

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

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

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

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

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

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

    
388
-- | Disk data structure.
389
--
390
-- This is declared manually as it's a recursive structure, and our TH
391
-- code currently can't build it.
392
data Disk = Disk
393
  { diskLogicalId  :: DiskLogicalId
394
  , diskChildren   :: [Disk]
395
  , diskIvName     :: String
396
  , diskSize       :: Int
397
  , diskMode       :: DiskMode
398
  , diskName       :: Maybe String
399
  , diskSpindles   :: Maybe Int
400
  , diskUuid       :: String
401
  } deriving (Show, Eq)
402

    
403
$(buildObjectSerialisation "Disk" $
404
  [ customField 'decodeDLId 'encodeFullDLId ["dev_type"] $
405
      simpleField "logical_id"    [t| DiskLogicalId   |]
406
  , defaultField  [| [] |] $ simpleField "children" [t| [Disk] |]
407
  , defaultField [| "" |] $ simpleField "iv_name" [t| String |]
408
  , simpleField "size" [t| Int |]
409
  , defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |]
410
  , optionalField $ simpleField "name" [t| String |]
411
  , optionalField $ simpleField "spindles" [t| Int |]
412
  ]
413
  ++ uuidFields)
414

    
415
instance UuidObject Disk where
416
  uuidOf = diskUuid
417

    
418
-- | Determines whether a disk or one of his children has the given logical id
419
-- (determined by the volume group name and by the logical volume name).
420
-- This can be true only for DRBD or LVM disks.
421
includesLogicalId :: String -> String -> Disk -> Bool
422
includesLogicalId vg_name lv_name disk =
423
  case diskLogicalId disk of
424
    LIDPlain vg lv -> vg_name == vg && lv_name == lv
425
    LIDDrbd8 {} ->
426
      any (includesLogicalId vg_name lv_name) $ diskChildren disk
427
    _ -> False
428

    
429
-- * Instance definitions
430

    
431
$(buildParam "Be" "bep"
432
  [ specialNumericalField 'parseUnitAssumeBinary
433
      $ simpleField "minmem"      [t| Int  |]
434
  , specialNumericalField 'parseUnitAssumeBinary
435
      $ simpleField "maxmem"      [t| Int  |]
436
  , simpleField "vcpus"           [t| Int  |]
437
  , simpleField "auto_balance"    [t| Bool |]
438
  , simpleField "always_failover" [t| Bool |]
439
  , simpleField "spindle_use"     [t| Int  |]
440
  ])
441

    
442
$(buildObject "Instance" "inst" $
443
  [ simpleField "name"           [t| String             |]
444
  , simpleField "primary_node"   [t| String             |]
445
  , simpleField "os"             [t| String             |]
446
  , simpleField "hypervisor"     [t| Hypervisor         |]
447
  , simpleField "hvparams"       [t| HvParams           |]
448
  , simpleField "beparams"       [t| PartialBeParams    |]
449
  , simpleField "osparams"       [t| OsParams           |]
450
  , simpleField "admin_state"    [t| AdminState         |]
451
  , simpleField "nics"           [t| [PartialNic]       |]
452
  , simpleField "disks"          [t| [Disk]             |]
453
  , simpleField "disk_template"  [t| DiskTemplate       |]
454
  , simpleField "disks_active"   [t| Bool               |]
455
  , optionalField $ simpleField "network_port" [t| Int  |]
456
  ]
457
  ++ timeStampFields
458
  ++ uuidFields
459
  ++ serialFields
460
  ++ tagsFields)
461

    
462
instance TimeStampObject Instance where
463
  cTimeOf = instCtime
464
  mTimeOf = instMtime
465

    
466
instance UuidObject Instance where
467
  uuidOf = instUuid
468

    
469
instance SerialNoObject Instance where
470
  serialOf = instSerial
471

    
472
instance TagsObject Instance where
473
  tagsOf = instTags
474

    
475
-- | Retrieves the real disk size requirements for all the disks of the
476
-- instance. This includes the metadata etc. and is different from the values
477
-- visible to the instance.
478
getDiskSizeRequirements :: Instance -> Int
479
getDiskSizeRequirements inst =
480
  sum . map
481
    (\disk -> case instDiskTemplate inst of
482
                DTDrbd8    -> diskSize disk + C.drbdMetaSize
483
                DTDiskless -> 0
484
                DTBlock    -> 0
485
                _          -> diskSize disk )
486
    $ instDisks inst
487

    
488
-- * IPolicy definitions
489

    
490
$(buildParam "ISpec" "ispec"
491
  [ simpleField ConstantUtils.ispecMemSize     [t| Int |]
492
  , simpleField ConstantUtils.ispecDiskSize    [t| Int |]
493
  , simpleField ConstantUtils.ispecDiskCount   [t| Int |]
494
  , simpleField ConstantUtils.ispecCpuCount    [t| Int |]
495
  , simpleField ConstantUtils.ispecNicCount    [t| Int |]
496
  , simpleField ConstantUtils.ispecSpindleUse  [t| Int |]
497
  ])
498

    
499
$(buildObject "MinMaxISpecs" "mmis"
500
  [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |]
501
  , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |]
502
  ])
503

    
504
-- | Custom partial ipolicy. This is not built via buildParam since it
505
-- has a special 2-level inheritance mode.
506
$(buildObject "PartialIPolicy" "ipolicy"
507
  [ optionalField . renameField "MinMaxISpecsP" $
508
    simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
509
  , optionalField . renameField "StdSpecP" $
510
    simpleField "std" [t| PartialISpecParams |]
511
  , optionalField . renameField "SpindleRatioP" $
512
    simpleField "spindle-ratio" [t| Double |]
513
  , optionalField . renameField "VcpuRatioP" $
514
    simpleField "vcpu-ratio" [t| Double |]
515
  , optionalField . renameField "DiskTemplatesP" $
516
    simpleField "disk-templates" [t| [DiskTemplate] |]
517
  ])
518

    
519
-- | Custom filled ipolicy. This is not built via buildParam since it
520
-- has a special 2-level inheritance mode.
521
$(buildObject "FilledIPolicy" "ipolicy"
522
  [ renameField "MinMaxISpecs" $
523
    simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
524
  , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
525
  , simpleField "spindle-ratio"  [t| Double |]
526
  , simpleField "vcpu-ratio"     [t| Double |]
527
  , simpleField "disk-templates" [t| [DiskTemplate] |]
528
  ])
529

    
530
-- | Custom filler for the ipolicy types.
531
fillIPolicy :: FilledIPolicy -> PartialIPolicy -> FilledIPolicy
532
fillIPolicy (FilledIPolicy { ipolicyMinMaxISpecs  = fminmax
533
                           , ipolicyStdSpec       = fstd
534
                           , ipolicySpindleRatio  = fspindleRatio
535
                           , ipolicyVcpuRatio     = fvcpuRatio
536
                           , ipolicyDiskTemplates = fdiskTemplates})
537
            (PartialIPolicy { ipolicyMinMaxISpecsP  = pminmax
538
                            , ipolicyStdSpecP       = pstd
539
                            , ipolicySpindleRatioP  = pspindleRatio
540
                            , ipolicyVcpuRatioP     = pvcpuRatio
541
                            , ipolicyDiskTemplatesP = pdiskTemplates}) =
542
  FilledIPolicy { ipolicyMinMaxISpecs  = fromMaybe fminmax pminmax
543
                , ipolicyStdSpec       = case pstd of
544
                                         Nothing -> fstd
545
                                         Just p -> fillISpecParams fstd p
546
                , ipolicySpindleRatio  = fromMaybe fspindleRatio pspindleRatio
547
                , ipolicyVcpuRatio     = fromMaybe fvcpuRatio pvcpuRatio
548
                , ipolicyDiskTemplates = fromMaybe fdiskTemplates
549
                                         pdiskTemplates
550
                }
551
-- * Node definitions
552

    
553
$(buildParam "ND" "ndp"
554
  [ simpleField "oob_program"   [t| String |]
555
  , simpleField "spindle_count" [t| Int    |]
556
  , simpleField "exclusive_storage" [t| Bool |]
557
  , simpleField "ovs"           [t| Bool |]
558
  , simpleField "ovs_name"       [t| String |]
559
  , simpleField "ovs_link"       [t| String |]
560
  , simpleField "ssh_port"      [t| Int |]
561
  ])
562

    
563
$(buildObject "Node" "node" $
564
  [ simpleField "name"             [t| String |]
565
  , simpleField "primary_ip"       [t| String |]
566
  , simpleField "secondary_ip"     [t| String |]
567
  , simpleField "master_candidate" [t| Bool   |]
568
  , simpleField "offline"          [t| Bool   |]
569
  , simpleField "drained"          [t| Bool   |]
570
  , simpleField "group"            [t| String |]
571
  , simpleField "master_capable"   [t| Bool   |]
572
  , simpleField "vm_capable"       [t| Bool   |]
573
  , simpleField "ndparams"         [t| PartialNDParams |]
574
  , simpleField "powered"          [t| Bool   |]
575
  ]
576
  ++ timeStampFields
577
  ++ uuidFields
578
  ++ serialFields
579
  ++ tagsFields)
580

    
581
instance TimeStampObject Node where
582
  cTimeOf = nodeCtime
583
  mTimeOf = nodeMtime
584

    
585
instance UuidObject Node where
586
  uuidOf = nodeUuid
587

    
588
instance SerialNoObject Node where
589
  serialOf = nodeSerial
590

    
591
instance TagsObject Node where
592
  tagsOf = nodeTags
593

    
594
-- * NodeGroup definitions
595

    
596
-- | The disk parameters type.
597
type DiskParams = Container (Container JSValue)
598

    
599
-- | A mapping from network UUIDs to nic params of the networks.
600
type Networks = Container PartialNicParams
601

    
602
$(buildObject "NodeGroup" "group" $
603
  [ simpleField "name"         [t| String |]
604
  , defaultField [| [] |] $ simpleField "members" [t| [String] |]
605
  , simpleField "ndparams"     [t| PartialNDParams |]
606
  , simpleField "alloc_policy" [t| AllocPolicy     |]
607
  , simpleField "ipolicy"      [t| PartialIPolicy  |]
608
  , simpleField "diskparams"   [t| DiskParams      |]
609
  , simpleField "networks"     [t| Networks        |]
610
  ]
611
  ++ timeStampFields
612
  ++ uuidFields
613
  ++ serialFields
614
  ++ tagsFields)
615

    
616
instance TimeStampObject NodeGroup where
617
  cTimeOf = groupCtime
618
  mTimeOf = groupMtime
619

    
620
instance UuidObject NodeGroup where
621
  uuidOf = groupUuid
622

    
623
instance SerialNoObject NodeGroup where
624
  serialOf = groupSerial
625

    
626
instance TagsObject NodeGroup where
627
  tagsOf = groupTags
628

    
629
-- | IP family type
630
$(declareIADT "IpFamily"
631
  [ ("IpFamilyV4", 'AutoConf.pyAfInet4)
632
  , ("IpFamilyV6", 'AutoConf.pyAfInet6)
633
  ])
634
$(makeJSONInstance ''IpFamily)
635

    
636
-- | Conversion from IP family to IP version. This is needed because
637
-- Python uses both, depending on context.
638
ipFamilyToVersion :: IpFamily -> Int
639
ipFamilyToVersion IpFamilyV4 = C.ip4Version
640
ipFamilyToVersion IpFamilyV6 = C.ip6Version
641

    
642
-- | Cluster HvParams (hvtype to hvparams mapping).
643
type ClusterHvParams = Container HvParams
644

    
645
-- | Cluster Os-HvParams (os to hvparams mapping).
646
type OsHvParams = Container ClusterHvParams
647

    
648
-- | Cluser BeParams.
649
type ClusterBeParams = Container FilledBeParams
650

    
651
-- | Cluster OsParams.
652
type ClusterOsParams = Container OsParams
653

    
654
-- | Cluster NicParams.
655
type ClusterNicParams = Container FilledNicParams
656

    
657
-- | Cluster UID Pool, list (low, high) UID ranges.
658
type UidPool = [(Int, Int)]
659

    
660
-- | The iallocator parameters type.
661
type IAllocatorParams = Container JSValue
662

    
663
-- | The master candidate client certificate digests
664
type CandidateCertificates = Container String
665

    
666
-- * Cluster definitions
667
$(buildObject "Cluster" "cluster" $
668
  [ simpleField "rsahostkeypub"             [t| String           |]
669
  , optionalField $
670
    simpleField "dsahostkeypub"             [t| String           |]
671
  , simpleField "highest_used_port"         [t| Int              |]
672
  , simpleField "tcpudp_port_pool"          [t| [Int]            |]
673
  , simpleField "mac_prefix"                [t| String           |]
674
  , optionalField $
675
    simpleField "volume_group_name"         [t| String           |]
676
  , simpleField "reserved_lvs"              [t| [String]         |]
677
  , optionalField $
678
    simpleField "drbd_usermode_helper"      [t| String           |]
679
  , simpleField "master_node"               [t| String           |]
680
  , simpleField "master_ip"                 [t| String           |]
681
  , simpleField "master_netdev"             [t| String           |]
682
  , simpleField "master_netmask"            [t| Int              |]
683
  , simpleField "use_external_mip_script"   [t| Bool             |]
684
  , simpleField "cluster_name"              [t| String           |]
685
  , simpleField "file_storage_dir"          [t| String           |]
686
  , simpleField "shared_file_storage_dir"   [t| String           |]
687
  , simpleField "gluster_storage_dir"       [t| String           |]
688
  , simpleField "enabled_hypervisors"       [t| [Hypervisor]     |]
689
  , simpleField "hvparams"                  [t| ClusterHvParams  |]
690
  , simpleField "os_hvp"                    [t| OsHvParams       |]
691
  , simpleField "beparams"                  [t| ClusterBeParams  |]
692
  , simpleField "osparams"                  [t| ClusterOsParams  |]
693
  , simpleField "nicparams"                 [t| ClusterNicParams |]
694
  , simpleField "ndparams"                  [t| FilledNDParams   |]
695
  , simpleField "diskparams"                [t| DiskParams       |]
696
  , simpleField "candidate_pool_size"       [t| Int              |]
697
  , simpleField "modify_etc_hosts"          [t| Bool             |]
698
  , simpleField "modify_ssh_setup"          [t| Bool             |]
699
  , simpleField "maintain_node_health"      [t| Bool             |]
700
  , simpleField "uid_pool"                  [t| UidPool          |]
701
  , simpleField "default_iallocator"        [t| String           |]
702
  , simpleField "default_iallocator_params" [t| IAllocatorParams |]
703
  , simpleField "hidden_os"                 [t| [String]         |]
704
  , simpleField "blacklisted_os"            [t| [String]         |]
705
  , simpleField "primary_ip_family"         [t| IpFamily         |]
706
  , simpleField "prealloc_wipe_disks"       [t| Bool             |]
707
  , simpleField "ipolicy"                   [t| FilledIPolicy    |]
708
  , simpleField "enabled_disk_templates"    [t| [DiskTemplate]   |]
709
  , simpleField "candidate_certs"           [t| CandidateCertificates |]
710
  , simpleField "max_running_jobs"          [t| Int              |]
711
 ]
712
 ++ timeStampFields
713
 ++ uuidFields
714
 ++ serialFields
715
 ++ tagsFields)
716

    
717
instance TimeStampObject Cluster where
718
  cTimeOf = clusterCtime
719
  mTimeOf = clusterMtime
720

    
721
instance UuidObject Cluster where
722
  uuidOf = clusterUuid
723

    
724
instance SerialNoObject Cluster where
725
  serialOf = clusterSerial
726

    
727
instance TagsObject Cluster where
728
  tagsOf = clusterTags
729

    
730
-- * ConfigData definitions
731

    
732
$(buildObject "ConfigData" "config" $
733
--  timeStampFields ++
734
  [ simpleField "version"    [t| Int                 |]
735
  , simpleField "cluster"    [t| Cluster             |]
736
  , simpleField "nodes"      [t| Container Node      |]
737
  , simpleField "nodegroups" [t| Container NodeGroup |]
738
  , simpleField "instances"  [t| Container Instance  |]
739
  , simpleField "networks"   [t| Container Network   |]
740
  ]
741
  ++ serialFields)
742

    
743
instance SerialNoObject ConfigData where
744
  serialOf = configSerial