projects / ganeti-local / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge branch 'stable-2.9' into stable-2.10
[ganeti-local] / src / Ganeti / Objects.hs
diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs
index 021a860..5b49713 100644 (file)
--- a/src/Ganeti/Objects.hs
+++ b/src/Ganeti/Objects.hs
@@ -29,9 +29,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 -}
 
 module Ganeti.Objects
 -}
 
 module Ganeti.Objects
-  ( VType(..)
-  , vTypeFromRaw
-  , HvParams
+  ( HvParams
   , OsParams
   , PartialNicParams(..)
   , FilledNicParams(..)
   , OsParams
   , PartialNicParams(..)
   , FilledNicParams(..)
@@ -39,9 +37,6 @@ module Ganeti.Objects
   , allNicParamFields
   , PartialNic(..)
   , FileDriver(..)
   , allNicParamFields
   , PartialNic(..)
   , FileDriver(..)
-  , BlockDriver(..)
-  , DiskMode(..)
-  , DiskType(..)
   , DiskLogicalId(..)
   , Disk(..)
   , includesLogicalId
   , DiskLogicalId(..)
   , Disk(..)
   , includesLogicalId
@@ -50,8 +45,6 @@ module Ganeti.Objects
   , FilledBeParams(..)
   , fillBeParams
   , allBeParamFields
   , FilledBeParams(..)
   , fillBeParams
   , allBeParamFields
-  , AdminState(..)
-  , adminStateFromRaw
   , Instance(..)
   , toDictInstance
   , PartialNDParams(..)
   , Instance(..)
   , toDictInstance
   , PartialNDParams(..)
@@ -59,9 +52,6 @@ module Ganeti.Objects
   , fillNDParams
   , allNDParamFields
   , Node(..)
   , fillNDParams
   , allNDParamFields
   , Node(..)
-  , NodeRole(..)
-  , nodeRoleToRaw
-  , roleDescription
   , AllocPolicy(..)
   , FilledISpecParams(..)
   , PartialISpecParams(..)
   , AllocPolicy(..)
   , FilledISpecParams(..)
   , PartialISpecParams(..)
@@ -105,7 +95,9 @@ import Data.Word
 import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
 import qualified Text.JSON as J
 
 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.Constants as C
+import qualified Ganeti.ConstantUtils as ConstantUtils
 import Ganeti.JSON
 import Ganeti.Types
 import Ganeti.THH
 import Ganeti.JSON
 import Ganeti.Types
 import Ganeti.THH
@@ -120,16 +112,6 @@ fillDict defaults custom skip_keys =
   let updated = Map.union custom defaults
   in foldl' (flip Map.delete) updated skip_keys
 
   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
 -- | The hypervisor parameter type. This is currently a simple map,
 -- without type checking on key/value pairs.
 type HvParams = Container JSValue
@@ -156,25 +138,6 @@ class SerialNoObject a where
 class TagsObject a where
   tagsOf :: a -> Set.Set String
 
 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
 -- * Network definitions
 
 -- ** Ipv4 types
@@ -260,6 +223,7 @@ $(buildObject "Network" "network" $
     simpleField "ext_reservations" [t| String |]
   ]
   ++ uuidFields
     simpleField "ext_reservations" [t| String |]
   ]
   ++ uuidFields
+  ++ timeStampFields
   ++ serialFields
   ++ tagsFields)
 
   ++ serialFields
   ++ tagsFields)
 
@@ -272,11 +236,16 @@ instance TagsObject Network where
 instance UuidObject Network where
   uuidOf = networkUuid
 
 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  |]
 -- * NIC definitions
 
 $(buildParam "Nic" "nicp"
   [ simpleField "mode" [t| NICMode |]
   , simpleField "link" [t| String  |]
+  , simpleField "vlan" [t| String |]
   ])
 
 $(buildObject "PartialNic" "nic" $
   ])
 
 $(buildObject "PartialNic" "nic" $
@@ -292,28 +261,6 @@ instance UuidObject PartialNic where
 
 -- * Disk definitions
 
 
 -- * 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"
 -- | Constant for the dev_type key entry in the disk config.
 devType :: String
 devType = "dev_type"
@@ -327,19 +274,21 @@ data DiskLogicalId
   | LIDDrbd8 String String Int Int Int String
   -- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret
   | LIDFile FileDriver String -- ^ Driver, path
   | 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.
   | 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)]
 
 -- | Builds the extra disk_type field for a given logical id.
 lidEncodeType :: DiskLogicalId -> [(String, JSValue)]
@@ -353,6 +302,8 @@ encodeDLId (LIDDrbd8 nodeA nodeB port minorA minorB key) =
           , showJSON minorA, showJSON minorB, showJSON key ]
 encodeDLId (LIDRados pool name) = JSArray [showJSON pool, showJSON name]
 encodeDLId (LIDFile driver name) = JSArray [showJSON driver, showJSON name]
           , 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]
 encodeDLId (LIDBlockDev driver name) = JSArray [showJSON driver, showJSON name]
 encodeDLId (LIDExt extprovider name) =
   JSArray [showJSON extprovider, showJSON name]
@@ -368,7 +319,7 @@ decodeDLId :: [(String, JSValue)] -> JSValue -> J.Result DiskLogicalId
 decodeDLId obj lid = do
   dtype <- fromObj obj devType
   case dtype of
 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
       case lid of
         JSArray [nA, nB, p, mA, mB, k] -> do
           nA' <- readJSON nA
@@ -379,41 +330,50 @@ decodeDLId obj lid = do
           k'  <- readJSON k
           return $ LIDDrbd8 nA' nB' p' mA' mB' k'
         _ -> fail "Can't read logical_id for DRBD8 type"
           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"
       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"
       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"
       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"
       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"
       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.
 --
 
 -- | Disk data structure.
 --
@@ -421,7 +381,6 @@ decodeDLId obj lid = do
 -- code currently can't build it.
 data Disk = Disk
   { diskLogicalId  :: DiskLogicalId
 -- code currently can't build it.
 data Disk = Disk
   { diskLogicalId  :: DiskLogicalId
---  , diskPhysicalId :: String
   , diskChildren   :: [Disk]
   , diskIvName     :: String
   , diskSize       :: Int
   , diskChildren   :: [Disk]
   , diskIvName     :: String
   , diskSize       :: Int
@@ -434,7 +393,6 @@ data Disk = Disk
 $(buildObjectSerialisation "Disk" $
   [ customField 'decodeDLId 'encodeFullDLId ["dev_type"] $
       simpleField "logical_id"    [t| DiskLogicalId   |]
 $(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 |]
   , defaultField  [| [] |] $ simpleField "children" [t| [Disk] |]
   , defaultField [| "" |] $ simpleField "iv_name" [t| String |]
   , simpleField "size" [t| Int |]
@@ -458,16 +416,8 @@ includesLogicalId vg_name lv_name disk =
       any (includesLogicalId vg_name lv_name) $ diskChildren disk
     _ -> False
 
       any (includesLogicalId vg_name lv_name) $ diskChildren disk
     _ -> False
 
-
 -- * Instance definitions
 
 -- * 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  |]
 $(buildParam "Be" "bep"
   [ simpleField "minmem"       [t| Int  |]
   , simpleField "maxmem"       [t| Int  |]
@@ -511,12 +461,12 @@ instance TagsObject Instance where
 -- * IPolicy definitions
 
 $(buildParam "ISpec" "ispec"
 -- * 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"
   ])
 
 $(buildObject "MinMaxISpecs" "mmis"
@@ -527,23 +477,23 @@ $(buildObject "MinMaxISpecs" "mmis"
 -- | Custom partial ipolicy. This is not built via buildParam since it
 -- has a special 2-level inheritance mode.
 $(buildObject "PartialIPolicy" "ipolicy"
 -- | 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"
   ])
 
 -- | 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 |]
   , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
   , simpleField "spindle-ratio"  [t| Double |]
   , simpleField "vcpu-ratio"     [t| Double |]
@@ -577,6 +527,9 @@ $(buildParam "ND" "ndp"
   [ simpleField "oob_program"   [t| String |]
   , simpleField "spindle_count" [t| Int    |]
   , simpleField "exclusive_storage" [t| Bool |]
   [ 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" $
   ])
 
 $(buildObject "Node" "node" $
@@ -647,8 +600,8 @@ instance TagsObject NodeGroup where
 
 -- | IP family type
 $(declareIADT "IpFamily"
 
 -- | IP family type
 $(declareIADT "IpFamily"
-  [ ("IpFamilyV4", 'C.ip4Family)
-  , ("IpFamilyV6", 'C.ip6Family)
+  [ ("IpFamilyV4", 'AutoConf.pyAfInet4)
+  , ("IpFamilyV6", 'AutoConf.pyAfInet6)
   ])
 $(makeJSONInstance ''IpFamily)
 
   ])
 $(makeJSONInstance ''IpFamily)
 
@@ -679,6 +632,8 @@ type UidPool = [(Int, Int)]
 -- * Cluster definitions
 $(buildObject "Cluster" "cluster" $
   [ simpleField "rsahostkeypub"           [t| String           |]
 -- * 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           |]
   , simpleField "highest_used_port"       [t| Int              |]
   , simpleField "tcpudp_port_pool"        [t| [Int]            |]
   , simpleField "mac_prefix"              [t| String           |]
Unnamed repository; edit this file 'description' to name the repository.