content: {-# LANGUAGE TemplateHaskell, FunctionalDependencies #-}
  
  {-| Implementation of the Ganeti config objects.
  
  -}
  
  {-
  
  Copyright (C) 2011, 2012, 2013, 2014 Google Inc.
  All rights reserved.
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions are
  met:
  
  1. Redistributions of source code must retain the above copyright notice,
  this list of conditions and the following disclaimer.
  
  2. Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.
  
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  -}
  
  module Ganeti.Objects
    ( HvParams
    , OsParams
    , OsParamsPrivate
    , PartialNicParams(..)
    , FilledNicParams(..)
    , allNicParamFields
    , PartialNic(..)
    , FileDriver(..)
    , DataCollectorConfig(..)
    , DiskTemplate(..)
    , PartialBeParams(..)
    , FilledBeParams(..)
    , PartialNDParams(..)
    , FilledNDParams(..)
    , allNDParamFields
    , Node(..)
    , AllocPolicy(..)
    , FilledISpecParams(..)
    , PartialISpecParams(..)
    , allISpecParamFields
    , MinMaxISpecs(..)
    , FilledIPolicy(..)
    , PartialIPolicy(..)
    , GroupDiskParams
    , NodeGroup(..)
    , FilterAction(..)
    , FilterPredicate(..)
    , FilterRule(..)
    , filterRuleOrder
    , IpFamily(..)
    , ipFamilyToRaw
    , ipFamilyToVersion
    , fillDict
    , ClusterHvParams
    , OsHvParams
    , ClusterBeParams
    , ClusterOsParams
    , ClusterOsParamsPrivate
    , ClusterNicParams
    , UidPool
    , formatUidRange
    , UidRange
    , Cluster(..)
    , ConfigData(..)
    , TimeStampObject(..) -- re-exported from Types
    , UuidObject(..) -- re-exported from Types
    , SerialNoObject(..) -- re-exported from Types
    , TagsObject(..) -- re-exported from Types
    , DictObject(..) -- re-exported from THH
    , TagSet(..) -- re-exported from THH
    , emptyTagSet -- re-exported from THH
    , Network(..)
    , AddressPool(..)
    , Ip4Address()
    , mkIp4Address
    , Ip4Network()
    , mkIp4Network
    , ip4netAddr
    , ip4netMask
    , readIp4Address
    , ip4AddressToList
    , ip4AddressToNumber
    , ip4AddressFromNumber
    , nextIp4Address
    , IAllocatorParams
    , MasterNetworkParameters(..)
    , module Ganeti.PartialParams
    , module Ganeti.Objects.Disk
    , module Ganeti.Objects.Instance
    ) where
  
  import Control.Arrow (first)
  import Control.Monad.State
  import Control.Monad.Fail (MonadFail)
  import Control.Monad (liftM)
  import qualified Data.ByteString.UTF8 as UTF8
  import Data.List (foldl', intercalate)
  import Data.Maybe
  import qualified Data.Map as Map
  import Data.Ord (comparing)
  import Data.Ratio (numerator, denominator)
  import qualified Data.Semigroup as Sem
  import Data.Tuple (swap)
  import Data.Word
  import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString,
                    toJSString)
  import qualified Text.JSON as J
  
  import qualified AutoConf
  import qualified Ganeti.Constants as C
  import qualified Ganeti.ConstantUtils as ConstantUtils
  import Ganeti.JSON (DictObject(..), Container, emptyContainer, GenericContainer)
  import Ganeti.Objects.BitArray (BitArray)
  import Ganeti.Objects.Disk
  import Ganeti.Objects.Nic
  import Ganeti.Objects.Instance
  import Ganeti.Query.Language
  import Ganeti.PartialParams
  import Ganeti.Types
  import Ganeti.THH
  import Ganeti.THH.Field
  import Ganeti.Utils (sepSplit, tryRead)
  
  -- * Generic definitions
  
  -- | Fills one map with keys from the other map, if not already
  -- existing. Mirrors objects.py:FillDict.
  fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v
  fillDict defaults custom skip_keys =
    let updated = Map.union custom defaults
    in foldl' (flip Map.delete) updated skip_keys
  
  
  -- * Network definitions
  
  -- ** Ipv4 types
  
  data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
    deriving (Eq, Ord)
  
  mkIp4Address :: (Word8, Word8, Word8, Word8) -> Ip4Address
  mkIp4Address (a, b, c, d) = Ip4Address a b c d
  
  instance Show Ip4Address where
    show (Ip4Address a b c d) = intercalate "." $ map show [a, b, c, d]
  
  readIp4Address :: (Applicative m, MonadFail m) => String -> m Ip4Address
  readIp4Address s =
    case sepSplit '.' s of
      [a, b, c, d] -> Ip4Address <$>
                        tryRead "first octect" a <*>
                        tryRead "second octet" b <*>
                        tryRead "third octet"  c <*>
                        tryRead "fourth octet" d
      _ -> fail $ "Can't parse IPv4 address from string " ++ s
  
  instance JSON Ip4Address where
    showJSON = showJSON . show
    readJSON (JSString s) = readIp4Address (fromJSString s)
    readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address"
  
  -- Converts an address to a list of numbers
  ip4AddressToList :: Ip4Address -> [Word8]
  ip4AddressToList (Ip4Address a b c d) = [a, b, c, d]
  
  -- | Converts an address into its ordinal number.
  -- This is needed for indexing IP adresses in reservation pools.
  ip4AddressToNumber :: Ip4Address -> Integer
  ip4AddressToNumber = foldl (\n i -> 256 * n + toInteger i) 0 . ip4AddressToList
  
  -- | Converts a number into an address.
  -- This is needed for indexing IP adresses in reservation pools.
  ip4AddressFromNumber :: Integer -> Ip4Address
  ip4AddressFromNumber n =
    let s = state $ first fromInteger . swap . (`divMod` 256)
        (d, c, b, a) = evalState ((,,,) <$> s <*> s <*> s <*> s) n
     in Ip4Address a b c d
  
  nextIp4Address :: Ip4Address -> Ip4Address
  nextIp4Address = ip4AddressFromNumber . (+ 1) . ip4AddressToNumber
  
  -- | Custom type for an IPv4 network.
  data Ip4Network = Ip4Network { ip4netAddr :: Ip4Address
                               , ip4netMask :: Word8
                               }
                    deriving (Eq)
  
  mkIp4Network :: Ip4Address -> Word8 -> Ip4Network
  mkIp4Network = Ip4Network
  
  instance Show Ip4Network where
    show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask
  
  -- | JSON instance for 'Ip4Network'.
  instance JSON Ip4Network where
    showJSON = showJSON . show
    readJSON (JSString s) =
      case sepSplit '/' (fromJSString s) of
        [ip, nm] -> do
          ip' <- readIp4Address ip
          nm' <- tryRead "parsing netmask" nm
          if nm' >= 0 && nm' <= 32
            then return $ Ip4Network ip' nm'
            else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++
                        fromJSString s
        _ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s
    readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network"
  
  -- ** Address pools
  
  -- | Currently address pools just wrap a reservation 'BitArray'.
  --
  -- In future, 'Network' might be extended to include several address pools
  -- and address pools might include their own ranges of addresses.
  newtype AddressPool = AddressPool { apReservations :: BitArray }
    deriving (Eq, Ord, Show)
  
  instance JSON AddressPool where
    showJSON = showJSON . apReservations
    readJSON = liftM AddressPool . readJSON
  
  -- ** Ganeti \"network\" config object.
  
  -- FIXME: Not all types might be correct here, since they
  -- haven't been exhaustively deduced from the python code yet.
  --
  -- FIXME: When parsing, check that the ext_reservations and reservations
  -- have the same length
  $(buildObject "Network" "network" $
    [ simpleField "name"             [t| NonEmptyString |]
    , optionalField $
      simpleField "mac_prefix"       [t| String |]
    , simpleField "network"          [t| Ip4Network |]
    , optionalField $
      simpleField "network6"         [t| String |]
    , optionalField $
      simpleField "gateway"          [t| Ip4Address |]
    , optionalField $
      simpleField "gateway6"         [t| String |]
    , optionalField $
      simpleField "reservations"     [t| AddressPool |]
    , optionalField $
      simpleField "ext_reservations" [t| AddressPool |]
    ]
    ++ uuidFields
    ++ timeStampFields
    ++ serialFields
    ++ tagsFields)
  
  instance SerialNoObject Network where
    serialOf = networkSerial
  
  instance TagsObject Network where
    tagsOf = networkTags
  
  instance UuidObject Network where
    uuidOf = UTF8.toString . networkUuid
  
  instance TimeStampObject Network where
    cTimeOf = networkCtime
    mTimeOf = networkMtime
  
  
  -- * Datacollector definitions
  type MicroSeconds = Integer
  
  -- | The configuration regarding a single data collector.
  $(buildObject "DataCollectorConfig" "dataCollector" [
    simpleField "active" [t| Bool|],
    simpleField "interval" [t| MicroSeconds |]
    ])
  
  -- | Central default values of the data collector config.
  instance Sem.Semigroup DataCollectorConfig where
    _ <> a = a
  
  instance Monoid DataCollectorConfig where
    mempty = DataCollectorConfig
      { dataCollectorActive = True
      , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval
      }
    mappend = (Sem.<>)
  
  -- * IPolicy definitions
  
  $(buildParam "ISpec" "ispec"
    [ 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"
    [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |]
    , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |]
    ])
  
  -- | 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 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 ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
    , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
    , simpleField "spindle-ratio"  [t| Double |]
    , simpleField "vcpu-ratio"     [t| Double |]
    , simpleField "disk-templates" [t| [DiskTemplate] |]
    ])
  
  -- | Custom filler for the ipolicy types.
  instance PartialParams FilledIPolicy PartialIPolicy where
    fillParams
              (FilledIPolicy { ipolicyMinMaxISpecs  = fminmax
                             , ipolicyStdSpec       = fstd
                             , ipolicySpindleRatio  = fspindleRatio
                             , ipolicyVcpuRatio     = fvcpuRatio
                             , ipolicyDiskTemplates = fdiskTemplates})
              (PartialIPolicy { ipolicyMinMaxISpecsP  = pminmax
                              , ipolicyStdSpecP       = pstd
                              , ipolicySpindleRatioP  = pspindleRatio
                              , ipolicyVcpuRatioP     = pvcpuRatio
                              , ipolicyDiskTemplatesP = pdiskTemplates}) =
      FilledIPolicy
                  { ipolicyMinMaxISpecs  = fromMaybe fminmax pminmax
                  , ipolicyStdSpec       = maybe fstd (fillParams fstd) pstd
                  , ipolicySpindleRatio  = fromMaybe fspindleRatio pspindleRatio
                  , ipolicyVcpuRatio     = fromMaybe fvcpuRatio pvcpuRatio
                  , ipolicyDiskTemplates = fromMaybe fdiskTemplates
                                           pdiskTemplates
                  }
    toPartial (FilledIPolicy { ipolicyMinMaxISpecs  = fminmax
                             , ipolicyStdSpec       = fstd
                             , ipolicySpindleRatio  = fspindleRatio
                             , ipolicyVcpuRatio     = fvcpuRatio
                             , ipolicyDiskTemplates = fdiskTemplates}) =
      PartialIPolicy
                  { ipolicyMinMaxISpecsP  = Just fminmax
                  , ipolicyStdSpecP       = Just $ toPartial fstd
                  , ipolicySpindleRatioP  = Just fspindleRatio
                  , ipolicyVcpuRatioP     = Just fvcpuRatio
                  , ipolicyDiskTemplatesP = Just fdiskTemplates
                  }
    toFilled (PartialIPolicy { ipolicyMinMaxISpecsP  = pminmax
                             , ipolicyStdSpecP       = pstd
                             , ipolicySpindleRatioP  = pspindleRatio
                             , ipolicyVcpuRatioP     = pvcpuRatio
                             , ipolicyDiskTemplatesP = pdiskTemplates}) =
      FilledIPolicy <$> pminmax <*> (toFilled =<< pstd) <*>  pspindleRatio
                    <*> pvcpuRatio <*> pdiskTemplates
  
  -- * Node definitions
  
  $(buildParam "ND" "ndp"
    [ 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 |]
    , simpleField "ssh_port"      [t| Int |]
    , simpleField "cpu_speed"     [t| Double |]
    ])
  
  -- | Disk state parameters.
  --
  -- As according to the documentation this option is unused by Ganeti,
  -- the content is just a 'JSValue'.
  type DiskState = Container JSValue
  
  -- | Hypervisor state parameters.
  --
  -- As according to the documentation this option is unused by Ganeti,
  -- the content is just a 'JSValue'.
  type HypervisorState = Container JSValue
  
  $(buildObject "Node" "node" $
    [ simpleField "name"             [t| String |]
    , simpleField "primary_ip"       [t| String |]
    , simpleField "secondary_ip"     [t| String |]
    , simpleField "master_candidate" [t| Bool   |]
    , simpleField "offline"          [t| Bool   |]
    , simpleField "drained"          [t| Bool   |]
    , simpleField "group"            [t| String |]
    , simpleField "master_capable"   [t| Bool   |]
    , simpleField "vm_capable"       [t| Bool   |]
    , simpleField "ndparams"         [t| PartialNDParams |]
    , simpleField "powered"          [t| Bool   |]
    , notSerializeDefaultField [| emptyContainer |] $
      simpleField "hv_state_static"   [t| HypervisorState |]
    , notSerializeDefaultField [| emptyContainer |] $
      simpleField "disk_state_static" [t| DiskState       |]
    ]
    ++ timeStampFields
    ++ uuidFields
    ++ serialFields
    ++ tagsFields)
  
  instance TimeStampObject Node where
    cTimeOf = nodeCtime
    mTimeOf = nodeMtime
  
  instance UuidObject Node where
    uuidOf = UTF8.toString . nodeUuid
  
  instance SerialNoObject Node where
    serialOf = nodeSerial
  
  instance TagsObject Node where
    tagsOf = nodeTags
  
  -- * NodeGroup definitions
  
  -- | The cluster/group disk parameters type.
  type GroupDiskParams = Container DiskParams
  
  -- | A mapping from network UUIDs to nic params of the networks.
  type Networks = Container PartialNicParams
  
  $(buildObject "NodeGroup" "group" $
    [ simpleField "name"         [t| String |]
    , defaultField [| [] |] $ simpleField "members" [t| [String] |]
    , simpleField "ndparams"     [t| PartialNDParams |]
    , simpleField "alloc_policy" [t| AllocPolicy     |]
    , simpleField "ipolicy"      [t| PartialIPolicy  |]
    , simpleField "diskparams"   [t| GroupDiskParams |]
    , simpleField "networks"     [t| Networks        |]
    , notSerializeDefaultField [| emptyContainer |] $
      simpleField "hv_state_static"   [t| HypervisorState |]
    , notSerializeDefaultField [| emptyContainer |] $
      simpleField "disk_state_static" [t| DiskState       |]
    ]
    ++ timeStampFields
    ++ uuidFields
    ++ serialFields
    ++ tagsFields)
  
  instance TimeStampObject NodeGroup where
    cTimeOf = groupCtime
    mTimeOf = groupMtime
  
  instance UuidObject NodeGroup where
    uuidOf = UTF8.toString . groupUuid
  
  instance SerialNoObject NodeGroup where
    serialOf = groupSerial
  
  instance TagsObject NodeGroup where
    tagsOf = groupTags
  
  -- * Job scheduler filtering definitions
  
  -- | Actions that can be performed when a filter matches.
  data FilterAction
    = Accept
    | Pause
    | Reject
    | Continue
    | RateLimit Int
    deriving (Eq, Ord, Show)
  
  instance JSON FilterAction where
    showJSON fa = case fa of
      Accept      -> JSString (toJSString "ACCEPT")
      Pause       -> JSString (toJSString "PAUSE")
      Reject      -> JSString (toJSString "REJECT")
      Continue    -> JSString (toJSString "CONTINUE")
      RateLimit n -> JSArray [ JSString (toJSString "RATE_LIMIT")
                             , JSRational False (fromIntegral n)
                             ]
    readJSON v = case v of
      -- `FilterAction`s are case-sensitive.
      JSString s | fromJSString s == "ACCEPT"   -> return Accept
      JSString s | fromJSString s == "PAUSE"    -> return Pause
      JSString s | fromJSString s == "REJECT"   -> return Reject
      JSString s | fromJSString s == "CONTINUE" -> return Continue
      JSArray (JSString s : rest) | fromJSString s == "RATE_LIMIT" ->
        case rest of
          [JSRational False n] | denominator n == 1 && numerator n > 0 ->
            return . RateLimit . fromIntegral $ numerator n
          _ -> fail "RATE_LIMIT argument must be a positive integer"
      x -> fail $ "malformed FilterAction JSON: " ++ J.showJSValue x ""
  
  
  data FilterPredicate
    = FPJobId (Filter FilterField)
    | FPOpCode (Filter FilterField)
    | FPReason (Filter FilterField)
    deriving (Eq, Ord, Show)
  
  
  instance JSON FilterPredicate where
    showJSON fp = case fp of
      FPJobId expr  -> JSArray [string "jobid",  showJSON expr]
      FPOpCode expr -> JSArray [string "opcode", showJSON expr]
      FPReason expr -> JSArray [string "reason", showJSON expr]
      where
        string = JSString . toJSString
  
    readJSON v = case v of
      -- Predicate names are case-sensitive.
      JSArray [JSString name, expr]
        | name == toJSString "jobid"  -> FPJobId <$> readJSON expr
        | name == toJSString "opcode" -> FPOpCode <$> readJSON expr
        | name == toJSString "reason" -> FPReason <$> readJSON expr
      JSArray (JSString name:params) ->
        fail $ "malformed FilterPredicate: bad parameter list for\
               \ '" ++ fromJSString name ++ "' predicate: "
               ++ J.showJSArray params ""
      _ -> fail "malformed FilterPredicate: must be a list with the first\
                \ entry being a string describing the predicate type"
  
  
  $(buildObject "FilterRule" "fr" $
    [ simpleField "watermark"    [t| JobId             |]
    , simpleField "priority"     [t| NonNegative Int   |]
    , simpleField "predicates"   [t| [FilterPredicate] |]
    , simpleField "action"       [t| FilterAction      |]
    , simpleField "reason_trail" [t| ReasonTrail       |]
    ]
    ++ uuidFields)
  
  instance UuidObject FilterRule where
    uuidOf = UTF8.toString . frUuid
  
  
  -- | Order in which filter rules are evaluated, according to
  -- `doc/design-optables.rst`.
  -- For `FilterRule` fields not specified as important for the order,
  -- we choose an arbitrary ordering effect (after the ones from the spec).
  --
  -- The `Ord` instance for `FilterRule` agrees with this function.
  -- Yet it is recommended to use this function instead of `compare` to be
  -- explicit that the spec order is used.
  filterRuleOrder :: FilterRule -> FilterRule -> Ordering
  filterRuleOrder = compare
  
  
  instance Ord FilterRule where
    -- It is important that the Ord instance respects the ordering given in
    -- `doc/design-optables.rst` for the fields defined in there. The other
    -- fields may be ordered arbitrarily.
    -- Use `filterRuleOrder` when relying on the spec order.
    compare =
      comparing $ \(FilterRule watermark prio predicates action reason uuid) ->
        ( prio, watermark, uuid -- spec part
        , predicates, action, reason -- arbitrary part
        )
  
  
  -- | IP family type
  $(declareIADT "IpFamily"
    [ ("IpFamilyV4", 'AutoConf.pyAfInet4)
    , ("IpFamilyV6", 'AutoConf.pyAfInet6)
    ])
  $(makeJSONInstance ''IpFamily)
  
  -- | Conversion from IP family to IP version. This is needed because
  -- Python uses both, depending on context.
  ipFamilyToVersion :: IpFamily -> Int
  ipFamilyToVersion IpFamilyV4 = C.ip4Version
  ipFamilyToVersion IpFamilyV6 = C.ip6Version
  
  -- | Cluster HvParams (hvtype to hvparams mapping).
  type ClusterHvParams = GenericContainer Hypervisor HvParams
  
  -- | Cluster Os-HvParams (os to hvparams mapping).
  type OsHvParams = Container ClusterHvParams
  
  -- | Cluser BeParams.
  type ClusterBeParams = Container FilledBeParams
  
  -- | Cluster OsParams.
  type ClusterOsParams = Container OsParams
  type ClusterOsParamsPrivate = Container (Private OsParams)
  
  -- | Cluster NicParams.
  type ClusterNicParams = Container FilledNicParams
  
  -- | A low-high UID ranges.
  type UidRange = (Int, Int)
  
  formatUidRange :: UidRange -> String
  formatUidRange (lower, higher)
    | lower == higher = show lower
    | otherwise       = show lower ++ "-" ++ show higher
  
  -- | Cluster UID Pool, list (low, high) UID ranges.
  type UidPool = [UidRange]
  
  -- | The iallocator parameters type.
  type IAllocatorParams = Container JSValue
  
  -- | The master candidate client certificate digests
  type CandidateCertificates = Container 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                  |]
    , optionalField $
      simpleField "volume_group_name"              [t| String                  |]
    , simpleField "reserved_lvs"                   [t| [String]                |]
    , optionalField $
      simpleField "drbd_usermode_helper"           [t| String                  |]
    , simpleField "master_node"                    [t| String                  |]
    , simpleField "master_ip"                      [t| String                  |]
    , simpleField "master_netdev"                  [t| String                  |]
    , simpleField "master_netmask"                 [t| Int                     |]
    , simpleField "use_external_mip_script"        [t| Bool                    |]
    , simpleField "cluster_name"                   [t| String                  |]
    , simpleField "file_storage_dir"               [t| String                  |]
    , simpleField "shared_file_storage_dir"        [t| String                  |]
    , simpleField "gluster_storage_dir"            [t| String                  |]
    , simpleField "enabled_hypervisors"            [t| [Hypervisor]            |]
    , simpleField "hvparams"                       [t| ClusterHvParams         |]
    , simpleField "os_hvp"                         [t| OsHvParams              |]
    , simpleField "beparams"                       [t| ClusterBeParams         |]
    , simpleField "osparams"                       [t| ClusterOsParams         |]
    , simpleField "osparams_private_cluster"       [t| ClusterOsParamsPrivate  |]
    , simpleField "nicparams"                      [t| ClusterNicParams        |]
    , simpleField "ndparams"                       [t| FilledNDParams          |]
    , simpleField "diskparams"                     [t| GroupDiskParams         |]
    , simpleField "candidate_pool_size"            [t| Int                     |]
    , simpleField "modify_etc_hosts"               [t| Bool                    |]
    , simpleField "modify_ssh_setup"               [t| Bool                    |]
    , simpleField "maintain_node_health"           [t| Bool                    |]
    , simpleField "uid_pool"                       [t| UidPool                 |]
    , simpleField "default_iallocator"             [t| String                  |]
    , simpleField "default_iallocator_params"      [t| IAllocatorParams        |]
    , simpleField "hidden_os"                      [t| [String]                |]
    , simpleField "blacklisted_os"                 [t| [String]                |]
    , simpleField "primary_ip_family"              [t| IpFamily                |]
    , simpleField "prealloc_wipe_disks"            [t| Bool                    |]
    , simpleField "ipolicy"                        [t| FilledIPolicy           |]
    , defaultField [| emptyContainer |] $
      simpleField "hv_state_static"                [t| HypervisorState        |]
    , defaultField [| emptyContainer |] $
      simpleField "disk_state_static"              [t| DiskState              |]
    , simpleField "enabled_disk_templates"         [t| [DiskTemplate]          |]
    , simpleField "candidate_certs"                [t| CandidateCertificates   |]
    , simpleField "max_running_jobs"               [t| Int                     |]
    , simpleField "max_tracked_jobs"               [t| Int                     |]
    , simpleField "install_image"                  [t| String                  |]
    , simpleField "instance_communication_network" [t| String                  |]
    , simpleField "zeroing_image"                  [t| String                  |]
    , simpleField "compression_tools"              [t| [String]                |]
    , simpleField "enabled_user_shutdown"          [t| Bool                    |]
    , simpleField "data_collectors"         [t| Container DataCollectorConfig  |]
    , simpleField "ssh_key_type"                   [t| SshKeyType              |]
    , simpleField "ssh_key_bits"                   [t| Int                     |]
   ]
   ++ timeStampFields
   ++ uuidFields
   ++ serialFields
   ++ tagsFields)
  
  instance TimeStampObject Cluster where
    cTimeOf = clusterCtime
    mTimeOf = clusterMtime
  
  instance UuidObject Cluster where
    uuidOf = UTF8.toString . clusterUuid
  
  instance SerialNoObject Cluster where
    serialOf = clusterSerial
  
  instance TagsObject Cluster where
    tagsOf = clusterTags
  
  -- * ConfigData definitions
  
  $(buildObject "ConfigData" "config" $
  --  timeStampFields ++
    [ simpleField "version"    [t| Int                 |]
    , simpleField "cluster"    [t| Cluster             |]
    , simpleField "nodes"      [t| Container Node      |]
    , simpleField "nodegroups" [t| Container NodeGroup |]
    , simpleField "instances"  [t| Container Instance  |]
    , simpleField "networks"   [t| Container Network   |]
    , simpleField "disks"      [t| Container Disk      |]
    , simpleField "filters"    [t| Container FilterRule |]
    ]
    ++ timeStampFields
    ++ serialFields)
  
  instance SerialNoObject ConfigData where
    serialOf = configSerial
  
  instance TimeStampObject ConfigData where
    cTimeOf = configCtime
    mTimeOf = configMtime
  
  -- * Master network parameters
  
  $(buildObject "MasterNetworkParameters" "masterNetworkParameters"
    [ simpleField "uuid"      [t| String   |]
    , simpleField "ip"        [t| String   |]
    , simpleField "netmask"   [t| Int      |]
    , simpleField "netdev"    [t| String   |]
    , simpleField "ip_family" [t| IpFamily |]
    ])
  