code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Objects.hs

   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   ( VType(..)
  33   , vTypeFromRaw
  34   , HvParams
  35   , OsParams
  36   , PartialNicParams(..)
  37   , FilledNicParams(..)
  38   , fillNicParams
  39   , allNicParamFields
  40   , PartialNic(..)
  41   , FileDriver(..)
  42   , BlockDriver(..)
  43   , DiskMode(..)
  44   , DiskType(..)
  45   , DiskLogicalId(..)
  46   , Disk(..)
  47   , DiskTemplate(..)
  48   , PartialBeParams(..)
  49   , FilledBeParams(..)
  50   , fillBeParams
  51   , allBeParamFields
  52   , AdminState(..)
  53   , adminStateFromRaw
  54   , Instance(..)
  55   , toDictInstance
  56   , PartialNDParams(..)
  57   , FilledNDParams(..)
  58   , fillNDParams
  59   , allNDParamFields
  60   , Node(..)
  61   , NodeRole(..)
  62   , nodeRoleToRaw
  63   , roleDescription
  64   , AllocPolicy(..)
  65   , FilledISpecParams(..)
  66   , PartialISpecParams(..)
  67   , fillISpecParams
  68   , allISpecParamFields
  69   , MinMaxISpecs(..)
  70   , FilledIPolicy(..)
  71   , PartialIPolicy(..)
  72   , fillIPolicy
  73   , DiskParams
  74   , NodeGroup(..)
  75   , IpFamily(..)
  76   , ipFamilyToVersion
  77   , fillDict
  78   , ClusterHvParams
  79   , OsHvParams
  80   , ClusterBeParams
  81   , ClusterOsParams
  82   , ClusterNicParams
  83   , Cluster(..)
  84   , ConfigData(..)
  85   , TimeStampObject(..)
  86   , UuidObject(..)
  87   , SerialNoObject(..)
  88   , TagsObject(..)
  89   , DictObject(..) -- re-exported from THH
  90   , TagSet -- re-exported from THH
  91   , Network(..)
  92   , Ip4Address(..)
  93   , Ip4Network(..)
  94   , readIp4Address
  95   , nextIp4Address
  96   ) where
  97
  98 import Control.Applicative
  99 import Data.List (foldl')
 100 import Data.Maybe
 101 import qualified Data.Map as Map
 102 import qualified Data.Set as Set
 103 import Data.Word
 104 import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
 105 import qualified Text.JSON as J
 106
 107 import qualified Ganeti.Constants as C
 108 import Ganeti.JSON
 109 import Ganeti.Types
 110 import Ganeti.THH
 111 import Ganeti.Utils (sepSplit, tryRead)
 112
 113 -- * Generic definitions
 114
 115 -- | Fills one map with keys from the other map, if not already
 116 -- existing. Mirrors objects.py:FillDict.
 117 fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v
 118 fillDict defaults custom skip_keys =
 119   let updated = Map.union custom defaults
 120   in foldl' (flip Map.delete) updated skip_keys
 121
 122 -- | The VTYPES, a mini-type system in Python.
 123 $(declareSADT "VType"
 124   [ ("VTypeString",      'C.vtypeString)
 125   , ("VTypeMaybeString", 'C.vtypeMaybeString)
 126   , ("VTypeBool",        'C.vtypeBool)
 127   , ("VTypeSize",        'C.vtypeSize)
 128   , ("VTypeInt",         'C.vtypeInt)
 129   ])
 130 $(makeJSONInstance ''VType)
 131
 132 -- | The hypervisor parameter type. This is currently a simple map,
 133 -- without type checking on key/value pairs.
 134 type HvParams = Container JSValue
 135
 136 -- | The OS parameters type. This is, and will remain, a string
 137 -- container, since the keys are dynamically declared by the OSes, and
 138 -- the values are always strings.
 139 type OsParams = Container String
 140
 141 -- | Class of objects that have timestamps.
 142 class TimeStampObject a where
 143   cTimeOf :: a -> Double
 144   mTimeOf :: a -> Double
 145
 146 -- | Class of objects that have an UUID.
 147 class UuidObject a where
 148   uuidOf :: a -> String
 149
 150 -- | Class of object that have a serial number.
 151 class SerialNoObject a where
 152   serialOf :: a -> Int
 153
 154 -- | Class of objects that have tags.
 155 class TagsObject a where
 156   tagsOf :: a -> Set.Set String
 157
 158 -- * Node role object
 159
 160 $(declareSADT "NodeRole"
 161   [ ("NROffline",   'C.nrOffline)
 162   , ("NRDrained",   'C.nrDrained)
 163   , ("NRRegular",   'C.nrRegular)
 164   , ("NRCandidate", 'C.nrMcandidate)
 165   , ("NRMaster",    'C.nrMaster)
 166   ])
 167 $(makeJSONInstance ''NodeRole)
 168
 169 -- | The description of the node role.
 170 roleDescription :: NodeRole -> String
 171 roleDescription NROffline   = "offline"
 172 roleDescription NRDrained   = "drained"
 173 roleDescription NRRegular   = "regular"
 174 roleDescription NRCandidate = "master candidate"
 175 roleDescription NRMaster    = "master"
 176
 177 -- * Network definitions
 178
 179 -- ** Ipv4 types
 180
 181 -- | Custom type for a simple IPv4 address.
 182 data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
 183                   deriving Eq
 184
 185 instance Show Ip4Address where
 186   show (Ip4Address a b c d) = show a ++ "." ++ show b ++ "." ++
 187                               show c ++ "." ++ show d
 188
 189 -- | Parses an IPv4 address from a string.
 190 readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address
 191 readIp4Address s =
 192   case sepSplit '.' s of
 193     [a, b, c, d] -> Ip4Address <$>
 194                       tryRead "first octect" a <*>
 195                       tryRead "second octet" b <*>
 196                       tryRead "third octet"  c <*>
 197                       tryRead "fourth octet" d
 198     _ -> fail $ "Can't parse IPv4 address from string " ++ s
 199
 200 -- | JSON instance for 'Ip4Address'.
 201 instance JSON Ip4Address where
 202   showJSON = showJSON . show
 203   readJSON (JSString s) = readIp4Address (fromJSString s)
 204   readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address"
 205
 206 -- | \"Next\" address implementation for IPv4 addresses.
 207 --
 208 -- Note that this loops! Note also that this is a very dumb
 209 -- implementation.
 210 nextIp4Address :: Ip4Address -> Ip4Address
 211 nextIp4Address (Ip4Address a b c d) =
 212   let inc xs y = if all (==0) xs then y + 1 else y
 213       d' = d + 1
 214       c' = inc [d'] c
 215       b' = inc [c', d'] b
 216       a' = inc [b', c', d'] a
 217   in Ip4Address a' b' c' d'
 218
 219 -- | Custom type for an IPv4 network.
 220 data Ip4Network = Ip4Network Ip4Address Word8
 221                   deriving Eq
 222
 223 instance Show Ip4Network where
 224   show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask
 225
 226 -- | JSON instance for 'Ip4Network'.
 227 instance JSON Ip4Network where
 228   showJSON = showJSON . show
 229   readJSON (JSString s) =
 230     case sepSplit '/' (fromJSString s) of
 231       [ip, nm] -> do
 232         ip' <- readIp4Address ip
 233         nm' <- tryRead "parsing netmask" nm
 234         if nm' >= 0 && nm' <= 32
 235           then return $ Ip4Network ip' nm'
 236           else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++
 237                       fromJSString s
 238       _ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s
 239   readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network"
 240
 241 -- ** Ganeti \"network\" config object.
 242
 243 -- FIXME: Not all types might be correct here, since they
 244 -- haven't been exhaustively deduced from the python code yet.
 245 $(buildObject "Network" "network" $
 246   [ simpleField "name"             [t| NonEmptyString |]
 247   , optionalField $
 248     simpleField "mac_prefix"       [t| String |]
 249   , simpleField "network"          [t| Ip4Network |]
 250   , optionalField $
 251     simpleField "network6"         [t| String |]
 252   , optionalField $
 253     simpleField "gateway"          [t| Ip4Address |]
 254   , optionalField $
 255     simpleField "gateway6"         [t| String |]
 256   , optionalField $
 257     simpleField "reservations"     [t| String |]
 258   , optionalField $
 259     simpleField "ext_reservations" [t| String |]
 260   ]
 261   ++ uuidFields
 262   ++ serialFields
 263   ++ tagsFields)
 264
 265 instance SerialNoObject Network where
 266   serialOf = networkSerial
 267
 268 instance TagsObject Network where
 269   tagsOf = networkTags
 270
 271 instance UuidObject Network where
 272   uuidOf = networkUuid
 273
 274 -- * NIC definitions
 275
 276 $(buildParam "Nic" "nicp"
 277   [ simpleField "mode" [t| NICMode |]
 278   , simpleField "link" [t| String  |]
 279   ])
 280
 281 $(buildObject "PartialNic" "nic" $
 282   [ simpleField "mac" [t| String |]
 283   , optionalField $ simpleField "ip" [t| String |]
 284   , simpleField "nicparams" [t| PartialNicParams |]
 285   , optionalField $ simpleField "network" [t| String |]
 286   , optionalField $ simpleField "name" [t| String |]
 287   ] ++ uuidFields)
 288
 289 instance UuidObject PartialNic where
 290   uuidOf = nicUuid
 291
 292 -- * Disk definitions
 293
 294 $(declareSADT "DiskMode"
 295   [ ("DiskRdOnly", 'C.diskRdonly)
 296   , ("DiskRdWr",   'C.diskRdwr)
 297   ])
 298 $(makeJSONInstance ''DiskMode)
 299
 300 $(declareSADT "DiskType"
 301   [ ("LD_LV",       'C.ldLv)
 302   , ("LD_DRBD8",    'C.ldDrbd8)
 303   , ("LD_FILE",     'C.ldFile)
 304   , ("LD_BLOCKDEV", 'C.ldBlockdev)
 305   , ("LD_RADOS",    'C.ldRbd)
 306   , ("LD_EXT",      'C.ldExt)
 307   ])
 308 $(makeJSONInstance ''DiskType)
 309
 310 -- | The persistent block driver type. Currently only one type is allowed.
 311 $(declareSADT "BlockDriver"
 312   [ ("BlockDrvManual", 'C.blockdevDriverManual)
 313   ])
 314 $(makeJSONInstance ''BlockDriver)
 315
 316 -- | Constant for the dev_type key entry in the disk config.
 317 devType :: String
 318 devType = "dev_type"
 319
 320 -- | The disk configuration type. This includes the disk type itself,
 321 -- for a more complete consistency. Note that since in the Python
 322 -- code-base there's no authoritative place where we document the
 323 -- logical id, this is probably a good reference point.
 324 data DiskLogicalId
 325   = LIDPlain String String  -- ^ Volume group, logical volume
 326   | LIDDrbd8 String String Int Int Int String
 327   -- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret
 328   | LIDFile FileDriver String -- ^ Driver, path
 329   | LIDBlockDev BlockDriver String -- ^ Driver, path (must be under /dev)
 330   | LIDRados String String -- ^ Unused, path
 331   | LIDExt String String -- ^ ExtProvider, unique name
 332     deriving (Show, Eq)
 333
 334 -- | Mapping from a logical id to a disk type.
 335 lidDiskType :: DiskLogicalId -> DiskType
 336 lidDiskType (LIDPlain {}) = LD_LV
 337 lidDiskType (LIDDrbd8 {}) = LD_DRBD8
 338 lidDiskType (LIDFile  {}) = LD_FILE
 339 lidDiskType (LIDBlockDev {}) = LD_BLOCKDEV
 340 lidDiskType (LIDRados {}) = LD_RADOS
 341 lidDiskType (LIDExt {}) = LD_EXT
 342
 343 -- | Builds the extra disk_type field for a given logical id.
 344 lidEncodeType :: DiskLogicalId -> [(String, JSValue)]
 345 lidEncodeType v = [(devType, showJSON . lidDiskType $ v)]
 346
 347 -- | Custom encoder for DiskLogicalId (logical id only).
 348 encodeDLId :: DiskLogicalId -> JSValue
 349 encodeDLId (LIDPlain vg lv) = JSArray [showJSON vg, showJSON lv]
 350 encodeDLId (LIDDrbd8 nodeA nodeB port minorA minorB key) =
 351   JSArray [ showJSON nodeA, showJSON nodeB, showJSON port
 352           , showJSON minorA, showJSON minorB, showJSON key ]
 353 encodeDLId (LIDRados pool name) = JSArray [showJSON pool, showJSON name]
 354 encodeDLId (LIDFile driver name) = JSArray [showJSON driver, showJSON name]
 355 encodeDLId (LIDBlockDev driver name) = JSArray [showJSON driver, showJSON name]
 356 encodeDLId (LIDExt extprovider name) =
 357   JSArray [showJSON extprovider, showJSON name]
 358
 359 -- | Custom encoder for DiskLogicalId, composing both the logical id
 360 -- and the extra disk_type field.
 361 encodeFullDLId :: DiskLogicalId -> (JSValue, [(String, JSValue)])
 362 encodeFullDLId v = (encodeDLId v, lidEncodeType v)
 363
 364 -- | Custom decoder for DiskLogicalId. This is manual for now, since
 365 -- we don't have yet automation for separate-key style fields.
 366 decodeDLId :: [(String, JSValue)] -> JSValue -> J.Result DiskLogicalId
 367 decodeDLId obj lid = do
 368   dtype <- fromObj obj devType
 369   case dtype of
 370     LD_DRBD8 ->
 371       case lid of
 372         JSArray [nA, nB, p, mA, mB, k] -> do
 373           nA' <- readJSON nA
 374           nB' <- readJSON nB
 375           p'  <- readJSON p
 376           mA' <- readJSON mA
 377           mB' <- readJSON mB
 378           k'  <- readJSON k
 379           return $ LIDDrbd8 nA' nB' p' mA' mB' k'
 380         _ -> fail "Can't read logical_id for DRBD8 type"
 381     LD_LV ->
 382       case lid of
 383         JSArray [vg, lv] -> do
 384           vg' <- readJSON vg
 385           lv' <- readJSON lv
 386           return $ LIDPlain vg' lv'
 387         _ -> fail "Can't read logical_id for plain type"
 388     LD_FILE ->
 389       case lid of
 390         JSArray [driver, path] -> do
 391           driver' <- readJSON driver
 392           path'   <- readJSON path
 393           return $ LIDFile driver' path'
 394         _ -> fail "Can't read logical_id for file type"
 395     LD_BLOCKDEV ->
 396       case lid of
 397         JSArray [driver, path] -> do
 398           driver' <- readJSON driver
 399           path'   <- readJSON path
 400           return $ LIDBlockDev driver' path'
 401         _ -> fail "Can't read logical_id for blockdev type"
 402     LD_RADOS ->
 403       case lid of
 404         JSArray [driver, path] -> do
 405           driver' <- readJSON driver
 406           path'   <- readJSON path
 407           return $ LIDRados driver' path'
 408         _ -> fail "Can't read logical_id for rdb type"
 409     LD_EXT ->
 410       case lid of
 411         JSArray [extprovider, name] -> do
 412           extprovider' <- readJSON extprovider
 413           name'   <- readJSON name
 414           return $ LIDExt extprovider' name'
 415         _ -> fail "Can't read logical_id for extstorage type"
 416
 417 -- | Disk data structure.
 418 --
 419 -- This is declared manually as it's a recursive structure, and our TH
 420 -- code currently can't build it.
 421 data Disk = Disk
 422   { diskLogicalId  :: DiskLogicalId
 423 --  , diskPhysicalId :: String
 424   , diskChildren   :: [Disk]
 425   , diskIvName     :: String
 426   , diskSize       :: Int
 427   , diskMode       :: DiskMode
 428   , diskName       :: Maybe String
 429   , diskSpindles   :: Maybe Int
 430   , diskUuid       :: String
 431   } deriving (Show, Eq)
 432
 433 $(buildObjectSerialisation "Disk" $
 434   [ customField 'decodeDLId 'encodeFullDLId ["dev_type"] $
 435       simpleField "logical_id"    [t| DiskLogicalId   |]
 436 --  , simpleField "physical_id" [t| String   |]
 437   , defaultField  [| [] |] $ simpleField "children" [t| [Disk] |]
 438   , defaultField [| "" |] $ simpleField "iv_name" [t| String |]
 439   , simpleField "size" [t| Int |]
 440   , defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |]
 441   , optionalField $ simpleField "name" [t| String |]
 442   , optionalField $ simpleField "spindles" [t| Int |]
 443   ]
 444   ++ uuidFields)
 445
 446 instance UuidObject Disk where
 447   uuidOf = diskUuid
 448
 449 -- * Instance definitions
 450
 451 $(declareSADT "AdminState"
 452   [ ("AdminOffline", 'C.adminstOffline)
 453   , ("AdminDown",    'C.adminstDown)
 454   , ("AdminUp",      'C.adminstUp)
 455   ])
 456 $(makeJSONInstance ''AdminState)
 457
 458 $(buildParam "Be" "bep"
 459   [ simpleField "minmem"       [t| Int  |]
 460   , simpleField "maxmem"       [t| Int  |]
 461   , simpleField "vcpus"        [t| Int  |]
 462   , simpleField "auto_balance" [t| Bool |]
 463   ])
 464
 465 $(buildObject "Instance" "inst" $
 466   [ simpleField "name"           [t| String             |]
 467   , simpleField "primary_node"   [t| String             |]
 468   , simpleField "os"             [t| String             |]
 469   , simpleField "hypervisor"     [t| Hypervisor         |]
 470   , simpleField "hvparams"       [t| HvParams           |]
 471   , simpleField "beparams"       [t| PartialBeParams    |]
 472   , simpleField "osparams"       [t| OsParams           |]
 473   , simpleField "admin_state"    [t| AdminState         |]
 474   , simpleField "nics"           [t| [PartialNic]       |]
 475   , simpleField "disks"          [t| [Disk]             |]
 476   , simpleField "disk_template"  [t| DiskTemplate       |]
 477   , simpleField "disks_active"   [t| Bool               |]
 478   , optionalField $ simpleField "network_port" [t| Int  |]
 479   ]
 480   ++ timeStampFields
 481   ++ uuidFields
 482   ++ serialFields
 483   ++ tagsFields)
 484
 485 instance TimeStampObject Instance where
 486   cTimeOf = instCtime
 487   mTimeOf = instMtime
 488
 489 instance UuidObject Instance where
 490   uuidOf = instUuid
 491
 492 instance SerialNoObject Instance where
 493   serialOf = instSerial
 494
 495 instance TagsObject Instance where
 496   tagsOf = instTags
 497
 498 -- * IPolicy definitions
 499
 500 $(buildParam "ISpec" "ispec"
 501   [ simpleField C.ispecMemSize     [t| Int |]
 502   , simpleField C.ispecDiskSize    [t| Int |]
 503   , simpleField C.ispecDiskCount   [t| Int |]
 504   , simpleField C.ispecCpuCount    [t| Int |]
 505   , simpleField C.ispecNicCount    [t| Int |]
 506   , simpleField C.ispecSpindleUse  [t| Int |]
 507   ])
 508
 509 $(buildObject "MinMaxISpecs" "mmis"
 510   [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |]
 511   , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |]
 512   ])
 513
 514 -- | Custom partial ipolicy. This is not built via buildParam since it
 515 -- has a special 2-level inheritance mode.
 516 $(buildObject "PartialIPolicy" "ipolicy"
 517   [ optionalField . renameField "MinMaxISpecsP"
 518                     $ simpleField C.ispecsMinmax   [t| [MinMaxISpecs] |]
 519   , optionalField . renameField "StdSpecP"
 520                     $ simpleField "std"            [t| PartialISpecParams |]
 521   , optionalField . renameField "SpindleRatioP"
 522                     $ simpleField "spindle-ratio"  [t| Double |]
 523   , optionalField . renameField "VcpuRatioP"
 524                     $ simpleField "vcpu-ratio"     [t| Double |]
 525   , optionalField . renameField "DiskTemplatesP"
 526                     $ simpleField "disk-templates" [t| [DiskTemplate] |]
 527   ])
 528
 529 -- | Custom filled ipolicy. This is not built via buildParam since it
 530 -- has a special 2-level inheritance mode.
 531 $(buildObject "FilledIPolicy" "ipolicy"
 532   [ renameField "MinMaxISpecs"
 533     $ simpleField C.ispecsMinmax [t| [MinMaxISpecs] |]
 534   , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
 535   , simpleField "spindle-ratio"  [t| Double |]
 536   , simpleField "vcpu-ratio"     [t| Double |]
 537   , simpleField "disk-templates" [t| [DiskTemplate] |]
 538   ])
 539
 540 -- | Custom filler for the ipolicy types.
 541 fillIPolicy :: FilledIPolicy -> PartialIPolicy -> FilledIPolicy
 542 fillIPolicy (FilledIPolicy { ipolicyMinMaxISpecs  = fminmax
 543                            , ipolicyStdSpec       = fstd
 544                            , ipolicySpindleRatio  = fspindleRatio
 545                            , ipolicyVcpuRatio     = fvcpuRatio
 546                            , ipolicyDiskTemplates = fdiskTemplates})
 547             (PartialIPolicy { ipolicyMinMaxISpecsP  = pminmax
 548                             , ipolicyStdSpecP       = pstd
 549                             , ipolicySpindleRatioP  = pspindleRatio
 550                             , ipolicyVcpuRatioP     = pvcpuRatio
 551                             , ipolicyDiskTemplatesP = pdiskTemplates}) =
 552   FilledIPolicy { ipolicyMinMaxISpecs  = fromMaybe fminmax pminmax
 553                 , ipolicyStdSpec       = case pstd of
 554                                          Nothing -> fstd
 555                                          Just p -> fillISpecParams fstd p
 556                 , ipolicySpindleRatio  = fromMaybe fspindleRatio pspindleRatio
 557                 , ipolicyVcpuRatio     = fromMaybe fvcpuRatio pvcpuRatio
 558                 , ipolicyDiskTemplates = fromMaybe fdiskTemplates
 559                                          pdiskTemplates
 560                 }
 561 -- * Node definitions
 562
 563 $(buildParam "ND" "ndp"
 564   [ simpleField "oob_program"   [t| String |]
 565   , simpleField "spindle_count" [t| Int    |]
 566   , simpleField "exclusive_storage" [t| Bool |]
 567   ])
 568
 569 $(buildObject "Node" "node" $
 570   [ simpleField "name"             [t| String |]
 571   , simpleField "primary_ip"       [t| String |]
 572   , simpleField "secondary_ip"     [t| String |]
 573   , simpleField "master_candidate" [t| Bool   |]
 574   , simpleField "offline"          [t| Bool   |]
 575   , simpleField "drained"          [t| Bool   |]
 576   , simpleField "group"            [t| String |]
 577   , simpleField "master_capable"   [t| Bool   |]
 578   , simpleField "vm_capable"       [t| Bool   |]
 579   , simpleField "ndparams"         [t| PartialNDParams |]
 580   , simpleField "powered"          [t| Bool   |]
 581   ]
 582   ++ timeStampFields
 583   ++ uuidFields
 584   ++ serialFields
 585   ++ tagsFields)
 586
 587 instance TimeStampObject Node where
 588   cTimeOf = nodeCtime
 589   mTimeOf = nodeMtime
 590
 591 instance UuidObject Node where
 592   uuidOf = nodeUuid
 593
 594 instance SerialNoObject Node where
 595   serialOf = nodeSerial
 596
 597 instance TagsObject Node where
 598   tagsOf = nodeTags
 599
 600 -- * NodeGroup definitions
 601
 602 -- | The disk parameters type.
 603 type DiskParams = Container (Container JSValue)
 604
 605 -- | A mapping from network UUIDs to nic params of the networks.
 606 type Networks = Container PartialNicParams
 607
 608 $(buildObject "NodeGroup" "group" $
 609   [ simpleField "name"         [t| String |]
 610   , defaultField [| [] |] $ simpleField "members" [t| [String] |]
 611   , simpleField "ndparams"     [t| PartialNDParams |]
 612   , simpleField "alloc_policy" [t| AllocPolicy     |]
 613   , simpleField "ipolicy"      [t| PartialIPolicy  |]
 614   , simpleField "diskparams"   [t| DiskParams      |]
 615   , simpleField "networks"     [t| Networks        |]
 616   ]
 617   ++ timeStampFields
 618   ++ uuidFields
 619   ++ serialFields
 620   ++ tagsFields)
 621
 622 instance TimeStampObject NodeGroup where
 623   cTimeOf = groupCtime
 624   mTimeOf = groupMtime
 625
 626 instance UuidObject NodeGroup where
 627   uuidOf = groupUuid
 628
 629 instance SerialNoObject NodeGroup where
 630   serialOf = groupSerial
 631
 632 instance TagsObject NodeGroup where
 633   tagsOf = groupTags
 634
 635 -- | IP family type
 636 $(declareIADT "IpFamily"
 637   [ ("IpFamilyV4", 'C.ip4Family)
 638   , ("IpFamilyV6", 'C.ip6Family)
 639   ])
 640 $(makeJSONInstance ''IpFamily)
 641
 642 -- | Conversion from IP family to IP version. This is needed because
 643 -- Python uses both, depending on context.
 644 ipFamilyToVersion :: IpFamily -> Int
 645 ipFamilyToVersion IpFamilyV4 = C.ip4Version
 646 ipFamilyToVersion IpFamilyV6 = C.ip6Version
 647
 648 -- | Cluster HvParams (hvtype to hvparams mapping).
 649 type ClusterHvParams = Container HvParams
 650
 651 -- | Cluster Os-HvParams (os to hvparams mapping).
 652 type OsHvParams = Container ClusterHvParams
 653
 654 -- | Cluser BeParams.
 655 type ClusterBeParams = Container FilledBeParams
 656
 657 -- | Cluster OsParams.
 658 type ClusterOsParams = Container OsParams
 659
 660 -- | Cluster NicParams.
 661 type ClusterNicParams = Container FilledNicParams
 662
 663 -- | Cluster UID Pool, list (low, high) UID ranges.
 664 type UidPool = [(Int, Int)]
 665
 666 -- * Cluster definitions
 667 $(buildObject "Cluster" "cluster" $
 668   [ simpleField "rsahostkeypub"           [t| String           |]
 669   , simpleField "highest_used_port"       [t| Int              |]
 670   , simpleField "tcpudp_port_pool"        [t| [Int]            |]
 671   , simpleField "mac_prefix"              [t| String           |]
 672   , optionalField $
 673     simpleField "volume_group_name"       [t| String           |]
 674   , simpleField "reserved_lvs"            [t| [String]         |]
 675   , optionalField $
 676     simpleField "drbd_usermode_helper"    [t| String           |]
 677   , simpleField "master_node"             [t| String           |]
 678   , simpleField "master_ip"               [t| String           |]
 679   , simpleField "master_netdev"           [t| String           |]
 680   , simpleField "master_netmask"          [t| Int              |]
 681   , simpleField "use_external_mip_script" [t| Bool             |]
 682   , simpleField "cluster_name"            [t| String           |]
 683   , simpleField "file_storage_dir"        [t| String           |]
 684   , simpleField "shared_file_storage_dir" [t| String           |]
 685   , simpleField "enabled_hypervisors"     [t| [Hypervisor]     |]
 686   , simpleField "hvparams"                [t| ClusterHvParams  |]
 687   , simpleField "os_hvp"                  [t| OsHvParams       |]
 688   , simpleField "beparams"                [t| ClusterBeParams  |]
 689   , simpleField "osparams"                [t| ClusterOsParams  |]
 690   , simpleField "nicparams"               [t| ClusterNicParams |]
 691   , simpleField "ndparams"                [t| FilledNDParams   |]
 692   , simpleField "diskparams"              [t| DiskParams       |]
 693   , simpleField "candidate_pool_size"     [t| Int              |]
 694   , simpleField "modify_etc_hosts"        [t| Bool             |]
 695   , simpleField "modify_ssh_setup"        [t| Bool             |]
 696   , simpleField "maintain_node_health"    [t| Bool             |]
 697   , simpleField "uid_pool"                [t| UidPool          |]
 698   , simpleField "default_iallocator"      [t| String           |]
 699   , simpleField "hidden_os"               [t| [String]         |]
 700   , simpleField "blacklisted_os"          [t| [String]         |]
 701   , simpleField "primary_ip_family"       [t| IpFamily         |]
 702   , simpleField "prealloc_wipe_disks"     [t| Bool             |]
 703   , simpleField "ipolicy"                 [t| FilledIPolicy    |]
 704   , simpleField "enabled_disk_templates"  [t| [DiskTemplate]   |]
 705  ]
 706  ++ timeStampFields
 707  ++ uuidFields
 708  ++ serialFields
 709  ++ tagsFields)
 710
 711 instance TimeStampObject Cluster where
 712   cTimeOf = clusterCtime
 713   mTimeOf = clusterMtime
 714
 715 instance UuidObject Cluster where
 716   uuidOf = clusterUuid
 717
 718 instance SerialNoObject Cluster where
 719   serialOf = clusterSerial
 720
 721 instance TagsObject Cluster where
 722   tagsOf = clusterTags
 723
 724 -- * ConfigData definitions
 725
 726 $(buildObject "ConfigData" "config" $
 727 --  timeStampFields ++
 728   [ simpleField "version"    [t| Int                 |]
 729   , simpleField "cluster"    [t| Cluster             |]
 730   , simpleField "nodes"      [t| Container Node      |]
 731   , simpleField "nodegroups" [t| Container NodeGroup |]
 732   , simpleField "instances"  [t| Container Instance  |]
 733   , simpleField "networks"   [t| Container Network   |]
 734   ]
 735   ++ serialFields)
 736
 737 instance SerialNoObject ConfigData where
 738   serialOf = configSerial