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