-}
module Ganeti.Objects
- ( VType(..)
- , vTypeFromRaw
- , HvParams
+ ( HvParams
, OsParams
, PartialNicParams(..)
, FilledNicParams(..)
, allNicParamFields
, PartialNic(..)
, FileDriver(..)
- , BlockDriver(..)
- , DiskMode(..)
- , DiskType(..)
, DiskLogicalId(..)
, Disk(..)
, includesLogicalId
, FilledBeParams(..)
, fillBeParams
, allBeParamFields
- , AdminState(..)
- , adminStateFromRaw
, Instance(..)
, toDictInstance
, PartialNDParams(..)
, fillNDParams
, allNDParamFields
, Node(..)
- , NodeRole(..)
- , nodeRoleToRaw
- , roleDescription
, AllocPolicy(..)
, FilledISpecParams(..)
, PartialISpecParams(..)
import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
import qualified Text.JSON as J
+import qualified AutoConf
import qualified Ganeti.Constants as C
+import qualified Ganeti.ConstantUtils as ConstantUtils
import Ganeti.JSON
import Ganeti.Types
import Ganeti.THH
let updated = Map.union custom defaults
in foldl' (flip Map.delete) updated skip_keys
--- | The VTYPES, a mini-type system in Python.
-$(declareSADT "VType"
- [ ("VTypeString", 'C.vtypeString)
- , ("VTypeMaybeString", 'C.vtypeMaybeString)
- , ("VTypeBool", 'C.vtypeBool)
- , ("VTypeSize", 'C.vtypeSize)
- , ("VTypeInt", 'C.vtypeInt)
- ])
-$(makeJSONInstance ''VType)
-
-- | The hypervisor parameter type. This is currently a simple map,
-- without type checking on key/value pairs.
type HvParams = Container JSValue
class TagsObject a where
tagsOf :: a -> Set.Set String
--- * Node role object
-
-$(declareSADT "NodeRole"
- [ ("NROffline", 'C.nrOffline)
- , ("NRDrained", 'C.nrDrained)
- , ("NRRegular", 'C.nrRegular)
- , ("NRCandidate", 'C.nrMcandidate)
- , ("NRMaster", 'C.nrMaster)
- ])
-$(makeJSONInstance ''NodeRole)
-
--- | The description of the node role.
-roleDescription :: NodeRole -> String
-roleDescription NROffline = "offline"
-roleDescription NRDrained = "drained"
-roleDescription NRRegular = "regular"
-roleDescription NRCandidate = "master candidate"
-roleDescription NRMaster = "master"
-
-- * Network definitions
-- ** Ipv4 types
simpleField "ext_reservations" [t| String |]
]
++ uuidFields
+ ++ timeStampFields
++ serialFields
++ tagsFields)
instance UuidObject Network where
uuidOf = networkUuid
+instance TimeStampObject Network where
+ cTimeOf = networkCtime
+ mTimeOf = networkMtime
+
-- * NIC definitions
$(buildParam "Nic" "nicp"
[ simpleField "mode" [t| NICMode |]
, simpleField "link" [t| String |]
+ , simpleField "vlan" [t| String |]
])
$(buildObject "PartialNic" "nic" $
-- * Disk definitions
-$(declareSADT "DiskMode"
- [ ("DiskRdOnly", 'C.diskRdonly)
- , ("DiskRdWr", 'C.diskRdwr)
- ])
-$(makeJSONInstance ''DiskMode)
-
-$(declareSADT "DiskType"
- [ ("LD_LV", 'C.ldLv)
- , ("LD_DRBD8", 'C.ldDrbd8)
- , ("LD_FILE", 'C.ldFile)
- , ("LD_BLOCKDEV", 'C.ldBlockdev)
- , ("LD_RADOS", 'C.ldRbd)
- , ("LD_EXT", 'C.ldExt)
- ])
-$(makeJSONInstance ''DiskType)
-
--- | The persistent block driver type. Currently only one type is allowed.
-$(declareSADT "BlockDriver"
- [ ("BlockDrvManual", 'C.blockdevDriverManual)
- ])
-$(makeJSONInstance ''BlockDriver)
-
-- | Constant for the dev_type key entry in the disk config.
devType :: String
devType = "dev_type"
| LIDDrbd8 String String Int Int Int String
-- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret
| LIDFile FileDriver String -- ^ Driver, path
+ | LIDSharedFile FileDriver String -- ^ Driver, path
| LIDBlockDev BlockDriver String -- ^ Driver, path (must be under /dev)
| LIDRados String String -- ^ Unused, path
| LIDExt String String -- ^ ExtProvider, unique name
deriving (Show, Eq)
-- | Mapping from a logical id to a disk type.
-lidDiskType :: DiskLogicalId -> DiskType
-lidDiskType (LIDPlain {}) = LD_LV
-lidDiskType (LIDDrbd8 {}) = LD_DRBD8
-lidDiskType (LIDFile {}) = LD_FILE
-lidDiskType (LIDBlockDev {}) = LD_BLOCKDEV
-lidDiskType (LIDRados {}) = LD_RADOS
-lidDiskType (LIDExt {}) = LD_EXT
+lidDiskType :: DiskLogicalId -> DiskTemplate
+lidDiskType (LIDPlain {}) = DTPlain
+lidDiskType (LIDDrbd8 {}) = DTDrbd8
+lidDiskType (LIDFile {}) = DTFile
+lidDiskType (LIDSharedFile {}) = DTSharedFile
+lidDiskType (LIDBlockDev {}) = DTBlock
+lidDiskType (LIDRados {}) = DTRbd
+lidDiskType (LIDExt {}) = DTExt
-- | Builds the extra disk_type field for a given logical id.
lidEncodeType :: DiskLogicalId -> [(String, JSValue)]
, showJSON minorA, showJSON minorB, showJSON key ]
encodeDLId (LIDRados pool name) = JSArray [showJSON pool, showJSON name]
encodeDLId (LIDFile driver name) = JSArray [showJSON driver, showJSON name]
+encodeDLId (LIDSharedFile driver name) =
+ JSArray [showJSON driver, showJSON name]
encodeDLId (LIDBlockDev driver name) = JSArray [showJSON driver, showJSON name]
encodeDLId (LIDExt extprovider name) =
JSArray [showJSON extprovider, showJSON name]
decodeDLId obj lid = do
dtype <- fromObj obj devType
case dtype of
- LD_DRBD8 ->
+ DTDrbd8 ->
case lid of
JSArray [nA, nB, p, mA, mB, k] -> do
nA' <- readJSON nA
k' <- readJSON k
return $ LIDDrbd8 nA' nB' p' mA' mB' k'
_ -> fail "Can't read logical_id for DRBD8 type"
- LD_LV ->
+ DTPlain ->
case lid of
JSArray [vg, lv] -> do
vg' <- readJSON vg
lv' <- readJSON lv
return $ LIDPlain vg' lv'
_ -> fail "Can't read logical_id for plain type"
- LD_FILE ->
+ DTFile ->
case lid of
JSArray [driver, path] -> do
driver' <- readJSON driver
path' <- readJSON path
return $ LIDFile driver' path'
_ -> fail "Can't read logical_id for file type"
- LD_BLOCKDEV ->
+ DTSharedFile ->
+ case lid of
+ JSArray [driver, path] -> do
+ driver' <- readJSON driver
+ path' <- readJSON path
+ return $ LIDSharedFile driver' path'
+ _ -> fail "Can't read logical_id for shared file type"
+ DTBlock ->
case lid of
JSArray [driver, path] -> do
driver' <- readJSON driver
path' <- readJSON path
return $ LIDBlockDev driver' path'
_ -> fail "Can't read logical_id for blockdev type"
- LD_RADOS ->
+ DTRbd ->
case lid of
JSArray [driver, path] -> do
driver' <- readJSON driver
path' <- readJSON path
return $ LIDRados driver' path'
_ -> fail "Can't read logical_id for rdb type"
- LD_EXT ->
+ DTExt ->
case lid of
JSArray [extprovider, name] -> do
extprovider' <- readJSON extprovider
name' <- readJSON name
return $ LIDExt extprovider' name'
_ -> fail "Can't read logical_id for extstorage type"
+ DTDiskless ->
+ fail "Retrieved 'diskless' disk."
-- | Disk data structure.
--
-- code currently can't build it.
data Disk = Disk
{ diskLogicalId :: DiskLogicalId
--- , diskPhysicalId :: String
, diskChildren :: [Disk]
, diskIvName :: String
, diskSize :: Int
$(buildObjectSerialisation "Disk" $
[ customField 'decodeDLId 'encodeFullDLId ["dev_type"] $
simpleField "logical_id" [t| DiskLogicalId |]
--- , simpleField "physical_id" [t| String |]
, defaultField [| [] |] $ simpleField "children" [t| [Disk] |]
, defaultField [| "" |] $ simpleField "iv_name" [t| String |]
, simpleField "size" [t| Int |]
any (includesLogicalId vg_name lv_name) $ diskChildren disk
_ -> False
-
-- * Instance definitions
-$(declareSADT "AdminState"
- [ ("AdminOffline", 'C.adminstOffline)
- , ("AdminDown", 'C.adminstDown)
- , ("AdminUp", 'C.adminstUp)
- ])
-$(makeJSONInstance ''AdminState)
-
$(buildParam "Be" "bep"
[ simpleField "minmem" [t| Int |]
, simpleField "maxmem" [t| Int |]
-- * IPolicy definitions
$(buildParam "ISpec" "ispec"
- [ simpleField C.ispecMemSize [t| Int |]
- , simpleField C.ispecDiskSize [t| Int |]
- , simpleField C.ispecDiskCount [t| Int |]
- , simpleField C.ispecCpuCount [t| Int |]
- , simpleField C.ispecNicCount [t| Int |]
- , simpleField C.ispecSpindleUse [t| Int |]
+ [ simpleField ConstantUtils.ispecMemSize [t| Int |]
+ , simpleField ConstantUtils.ispecDiskSize [t| Int |]
+ , simpleField ConstantUtils.ispecDiskCount [t| Int |]
+ , simpleField ConstantUtils.ispecCpuCount [t| Int |]
+ , simpleField ConstantUtils.ispecNicCount [t| Int |]
+ , simpleField ConstantUtils.ispecSpindleUse [t| Int |]
])
$(buildObject "MinMaxISpecs" "mmis"
-- | Custom partial ipolicy. This is not built via buildParam since it
-- has a special 2-level inheritance mode.
$(buildObject "PartialIPolicy" "ipolicy"
- [ optionalField . renameField "MinMaxISpecsP"
- $ simpleField C.ispecsMinmax [t| [MinMaxISpecs] |]
- , optionalField . renameField "StdSpecP"
- $ simpleField "std" [t| PartialISpecParams |]
- , optionalField . renameField "SpindleRatioP"
- $ simpleField "spindle-ratio" [t| Double |]
- , optionalField . renameField "VcpuRatioP"
- $ simpleField "vcpu-ratio" [t| Double |]
- , optionalField . renameField "DiskTemplatesP"
- $ simpleField "disk-templates" [t| [DiskTemplate] |]
+ [ optionalField . renameField "MinMaxISpecsP" $
+ simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
+ , optionalField . renameField "StdSpecP" $
+ simpleField "std" [t| PartialISpecParams |]
+ , optionalField . renameField "SpindleRatioP" $
+ simpleField "spindle-ratio" [t| Double |]
+ , optionalField . renameField "VcpuRatioP" $
+ simpleField "vcpu-ratio" [t| Double |]
+ , optionalField . renameField "DiskTemplatesP" $
+ simpleField "disk-templates" [t| [DiskTemplate] |]
])
-- | Custom filled ipolicy. This is not built via buildParam since it
-- has a special 2-level inheritance mode.
$(buildObject "FilledIPolicy" "ipolicy"
- [ renameField "MinMaxISpecs"
- $ simpleField C.ispecsMinmax [t| [MinMaxISpecs] |]
+ [ renameField "MinMaxISpecs" $
+ simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
, renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
, simpleField "spindle-ratio" [t| Double |]
, simpleField "vcpu-ratio" [t| Double |]
[ simpleField "oob_program" [t| String |]
, simpleField "spindle_count" [t| Int |]
, simpleField "exclusive_storage" [t| Bool |]
+ , simpleField "ovs" [t| Bool |]
+ , simpleField "ovs_name" [t| String |]
+ , simpleField "ovs_link" [t| String |]
])
$(buildObject "Node" "node" $
-- | IP family type
$(declareIADT "IpFamily"
- [ ("IpFamilyV4", 'C.ip4Family)
- , ("IpFamilyV6", 'C.ip6Family)
+ [ ("IpFamilyV4", 'AutoConf.pyAfInet4)
+ , ("IpFamilyV6", 'AutoConf.pyAfInet6)
])
$(makeJSONInstance ''IpFamily)
-- * Cluster definitions
$(buildObject "Cluster" "cluster" $
[ simpleField "rsahostkeypub" [t| String |]
+ , optionalField $
+ simpleField "dsahostkeypub" [t| String |]
, simpleField "highest_used_port" [t| Int |]
, simpleField "tcpudp_port_pool" [t| [Int] |]
, simpleField "mac_prefix" [t| String |]