code.grnet.gr Git - ganeti-local/blob - htools/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 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   ( NICMode(..)
  33   , PartialNICParams(..)
  34   , FilledNICParams(..)
  35   , fillNICParams
  36   , PartialNIC(..)
  37   , DiskMode(..)
  38   , DiskType(..)
  39   , Disk(..)
  40   , DiskTemplate(..)
  41   , PartialBEParams(..)
  42   , FilledBEParams(..)
  43   , fillBEParams
  44   , Instance(..)
  45   , toDictInstance
  46   , PartialNDParams(..)
  47   , FilledNDParams(..)
  48   , fillNDParams
  49   , Node(..)
  50   , AllocPolicy(..)
  51   , NodeGroup(..)
  52   , Cluster(..)
  53   , ConfigData(..)
  54   ) where
  55
  56 import Data.Maybe
  57 import Text.JSON (makeObj, showJSON, readJSON)
  58
  59 import qualified Ganeti.Constants as C
  60 import Ganeti.HTools.JSON
  61
  62 import Ganeti.THH
  63
  64 -- * NIC definitions
  65
  66 $(declareSADT "NICMode"
  67   [ ("NMBridged", 'C.nicModeBridged)
  68   , ("NMRouted",  'C.nicModeRouted)
  69   ])
  70 $(makeJSONInstance ''NICMode)
  71
  72 $(buildParam "NIC" "nicp"
  73   [ simpleField "mode" [t| NICMode |]
  74   , simpleField "link" [t| String  |]
  75   ])
  76
  77 $(buildObject "PartialNIC" "nic"
  78   [ simpleField "mac" [t| String |]
  79   , optionalField $ simpleField "ip" [t| String |]
  80   , simpleField "nicparams" [t| PartialNICParams |]
  81   ])
  82
  83 -- * Disk definitions
  84
  85 $(declareSADT "DiskMode"
  86   [ ("DiskRdOnly", 'C.diskRdonly)
  87   , ("DiskRdWr",   'C.diskRdwr)
  88   ])
  89 $(makeJSONInstance ''DiskMode)
  90
  91 $(declareSADT "DiskType"
  92   [ ("LD_LV",       'C.ldLv)
  93   , ("LD_DRBD8",    'C.ldDrbd8)
  94   , ("LD_FILE",     'C.ldFile)
  95   , ("LD_BLOCKDEV", 'C.ldBlockdev)
  96   ])
  97 $(makeJSONInstance ''DiskType)
  98
  99 -- | Disk data structure.
 100 --
 101 -- This is declared manually as it's a recursive structure, and our TH
 102 -- code currently can't build it.
 103 data Disk = Disk
 104   { diskDevType    :: DiskType
 105 --  , diskLogicalId  :: String
 106 --  , diskPhysicalId :: String
 107   , diskChildren   :: [Disk]
 108   , diskIvName     :: String
 109   , diskSize       :: Int
 110   , diskMode       :: DiskMode
 111   } deriving (Read, Show, Eq)
 112
 113 $(buildObjectSerialisation "Disk"
 114   [ simpleField "dev_type"      [t| DiskMode |]
 115 --  , simpleField "logical_id"  [t| String   |]
 116 --  , simpleField "physical_id" [t| String   |]
 117   , defaultField  [| [] |] $ simpleField "children" [t| [Disk] |]
 118   , defaultField [| "" |] $ simpleField "iv_name" [t| String |]
 119   , simpleField "size" [t| Int |]
 120   , defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |]
 121   ])
 122
 123 -- * Instance definitions
 124
 125 -- | Instance disk template type. **Copied from HTools/Types.hs**
 126 $(declareSADT "DiskTemplate"
 127   [ ("DTDiskless",   'C.dtDiskless)
 128   , ("DTFile",       'C.dtFile)
 129   , ("DTSharedFile", 'C.dtSharedFile)
 130   , ("DTPlain",      'C.dtPlain)
 131   , ("DTBlock",      'C.dtBlock)
 132   , ("DTDrbd8",      'C.dtDrbd8)
 133   ])
 134 $(makeJSONInstance ''DiskTemplate)
 135
 136 $(declareSADT "AdminState"
 137   [ ("AdminOffline", 'C.adminstOffline)
 138   , ("AdminDown",    'C.adminstDown)
 139   , ("AdminUp",      'C.adminstUp)
 140   ])
 141 $(makeJSONInstance ''AdminState)
 142
 143 $(buildParam "BE" "bep" $
 144   [ simpleField "minmem"       [t| Int  |]
 145   , simpleField "maxmem"       [t| Int  |]
 146   , simpleField "vcpus"        [t| Int  |]
 147   , simpleField "auto_balance" [t| Bool |]
 148   ])
 149
 150 $(buildObject "Instance" "inst" $
 151   [ simpleField "name"           [t| String             |]
 152   , simpleField "primary_node"   [t| String             |]
 153   , simpleField "os"             [t| String             |]
 154   , simpleField "hypervisor"     [t| String             |]
 155 --  , simpleField "hvparams"     [t| [(String, String)] |]
 156   , simpleField "beparams"       [t| PartialBEParams |]
 157 --  , simpleField "osparams"     [t| [(String, String)] |]
 158   , simpleField "admin_state"    [t| AdminState         |]
 159   , simpleField "nics"           [t| [PartialNIC]              |]
 160   , simpleField "disks"          [t| [Disk]             |]
 161   , simpleField "disk_template"  [t| DiskTemplate       |]
 162   , optionalField $ simpleField "network_port" [t| Int |]
 163   ]
 164   ++ timeStampFields
 165   ++ uuidFields
 166   ++ serialFields)
 167
 168 -- * Node definitions
 169
 170 $(buildParam "ND" "ndp" $
 171   [ simpleField "oob_program" [t| String |]
 172   ])
 173
 174 $(buildObject "Node" "node" $
 175   [ simpleField "name"             [t| String |]
 176   , simpleField "primary_ip"       [t| String |]
 177   , simpleField "secondary_ip"     [t| String |]
 178   , simpleField "master_candidate" [t| Bool   |]
 179   , simpleField "offline"          [t| Bool   |]
 180   , simpleField "drained"          [t| Bool   |]
 181   , simpleField "group"            [t| String |]
 182   , simpleField "master_capable"   [t| Bool   |]
 183   , simpleField "vm_capable"       [t| Bool   |]
 184 --  , simpleField "ndparams"       [t| PartialNDParams |]
 185   , simpleField "powered"          [t| Bool   |]
 186   ]
 187   ++ timeStampFields
 188   ++ uuidFields
 189   ++ serialFields)
 190
 191 -- * NodeGroup definitions
 192
 193 -- | The Group allocation policy type.
 194 --
 195 -- Note that the order of constructors is important as the automatic
 196 -- Ord instance will order them in the order they are defined, so when
 197 -- changing this data type be careful about the interaction with the
 198 -- desired sorting order.
 199 --
 200 -- FIXME: COPIED from Types.hs; we need to eliminate this duplication later
 201 $(declareSADT "AllocPolicy"
 202   [ ("AllocPreferred",   'C.allocPolicyPreferred)
 203   , ("AllocLastResort",  'C.allocPolicyLastResort)
 204   , ("AllocUnallocable", 'C.allocPolicyUnallocable)
 205   ])
 206 $(makeJSONInstance ''AllocPolicy)
 207
 208 $(buildObject "NodeGroup" "group" $
 209   [ simpleField "name"         [t| String |]
 210   , defaultField  [| [] |] $ simpleField "members" [t| [String] |]
 211 --  , simpleField "ndparams"   [t| PartialNDParams |]
 212   , simpleField "alloc_policy" [t| AllocPolicy |]
 213   ]
 214   ++ timeStampFields
 215   ++ uuidFields
 216   ++ serialFields)
 217
 218 -- * Cluster definitions
 219 $(buildObject "Cluster" "cluster" $
 220   [ simpleField "rsahostkeypub"             [t| String   |]
 221   , simpleField "highest_used_port"         [t| Int      |]
 222   , simpleField "tcpudp_port_pool"          [t| [Int]    |]
 223   , simpleField "mac_prefix"                [t| String   |]
 224   , simpleField "volume_group_name"         [t| String   |]
 225   , simpleField "reserved_lvs"              [t| [String] |]
 226 --  , simpleField "drbd_usermode_helper"      [t| String   |]
 227 -- , simpleField "default_bridge"          [t| String   |]
 228 -- , simpleField "default_hypervisor"      [t| String   |]
 229   , simpleField "master_node"               [t| String   |]
 230   , simpleField "master_ip"                 [t| String   |]
 231   , simpleField "master_netdev"             [t| String   |]
 232 -- , simpleField "master_netmask"          [t| String   |]
 233   , simpleField "cluster_name"              [t| String   |]
 234   , simpleField "file_storage_dir"          [t| String   |]
 235 -- , simpleField "shared_file_storage_dir" [t| String   |]
 236   , simpleField "enabled_hypervisors"       [t| [String] |]
 237 -- , simpleField "hvparams"                [t| [(String, [(String, String)])] |]
 238 -- , simpleField "os_hvp"                  [t| [(String, String)] |]
 239   , containerField $ simpleField "beparams" [t| FilledBEParams |]
 240 -- , simpleField "osparams"                [t| [(String, String)] |]
 241   , containerField $ simpleField "nicparams" [t| FilledNICParams    |]
 242 --  , simpleField "ndparams"                  [t| FilledNDParams |]
 243   , simpleField "candidate_pool_size"       [t| Int                |]
 244   , simpleField "modify_etc_hosts"          [t| Bool               |]
 245   , simpleField "modify_ssh_setup"          [t| Bool               |]
 246   , simpleField "maintain_node_health"      [t| Bool               |]
 247   , simpleField "uid_pool"                  [t| [Int]              |]
 248   , simpleField "default_iallocator"        [t| String             |]
 249   , simpleField "hidden_os"                 [t| [String]           |]
 250   , simpleField "blacklisted_os"            [t| [String]           |]
 251   , simpleField "primary_ip_family"         [t| Int                |]
 252   , simpleField "prealloc_wipe_disks"       [t| Bool               |]
 253  ]
 254  ++ serialFields)
 255
 256 -- * ConfigData definitions
 257
 258 $(buildObject "ConfigData" "config" $
 259 --  timeStampFields ++
 260   [ simpleField "version"       [t| Int                |]
 261   , simpleField "cluster"       [t| Cluster            |]
 262   , containerField $ simpleField "nodes"      [t| Node     |]
 263   , containerField $ simpleField "nodegroups" [t| NodeGroup |]
 264   , containerField $ simpleField "instances"  [t| Instance |]
 265   ]
 266   ++ serialFields)