5be8adfe5860ba130f1c0a0ed92ba13b54ec1b80
[ganeti-github.git] / src / Ganeti / Objects.hs
1 {-# LANGUAGE TemplateHaskell, FunctionalDependencies #-}
2
3 {-| Implementation of the Ganeti config objects.
4
5 -}
6
7 {-
8
9 Copyright (C) 2011, 2012, 2013, 2014 Google Inc.
10 All rights reserved.
11
12 Redistribution and use in source and binary forms, with or without
13 modification, are permitted provided that the following conditions are
14 met:
15
16 1. Redistributions of source code must retain the above copyright notice,
17 this list of conditions and the following disclaimer.
18
19 2. Redistributions in binary form must reproduce the above copyright
20 notice, this list of conditions and the following disclaimer in the
21 documentation and/or other materials provided with the distribution.
22
23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
24 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
25 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
27 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
30 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
31 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
35 -}
36
37 module Ganeti.Objects
38 ( HvParams
39 , OsParams
40 , OsParamsPrivate
41 , PartialNicParams(..)
42 , FilledNicParams(..)
43 , allNicParamFields
44 , PartialNic(..)
45 , FileDriver(..)
46 , DataCollectorConfig(..)
47 , DiskTemplate(..)
48 , PartialBeParams(..)
49 , FilledBeParams(..)
50 , PartialNDParams(..)
51 , FilledNDParams(..)
52 , allNDParamFields
53 , Node(..)
54 , AllocPolicy(..)
55 , FilledISpecParams(..)
56 , PartialISpecParams(..)
57 , allISpecParamFields
58 , MinMaxISpecs(..)
59 , FilledIPolicy(..)
60 , PartialIPolicy(..)
61 , GroupDiskParams
62 , NodeGroup(..)
63 , FilterAction(..)
64 , FilterPredicate(..)
65 , FilterRule(..)
66 , filterRuleOrder
67 , IpFamily(..)
68 , ipFamilyToRaw
69 , ipFamilyToVersion
70 , fillDict
71 , ClusterHvParams
72 , OsHvParams
73 , ClusterBeParams
74 , ClusterOsParams
75 , ClusterOsParamsPrivate
76 , ClusterNicParams
77 , UidPool
78 , formatUidRange
79 , UidRange
80 , Cluster(..)
81 , ConfigData(..)
82 , TimeStampObject(..) -- re-exported from Types
83 , UuidObject(..) -- re-exported from Types
84 , SerialNoObject(..) -- re-exported from Types
85 , TagsObject(..) -- re-exported from Types
86 , DictObject(..) -- re-exported from THH
87 , TagSet(..) -- re-exported from THH
88 , emptyTagSet -- re-exported from THH
89 , Network(..)
90 , AddressPool(..)
91 , Ip4Address()
92 , mkIp4Address
93 , Ip4Network()
94 , mkIp4Network
95 , ip4netAddr
96 , ip4netMask
97 , readIp4Address
98 , ip4AddressToList
99 , ip4AddressToNumber
100 , ip4AddressFromNumber
101 , nextIp4Address
102 , IAllocatorParams
103 , MasterNetworkParameters(..)
104 , module Ganeti.PartialParams
105 , module Ganeti.Objects.Disk
106 , module Ganeti.Objects.Instance
107 , module Ganeti.Objects.Maintenance
108 , FilledHvStateParams(..)
109 , PartialHvStateParams(..)
110 , allHvStateParamFields
111 , FilledHvState
112 , PartialHvState ) where
113
114 import Prelude ()
115 import Ganeti.Prelude
116
117 import Control.Arrow (first)
118 import Control.Monad.State
119 import qualified Data.ByteString.UTF8 as UTF8
120 import Data.List (foldl', intercalate)
121 import Data.Maybe
122 import qualified Data.Map as Map
123 import Data.Ord (comparing)
124 import Data.Ratio (numerator, denominator)
125 import Data.Tuple (swap)
126 import Data.Word
127 import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString,
128 toJSString)
129 import qualified Text.JSON as J
130
131 import qualified AutoConf
132 import qualified Ganeti.Constants as C
133 import qualified Ganeti.ConstantUtils as ConstantUtils
134 import Ganeti.JSON (DictObject(..), Container, emptyContainer, GenericContainer)
135 import Ganeti.Objects.BitArray (BitArray)
136 import Ganeti.Objects.Disk
137 import Ganeti.Objects.Maintenance
138 import Ganeti.Objects.Nic
139 import Ganeti.Objects.Instance
140 import Ganeti.Objects.HvState
141 import Ganeti.Query.Language
142 import Ganeti.PartialParams
143 import Ganeti.Types
144 import Ganeti.THH
145 import Ganeti.THH.Field
146 import Ganeti.Utils (sepSplit, tryRead)
147
148 -- * Generic definitions
149
150 -- | Fills one map with keys from the other map, if not already
151 -- existing. Mirrors objects.py:FillDict.
152 fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v
153 fillDict defaults custom skip_keys =
154 let updated = Map.union custom defaults
155 in foldl' (flip Map.delete) updated skip_keys
156
157
158 -- * Network definitions
159
160 -- ** Ipv4 types
161
162 data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
163 deriving (Eq, Ord)
164
165 mkIp4Address :: (Word8, Word8, Word8, Word8) -> Ip4Address
166 mkIp4Address (a, b, c, d) = Ip4Address a b c d
167
168 instance Show Ip4Address where
169 show (Ip4Address a b c d) = intercalate "." $ map show [a, b, c, d]
170
171 readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address
172 readIp4Address s =
173 case sepSplit '.' s of
174 [a, b, c, d] -> Ip4Address <$>
175 tryRead "first octect" a <*>
176 tryRead "second octet" b <*>
177 tryRead "third octet" c <*>
178 tryRead "fourth octet" d
179 _ -> fail $ "Can't parse IPv4 address from string " ++ s
180
181 instance JSON Ip4Address where
182 showJSON = showJSON . show
183 readJSON (JSString s) = readIp4Address (fromJSString s)
184 readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address"
185
186 -- Converts an address to a list of numbers
187 ip4AddressToList :: Ip4Address -> [Word8]
188 ip4AddressToList (Ip4Address a b c d) = [a, b, c, d]
189
190 -- | Converts an address into its ordinal number.
191 -- This is needed for indexing IP adresses in reservation pools.
192 ip4AddressToNumber :: Ip4Address -> Integer
193 ip4AddressToNumber = foldl (\n i -> 256 * n + toInteger i) 0 . ip4AddressToList
194
195 -- | Converts a number into an address.
196 -- This is needed for indexing IP adresses in reservation pools.
197 ip4AddressFromNumber :: Integer -> Ip4Address
198 ip4AddressFromNumber n =
199 let s = state $ first fromInteger . swap . (`divMod` 256)
200 (d, c, b, a) = evalState ((,,,) <$> s <*> s <*> s <*> s) n
201 in Ip4Address a b c d
202
203 nextIp4Address :: Ip4Address -> Ip4Address
204 nextIp4Address = ip4AddressFromNumber . (+ 1) . ip4AddressToNumber
205
206 -- | Custom type for an IPv4 network.
207 data Ip4Network = Ip4Network { ip4netAddr :: Ip4Address
208 , ip4netMask :: Word8
209 }
210 deriving (Eq)
211
212 mkIp4Network :: Ip4Address -> Word8 -> Ip4Network
213 mkIp4Network = Ip4Network
214
215 instance Show Ip4Network where
216 show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask
217
218 -- | JSON instance for 'Ip4Network'.
219 instance JSON Ip4Network where
220 showJSON = showJSON . show
221 readJSON (JSString s) =
222 case sepSplit '/' (fromJSString s) of
223 [ip, nm] -> do
224 ip' <- readIp4Address ip
225 nm' <- tryRead "parsing netmask" nm
226 if nm' >= 0 && nm' <= 32
227 then return $ Ip4Network ip' nm'
228 else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++
229 fromJSString s
230 _ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s
231 readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network"
232
233 -- ** Address pools
234
235 -- | Currently address pools just wrap a reservation 'BitArray'.
236 --
237 -- In future, 'Network' might be extended to include several address pools
238 -- and address pools might include their own ranges of addresses.
239 newtype AddressPool = AddressPool { apReservations :: BitArray }
240 deriving (Eq, Ord, Show)
241
242 instance JSON AddressPool where
243 showJSON = showJSON . apReservations
244 readJSON = liftM AddressPool . readJSON
245
246 -- ** Ganeti \"network\" config object.
247
248 -- FIXME: Not all types might be correct here, since they
249 -- haven't been exhaustively deduced from the python code yet.
250 --
251 -- FIXME: When parsing, check that the ext_reservations and reservations
252 -- have the same length
253 $(buildObject "Network" "network" $
254 [ simpleField "name" [t| NonEmptyString |]
255 , optionalField $
256 simpleField "mac_prefix" [t| String |]
257 , simpleField "network" [t| Ip4Network |]
258 , optionalField $
259 simpleField "network6" [t| String |]
260 , optionalField $
261 simpleField "gateway" [t| Ip4Address |]
262 , optionalField $
263 simpleField "gateway6" [t| String |]
264 , optionalField $
265 simpleField "reservations" [t| AddressPool |]
266 , optionalField $
267 simpleField "ext_reservations" [t| AddressPool |]
268 ]
269 ++ uuidFields
270 ++ timeStampFields
271 ++ serialFields
272 ++ tagsFields)
273
274 instance SerialNoObject Network where
275 serialOf = networkSerial
276
277 instance TagsObject Network where
278 tagsOf = networkTags
279
280 instance UuidObject Network where
281 uuidOf = UTF8.toString . networkUuid
282
283 instance TimeStampObject Network where
284 cTimeOf = networkCtime
285 mTimeOf = networkMtime
286
287
288 -- * Datacollector definitions
289 type MicroSeconds = Integer
290
291 -- | The configuration regarding a single data collector.
292 $(buildObject "DataCollectorConfig" "dataCollector" [
293 simpleField "active" [t| Bool|],
294 simpleField "interval" [t| MicroSeconds |]
295 ])
296
297 -- | Central default values of the data collector config.
298 instance Monoid DataCollectorConfig where
299 mempty = DataCollectorConfig
300 { dataCollectorActive = True
301 , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval
302 }
303 mappend _ a = a
304
305 -- * IPolicy definitions
306
307 $(buildParam "ISpec" "ispec"
308 [ simpleField ConstantUtils.ispecMemSize [t| Int |]
309 , simpleField ConstantUtils.ispecDiskSize [t| Int |]
310 , simpleField ConstantUtils.ispecDiskCount [t| Int |]
311 , simpleField ConstantUtils.ispecCpuCount [t| Int |]
312 , simpleField ConstantUtils.ispecNicCount [t| Int |]
313 , simpleField ConstantUtils.ispecSpindleUse [t| Int |]
314 ])
315
316 $(buildObject "MinMaxISpecs" "mmis"
317 [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |]
318 , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |]
319 ])
320
321 -- | Custom partial ipolicy. This is not built via buildParam since it
322 -- has a special 2-level inheritance mode.
323 $(buildObject "PartialIPolicy" "ipolicy"
324 [ optionalField . renameField "MinMaxISpecsP" $
325 simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
326 , optionalField . renameField "StdSpecP" $
327 simpleField "std" [t| PartialISpecParams |]
328 , optionalField . renameField "SpindleRatioP" $
329 simpleField "spindle-ratio" [t| Double |]
330 , optionalField . renameField "MemoryRatioP" $
331 simpleField "memory-ratio" [t| Double |]
332 , optionalField . renameField "VcpuRatioP" $
333 simpleField "vcpu-ratio" [t| Double |]
334 , optionalField . renameField "DiskTemplatesP" $
335 simpleField "disk-templates" [t| [DiskTemplate] |]
336 ])
337
338 -- | Custom filled ipolicy. This is not built via buildParam since it
339 -- has a special 2-level inheritance mode.
340 $(buildObject "FilledIPolicy" "ipolicy"
341 [ renameField "MinMaxISpecs" $
342 simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |]
343 , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |]
344 , simpleField "spindle-ratio" [t| Double |]
345 , defaultField [| ConstantUtils.ipolicyDefaultsMemoryRatio |] $
346 simpleField "memory-ratio" [t| Double |]
347 , simpleField "vcpu-ratio" [t| Double |]
348 , simpleField "disk-templates" [t| [DiskTemplate] |]
349 ])
350
351 -- | Custom filler for the ipolicy types.
352 instance PartialParams FilledIPolicy PartialIPolicy where
353 fillParams
354 (FilledIPolicy { ipolicyMinMaxISpecs = fminmax
355 , ipolicyStdSpec = fstd
356 , ipolicySpindleRatio = fspindleRatio
357 , ipolicyMemoryRatio = fmemoryRatio
358 , ipolicyVcpuRatio = fvcpuRatio
359 , ipolicyDiskTemplates = fdiskTemplates})
360 (PartialIPolicy { ipolicyMinMaxISpecsP = pminmax
361 , ipolicyStdSpecP = pstd
362 , ipolicySpindleRatioP = pspindleRatio
363 , ipolicyMemoryRatioP = pmemoryRatio
364 , ipolicyVcpuRatioP = pvcpuRatio
365 , ipolicyDiskTemplatesP = pdiskTemplates}) =
366 FilledIPolicy
367 { ipolicyMinMaxISpecs = fromMaybe fminmax pminmax
368 , ipolicyStdSpec = maybe fstd (fillParams fstd) pstd
369 , ipolicySpindleRatio = fromMaybe fspindleRatio pspindleRatio
370 , ipolicyMemoryRatio = fromMaybe fmemoryRatio pmemoryRatio
371 , ipolicyVcpuRatio = fromMaybe fvcpuRatio pvcpuRatio
372 , ipolicyDiskTemplates = fromMaybe fdiskTemplates
373 pdiskTemplates
374 }
375 toPartial (FilledIPolicy { ipolicyMinMaxISpecs = fminmax
376 , ipolicyStdSpec = fstd
377 , ipolicySpindleRatio = fspindleRatio
378 , ipolicyMemoryRatio = fmemoryRatio
379 , ipolicyVcpuRatio = fvcpuRatio
380 , ipolicyDiskTemplates = fdiskTemplates}) =
381 PartialIPolicy
382 { ipolicyMinMaxISpecsP = Just fminmax
383 , ipolicyStdSpecP = Just $ toPartial fstd
384 , ipolicySpindleRatioP = Just fspindleRatio
385 , ipolicyMemoryRatioP = Just fmemoryRatio
386 , ipolicyVcpuRatioP = Just fvcpuRatio
387 , ipolicyDiskTemplatesP = Just fdiskTemplates
388 }
389 toFilled (PartialIPolicy { ipolicyMinMaxISpecsP = pminmax
390 , ipolicyStdSpecP = pstd
391 , ipolicySpindleRatioP = pspindleRatio
392 , ipolicyMemoryRatioP = pmemoryRatio
393 , ipolicyVcpuRatioP = pvcpuRatio
394 , ipolicyDiskTemplatesP = pdiskTemplates}) =
395 FilledIPolicy <$> pminmax <*> (toFilled =<< pstd) <*> pspindleRatio
396 <*> pmemoryRatio <*> pvcpuRatio <*> pdiskTemplates
397
398 -- | Disk state parameters.
399 --
400 -- As according to the documentation this option is unused by Ganeti,
401 -- the content is just a 'JSValue'.
402 type DiskState = Container JSValue
403
404 -- * Node definitions
405
406 $(buildParam "ND" "ndp"
407 [ simpleField "oob_program" [t| String |]
408 , simpleField "spindle_count" [t| Int |]
409 , simpleField "exclusive_storage" [t| Bool |]
410 , simpleField "ovs" [t| Bool |]
411 , simpleField "ovs_name" [t| String |]
412 , simpleField "ovs_link" [t| String |]
413 , simpleField "ssh_port" [t| Int |]
414 , simpleField "cpu_speed" [t| Double |]
415 ])
416
417 $(buildObject "Node" "node" $
418 [ simpleField "name" [t| String |]
419 , simpleField "primary_ip" [t| String |]
420 , simpleField "secondary_ip" [t| String |]
421 , simpleField "master_candidate" [t| Bool |]
422 , simpleField "offline" [t| Bool |]
423 , simpleField "drained" [t| Bool |]
424 , simpleField "group" [t| String |]
425 , simpleField "master_capable" [t| Bool |]
426 , simpleField "vm_capable" [t| Bool |]
427 , simpleField "ndparams" [t| PartialNDParams |]
428 , simpleField "powered" [t| Bool |]
429 , notSerializeDefaultField [| emptyContainer |] $
430 simpleField "hv_state_static" [t| PartialHvState |]
431 , notSerializeDefaultField [| emptyContainer |] $
432 simpleField "disk_state_static" [t| DiskState |]
433 ]
434 ++ timeStampFields
435 ++ uuidFields
436 ++ serialFields
437 ++ tagsFields)
438
439 instance TimeStampObject Node where
440 cTimeOf = nodeCtime
441 mTimeOf = nodeMtime
442
443 instance UuidObject Node where
444 uuidOf = UTF8.toString . nodeUuid
445
446 instance SerialNoObject Node where
447 serialOf = nodeSerial
448
449 instance TagsObject Node where
450 tagsOf = nodeTags
451
452 -- * NodeGroup definitions
453
454 -- | The cluster/group disk parameters type.
455 type GroupDiskParams = Container DiskParams
456
457 -- | A mapping from network UUIDs to nic params of the networks.
458 type Networks = Container PartialNicParams
459
460 $(buildObject "NodeGroup" "group" $
461 [ simpleField "name" [t| String |]
462 , defaultField [| [] |] $ simpleField "members" [t| [String] |]
463 , simpleField "ndparams" [t| PartialNDParams |]
464 , simpleField "alloc_policy" [t| AllocPolicy |]
465 , simpleField "ipolicy" [t| PartialIPolicy |]
466 , simpleField "diskparams" [t| GroupDiskParams |]
467 , simpleField "networks" [t| Networks |]
468 , notSerializeDefaultField [| emptyContainer |] $
469 simpleField "hv_state_static" [t| PartialHvState |]
470 , notSerializeDefaultField [| emptyContainer |] $
471 simpleField "disk_state_static" [t| DiskState |]
472 ]
473 ++ timeStampFields
474 ++ uuidFields
475 ++ serialFields
476 ++ tagsFields)
477
478 instance TimeStampObject NodeGroup where
479 cTimeOf = groupCtime
480 mTimeOf = groupMtime
481
482 instance UuidObject NodeGroup where
483 uuidOf = UTF8.toString . groupUuid
484
485 instance SerialNoObject NodeGroup where
486 serialOf = groupSerial
487
488 instance TagsObject NodeGroup where
489 tagsOf = groupTags
490
491 -- * Job scheduler filtering definitions
492
493 -- | Actions that can be performed when a filter matches.
494 data FilterAction
495 = Accept
496 | Pause
497 | Reject
498 | Continue
499 | RateLimit Int
500 deriving (Eq, Ord, Show)
501
502 instance JSON FilterAction where
503 showJSON fa = case fa of
504 Accept -> JSString (toJSString "ACCEPT")
505 Pause -> JSString (toJSString "PAUSE")
506 Reject -> JSString (toJSString "REJECT")
507 Continue -> JSString (toJSString "CONTINUE")
508 RateLimit n -> JSArray [ JSString (toJSString "RATE_LIMIT")
509 , JSRational False (fromIntegral n)
510 ]
511 readJSON v = case v of
512 -- `FilterAction`s are case-sensitive.
513 JSString s | fromJSString s == "ACCEPT" -> return Accept
514 JSString s | fromJSString s == "PAUSE" -> return Pause
515 JSString s | fromJSString s == "REJECT" -> return Reject
516 JSString s | fromJSString s == "CONTINUE" -> return Continue
517 JSArray (JSString s : rest) | fromJSString s == "RATE_LIMIT" ->
518 case rest of
519 [JSRational False n] | denominator n == 1 && numerator n > 0 ->
520 return . RateLimit . fromIntegral $ numerator n
521 _ -> fail "RATE_LIMIT argument must be a positive integer"
522 x -> fail $ "malformed FilterAction JSON: " ++ J.showJSValue x ""
523
524
525 data FilterPredicate
526 = FPJobId (Filter FilterField)
527 | FPOpCode (Filter FilterField)
528 | FPReason (Filter FilterField)
529 | FPUser (Filter FilterField)
530 deriving (Eq, Ord, Show)
531
532
533 instance JSON FilterPredicate where
534 showJSON fp = case fp of
535 FPJobId expr -> JSArray [string "jobid", showJSON expr]
536 FPOpCode expr -> JSArray [string "opcode", showJSON expr]
537 FPReason expr -> JSArray [string "reason", showJSON expr]
538 FPUser expr -> JSArray [string "user", showJSON expr]
539 where
540 string = JSString . toJSString
541
542 readJSON v = case v of
543 -- Predicate names are case-sensitive.
544 JSArray [JSString name, expr]
545 | name == toJSString "jobid" -> FPJobId <$> readJSON expr
546 | name == toJSString "opcode" -> FPOpCode <$> readJSON expr
547 | name == toJSString "reason" -> FPReason <$> readJSON expr
548 | name == toJSString "user" -> FPUser <$> readJSON expr
549 JSArray (JSString name:params) ->
550 fail $ "malformed FilterPredicate: bad parameter list for\
551 \ '" ++ fromJSString name ++ "' predicate: "
552 ++ J.showJSArray params ""
553 _ -> fail "malformed FilterPredicate: must be a list with the first\
554 \ entry being a string describing the predicate type"
555
556
557 $(buildObject "FilterRule" "fr" $
558 [ simpleField "watermark" [t| JobId |]
559 , simpleField "priority" [t| NonNegative Int |]
560 , simpleField "predicates" [t| [FilterPredicate] |]
561 , simpleField "action" [t| FilterAction |]
562 , simpleField "reason_trail" [t| ReasonTrail |]
563 ]
564 ++ uuidFields)
565
566 instance UuidObject FilterRule where
567 uuidOf = UTF8.toString . frUuid
568
569
570 -- | Order in which filter rules are evaluated, according to
571 -- `doc/design-optables.rst`.
572 -- For `FilterRule` fields not specified as important for the order,
573 -- we choose an arbitrary ordering effect (after the ones from the spec).
574 --
575 -- The `Ord` instance for `FilterRule` agrees with this function.
576 -- Yet it is recommended to use this function instead of `compare` to be
577 -- explicit that the spec order is used.
578 filterRuleOrder :: FilterRule -> FilterRule -> Ordering
579 filterRuleOrder = compare
580
581
582 instance Ord FilterRule where
583 -- It is important that the Ord instance respects the ordering given in
584 -- `doc/design-optables.rst` for the fields defined in there. The other
585 -- fields may be ordered arbitrarily.
586 -- Use `filterRuleOrder` when relying on the spec order.
587 compare =
588 comparing $ \(FilterRule watermark prio predicates action reason uuid) ->
589 ( prio, watermark, uuid -- spec part
590 , predicates, action, reason -- arbitrary part
591 )
592
593
594 -- | IP family type
595 $(declareIADT "IpFamily"
596 [ ("IpFamilyV4", 'AutoConf.pyAfInet4)
597 , ("IpFamilyV6", 'AutoConf.pyAfInet6)
598 ])
599 $(makeJSONInstance ''IpFamily)
600
601 -- | Conversion from IP family to IP version. This is needed because
602 -- Python uses both, depending on context.
603 ipFamilyToVersion :: IpFamily -> Int
604 ipFamilyToVersion IpFamilyV4 = C.ip4Version
605 ipFamilyToVersion IpFamilyV6 = C.ip6Version
606
607 -- | Cluster HvParams (hvtype to hvparams mapping).
608 type ClusterHvParams = GenericContainer Hypervisor HvParams
609
610 -- | Cluster Os-HvParams (os to hvparams mapping).
611 type OsHvParams = Container ClusterHvParams
612
613 -- | Cluser BeParams.
614 type ClusterBeParams = Container FilledBeParams
615
616 -- | Cluster OsParams.
617 type ClusterOsParams = Container OsParams
618 type ClusterOsParamsPrivate = Container (Private OsParams)
619
620 -- | Cluster NicParams.
621 type ClusterNicParams = Container FilledNicParams
622
623 -- | A low-high UID ranges.
624 type UidRange = (Int, Int)
625
626 formatUidRange :: UidRange -> String
627 formatUidRange (lower, higher)
628 | lower == higher = show lower
629 | otherwise = show lower ++ "-" ++ show higher
630
631 -- | Cluster UID Pool, list (low, high) UID ranges.
632 type UidPool = [UidRange]
633
634 -- | The iallocator parameters type.
635 type IAllocatorParams = Container JSValue
636
637 -- | The master candidate client certificate digests
638 type CandidateCertificates = Container String
639
640 -- * Cluster definitions
641 $(buildObject "Cluster" "cluster" $
642 [ simpleField "rsahostkeypub" [t| String |]
643 , optionalField $
644 simpleField "dsahostkeypub" [t| String |]
645 , simpleField "highest_used_port" [t| Int |]
646 , simpleField "tcpudp_port_pool" [t| [Int] |]
647 , simpleField "mac_prefix" [t| String |]
648 , optionalField $
649 simpleField "volume_group_name" [t| String |]
650 , simpleField "reserved_lvs" [t| [String] |]
651 , optionalField $
652 simpleField "drbd_usermode_helper" [t| String |]
653 , simpleField "master_node" [t| String |]
654 , simpleField "master_ip" [t| String |]
655 , simpleField "master_netdev" [t| String |]
656 , simpleField "master_netmask" [t| Int |]
657 , simpleField "use_external_mip_script" [t| Bool |]
658 , simpleField "cluster_name" [t| String |]
659 , simpleField "file_storage_dir" [t| String |]
660 , simpleField "shared_file_storage_dir" [t| String |]
661 , simpleField "gluster_storage_dir" [t| String |]
662 , simpleField "enabled_hypervisors" [t| [Hypervisor] |]
663 , simpleField "hvparams" [t| ClusterHvParams |]
664 , simpleField "os_hvp" [t| OsHvParams |]
665 , simpleField "beparams" [t| ClusterBeParams |]
666 , simpleField "osparams" [t| ClusterOsParams |]
667 , simpleField "osparams_private_cluster" [t| ClusterOsParamsPrivate |]
668 , simpleField "nicparams" [t| ClusterNicParams |]
669 , simpleField "ndparams" [t| FilledNDParams |]
670 , simpleField "diskparams" [t| GroupDiskParams |]
671 , simpleField "candidate_pool_size" [t| Int |]
672 , simpleField "modify_etc_hosts" [t| Bool |]
673 , simpleField "modify_ssh_setup" [t| Bool |]
674 , simpleField "maintain_node_health" [t| Bool |]
675 , simpleField "uid_pool" [t| UidPool |]
676 , simpleField "default_iallocator" [t| String |]
677 , simpleField "default_iallocator_params" [t| IAllocatorParams |]
678 , simpleField "hidden_os" [t| [String] |]
679 , simpleField "blacklisted_os" [t| [String] |]
680 , simpleField "primary_ip_family" [t| IpFamily |]
681 , simpleField "prealloc_wipe_disks" [t| Bool |]
682 , simpleField "ipolicy" [t| FilledIPolicy |]
683 , notSerializeDefaultField [| emptyContainer |] $
684 simpleField "hv_state_static" [t| FilledHvState |]
685 , notSerializeDefaultField [| emptyContainer |] $
686 simpleField "disk_state_static" [t| DiskState |]
687 , simpleField "enabled_disk_templates" [t| [DiskTemplate] |]
688 , simpleField "candidate_certs" [t| CandidateCertificates |]
689 , simpleField "max_running_jobs" [t| Int |]
690 , simpleField "max_tracked_jobs" [t| Int |]
691 , simpleField "install_image" [t| String |]
692 , simpleField "instance_communication_network" [t| String |]
693 , simpleField "zeroing_image" [t| String |]
694 , simpleField "compression_tools" [t| [String] |]
695 , simpleField "enabled_user_shutdown" [t| Bool |]
696 , simpleField "data_collectors" [t| Container DataCollectorConfig |]
697 , defaultField [| [] |] $ simpleField
698 "diagnose_data_collector_filename" [t| String |]
699 , simpleField "ssh_key_type" [t| SshKeyType |]
700 , simpleField "ssh_key_bits" [t| Int |]
701 ]
702 ++ timeStampFields
703 ++ uuidFields
704 ++ serialFields
705 ++ tagsFields)
706
707 instance TimeStampObject Cluster where
708 cTimeOf = clusterCtime
709 mTimeOf = clusterMtime
710
711 instance UuidObject Cluster where
712 uuidOf = UTF8.toString . clusterUuid
713
714 instance SerialNoObject Cluster where
715 serialOf = clusterSerial
716
717 instance TagsObject Cluster where
718 tagsOf = clusterTags
719
720 -- * ConfigData definitions
721
722 $(buildObject "ConfigData" "config" $
723 [ simpleField "version" [t| Int |]
724 , simpleField "cluster" [t| Cluster |]
725 , simpleField "nodes" [t| Container Node |]
726 , simpleField "nodegroups" [t| Container NodeGroup |]
727 , simpleField "instances" [t| Container Instance |]
728 , simpleField "networks" [t| Container Network |]
729 , simpleField "disks" [t| Container Disk |]
730 , simpleField "filters" [t| Container FilterRule |]
731 , simpleField "maintenance" [t| MaintenanceData |]
732 ]
733 ++ timeStampFields
734 ++ serialFields)
735
736 instance SerialNoObject ConfigData where
737 serialOf = configSerial
738
739 instance TimeStampObject ConfigData where
740 cTimeOf = configCtime
741 mTimeOf = configMtime
742
743 -- * Master network parameters
744
745 $(buildObject "MasterNetworkParameters" "masterNetworkParameters"
746 [ simpleField "uuid" [t| String |]
747 , simpleField "ip" [t| String |]
748 , simpleField "netmask" [t| Int |]
749 , simpleField "netdev" [t| String |]
750 , simpleField "ip_family" [t| IpFamily |]
751 ])