Merge branch 'stable-2.12' into stable-2.13
[ganeti-github.git] / src / Ganeti / Objects.hs
index c99c1c2..4bbf5b6 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, StandaloneDeriving #-}
 
 {-| Implementation of the Ganeti config objects.
 
@@ -48,6 +48,7 @@ module Ganeti.Objects
   , PartialNic(..)
   , FileDriver(..)
   , DRBDSecret
+  , DataCollectorConfig(..)
   , LogicalVolume(..)
   , DiskLogicalId(..)
   , Disk(..)
@@ -74,6 +75,10 @@ module Ganeti.Objects
   , fillIPolicy
   , GroupDiskParams
   , NodeGroup(..)
+  , FilterAction(..)
+  , FilterPredicate(..)
+  , FilterRule(..)
+  , filterRuleOrder
   , IpFamily(..)
   , ipFamilyToRaw
   , ipFamilyToVersion
@@ -119,11 +124,15 @@ import Data.Char
 import Data.List (foldl', isPrefixOf, isInfixOf, intercalate)
 import Data.Maybe
 import qualified Data.Map as Map
+import Data.Monoid
+import Data.Ord (comparing)
+import Data.Ratio (numerator, denominator)
 import qualified Data.Set as Set
 import Data.Tuple (swap)
 import Data.Word
 import System.Time (ClockTime(..))
-import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
+import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString,
+                  toJSString)
 import qualified Text.JSON as J
 
 import qualified AutoConf
@@ -131,6 +140,7 @@ import qualified Ganeti.Constants as C
 import qualified Ganeti.ConstantUtils as ConstantUtils
 import Ganeti.JSON
 import Ganeti.Objects.BitArray (BitArray)
+import Ganeti.Query.Language
 import Ganeti.Types
 import Ganeti.THH
 import Ganeti.THH.Field
@@ -321,6 +331,23 @@ $(buildObject "PartialNic" "nic" $
 instance UuidObject PartialNic where
   uuidOf = nicUuid
 
+type MicroSeconds = Integer
+
+-- * Datacollector definitions
+-- | 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 Monoid DataCollectorConfig where
+  mempty = DataCollectorConfig
+    { dataCollectorActive = True
+    , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval
+    }
+  mappend _ a = a
+
 -- * Disk definitions
 
 -- | Constant for the dev_type key entry in the disk config.
@@ -770,6 +797,106 @@ instance SerialNoObject NodeGroup where
 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 = 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)
@@ -818,60 +945,61 @@ type CandidateCertificates = Container String
 
 -- * Cluster definitions
 $(buildObject "Cluster" "cluster" $
-  [ simpleField "rsahostkeypub"                  [t| String                 |]
+  [ 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 "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]               |]
+    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          |]
+    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 "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  |]
  ]
  ++ timeStampFields
  ++ uuidFields
@@ -902,6 +1030,7 @@ $(buildObject "ConfigData" "config" $
   , simpleField "instances"  [t| Container Instance  |]
   , simpleField "networks"   [t| Container Network   |]
   , simpleField "disks"      [t| Container Disk      |]
+  , simpleField "filters"    [t| Container FilterRule |]
   ]
   ++ timeStampFields
   ++ serialFields)