Fix parsing of absolute job dependencies

[ganeti-local] / htools / Ganeti / Objects.hs

diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 3504ed5..18ca6df 100644 (file)
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -33,7 +33,6 @@ module Ganeti.Objects
   , vTypeFromRaw
   , HvParams
   , OsParams
-  , NICMode(..)
   , PartialNicParams(..)
   , FilledNicParams(..)
   , fillNicParams
@@ -50,7 +49,6 @@ module Ganeti.Objects
   , FilledBeParams(..)
   , fillBeParams
   , allBeParamFields
-  , Hypervisor(..)
   , AdminState(..)
   , adminStateFromRaw
   , Instance(..)
@@ -89,18 +87,19 @@ module Ganeti.Objects
   , TagsObject(..)
   , DictObject(..) -- re-exported from THH
   , TagSet -- re-exported from THH
+  , Network(..)
   ) where
 
 import Data.List (foldl')
 import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..))
+import Text.JSON (showJSON, readJSON, JSON, JSValue(..))
 import qualified Text.JSON as J
 
 import qualified Ganeti.Constants as C
 import Ganeti.JSON
-
+import Ganeti.Types
 import Ganeti.THH
 
 -- * Generic definitions
@@ -169,12 +168,6 @@ roleDescription NRMaster    = "master"
 
 -- * NIC definitions
 
-$(declareSADT "NICMode"
-  [ ("NMBridged", 'C.nicModeBridged)
-  , ("NMRouted",  'C.nicModeRouted)
-  ])
-$(makeJSONInstance ''NICMode)
-
 $(buildParam "Nic" "nicp"
   [ simpleField "mode" [t| NICMode |]
   , simpleField "link" [t| String  |]
@@ -203,13 +196,6 @@ $(declareSADT "DiskType"
   ])
 $(makeJSONInstance ''DiskType)
 
--- | The file driver type.
-$(declareSADT "FileDriver"
-  [ ("FileLoop",   'C.fdLoop)
-  , ("FileBlktap", 'C.fdBlktap)
-  ])
-$(makeJSONInstance ''FileDriver)
-
 -- | The persistent block driver type. Currently only one type is allowed.
 $(declareSADT "BlockDriver"
   [ ("BlockDrvManual", 'C.blockdevDriverManual)
@@ -231,7 +217,7 @@ data DiskLogicalId
   | LIDFile FileDriver String -- ^ Driver, path
   | LIDBlockDev BlockDriver String -- ^ Driver, path (must be under /dev)
   | LIDRados String String -- ^ Unused, path
-    deriving (Read, Show, Eq)
+    deriving (Show, Eq)
 
 -- | Mapping from a logical id to a disk type.
 lidDiskType :: DiskLogicalId -> DiskType
@@ -317,10 +303,10 @@ data Disk = Disk
   , diskIvName     :: String
   , diskSize       :: Int
   , diskMode       :: DiskMode
-  } deriving (Read, Show, Eq)
+  } deriving (Show, Eq)
 
 $(buildObjectSerialisation "Disk"
-  [ customField 'decodeDLId 'encodeFullDLId $
+  [ customField 'decodeDLId 'encodeFullDLId ["dev_type"] $
       simpleField "logical_id"    [t| DiskLogicalId   |]
 --  , simpleField "physical_id" [t| String   |]
   , defaultField  [| [] |] $ simpleField "children" [t| [Disk] |]
@@ -329,33 +315,8 @@ $(buildObjectSerialisation "Disk"
   , defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |]
   ])
 
--- * Hypervisor definitions
-
--- | This may be due to change when we add hypervisor parameters.
-$(declareSADT "Hypervisor"
-  [ ( "Kvm",    'C.htKvm )
-  , ( "XenPvm", 'C.htXenPvm )
-  , ( "Chroot", 'C.htChroot )
-  , ( "XenHvm", 'C.htXenHvm )
-  , ( "Lxc",    'C.htLxc )
-  , ( "Fake",   'C.htFake )
-  ])
-$(makeJSONInstance ''Hypervisor)
-
 -- * Instance definitions
 
--- | Instance disk template type. **Copied from HTools/Types.hs**
-$(declareSADT "DiskTemplate"
-  [ ("DTDiskless",   'C.dtDiskless)
-  , ("DTFile",       'C.dtFile)
-  , ("DTSharedFile", 'C.dtSharedFile)
-  , ("DTPlain",      'C.dtPlain)
-  , ("DTBlock",      'C.dtBlock)
-  , ("DTDrbd8",      'C.dtDrbd8)
-  , ("DTRados",      'C.dtRbd)
-  ])
-$(makeJSONInstance ''DiskTemplate)
-
 $(declareSADT "AdminState"
   [ ("AdminOffline", 'C.adminstOffline)
   , ("AdminDown",    'C.adminstDown)
@@ -409,6 +370,7 @@ $(buildParam "ISpec" "ispec"
   , 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 |]
   ])
 
@@ -499,21 +461,6 @@ instance TagsObject Node where
 
 -- * NodeGroup definitions
 
--- | The Group allocation policy type.
---
--- Note that the order of constructors is important as the automatic
--- Ord instance will order them in the order they are defined, so when
--- changing this data type be careful about the interaction with the
--- desired sorting order.
---
--- FIXME: COPIED from Types.hs; we need to eliminate this duplication later
-$(declareSADT "AllocPolicy"
-  [ ("AllocPreferred",   'C.allocPolicyPreferred)
-  , ("AllocLastResort",  'C.allocPolicyLastResort)
-  , ("AllocUnallocable", 'C.allocPolicyUnallocable)
-  ])
-$(makeJSONInstance ''AllocPolicy)
-
 -- | The disk parameters type.
 type DiskParams = Container (Container JSValue)
 
@@ -644,3 +591,39 @@ $(buildObject "ConfigData" "config" $
 
 instance SerialNoObject ConfigData where
   serialOf = configSerial
+
+-- * Network definitions
+
+-- FIXME: Not all types might be correct here, since they
+-- haven't been exhaustively deduced from the python code yet.
+$(buildObject "Network" "network" $
+  [ simpleField "name"             [t| NonEmptyString |]
+  , optionalField $
+    simpleField "network_type"     [t| NetworkType |]
+  , optionalField $
+    simpleField "mac_prefix"       [t| String |]
+  , optionalField $
+    simpleField "family"           [t| Int |]
+  , simpleField "network"          [t| NonEmptyString |]
+  , optionalField $
+    simpleField "network6"         [t| String |]
+  , optionalField $
+    simpleField "gateway"          [t| String |]
+  , optionalField $
+    simpleField "gateway6"         [t| String |]
+  , optionalField $
+    simpleField "size"             [t| J.JSValue |]
+  , optionalField $
+    simpleField "reservations"     [t| String |]
+  , optionalField $
+    simpleField "ext_reservations" [t| String |]
+  ]
+  ++ serialFields
+  ++ tagsFields)
+
+instance SerialNoObject Network where
+  serialOf = networkSerial
+
+instance TagsObject Network where
+  tagsOf = networkTags
+