Merge branch 'stable-2.14' into stable-2.15
[ganeti-github.git] / src / Ganeti / Config.hs
1 {-# LANGUAGE ViewPatterns #-}
2
3 {-| Implementation of the Ganeti configuration database.
4
5 -}
6
7 {-
8
9 Copyright (C) 2011, 2012 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.Config
38 ( LinkIpMap
39 , NdParamObject(..)
40 , loadConfig
41 , saveConfig
42 , getNodeInstances
43 , getNodeRole
44 , getNodeNdParams
45 , getDefaultNicLink
46 , getDefaultHypervisor
47 , getInstancesIpByLink
48 , getMasterNodes
49 , getMasterCandidates
50 , getMasterOrCandidates
51 , getMasterNetworkParameters
52 , getOnlineNodes
53 , getNode
54 , getInstance
55 , getDisk
56 , getFilterRule
57 , getGroup
58 , getGroupNdParams
59 , getGroupIpolicy
60 , getGroupDiskParams
61 , getGroupNodes
62 , getGroupInstances
63 , getGroupOfNode
64 , getInstPrimaryNode
65 , getInstMinorsForNode
66 , getInstAllNodes
67 , getInstDisks
68 , getInstDisksFromObj
69 , getDrbdMinorsForDisk
70 , getDrbdMinorsForInstance
71 , getFilledInstHvParams
72 , getFilledInstBeParams
73 , getFilledInstOsParams
74 , getNetwork
75 , MAC
76 , getAllMACs
77 , getAllDrbdSecrets
78 , NodeLVsMap
79 , getInstanceLVsByNode
80 , getAllLVs
81 , buildLinkIpInstnameMap
82 , instNodes
83 ) where
84
85 import Control.Applicative
86 import Control.Arrow ((&&&))
87 import Control.Monad
88 import Control.Monad.State
89 import qualified Data.ByteString as BS
90 import qualified Data.ByteString.UTF8 as UTF8
91 import qualified Data.Foldable as F
92 import Data.List (foldl', nub)
93 import Data.Maybe (fromMaybe)
94 import Data.Monoid
95 import qualified Data.Map as M
96 import qualified Data.Set as S
97 import qualified Text.JSON as J
98 import System.IO
99
100 import Ganeti.BasicTypes
101 import qualified Ganeti.Constants as C
102 import Ganeti.Errors
103 import Ganeti.JSON
104 import Ganeti.Objects
105 import Ganeti.Types
106 import qualified Ganeti.Utils.MultiMap as MM
107
108 -- | Type alias for the link and ip map.
109 type LinkIpMap = M.Map String (M.Map String String)
110
111 -- * Operations on the whole configuration
112
113 -- | Reads the config file.
114 readConfig :: FilePath -> IO (Result String)
115 readConfig = runResultT . liftIO . readFile
116
117 -- | Parses the configuration file.
118 parseConfig :: String -> Result ConfigData
119 parseConfig = fromJResult "parsing configuration" . J.decodeStrict
120
121 -- | Encodes the configuration file.
122 encodeConfig :: ConfigData -> String
123 encodeConfig = J.encodeStrict
124
125 -- | Wrapper over 'readConfig' and 'parseConfig'.
126 loadConfig :: FilePath -> IO (Result ConfigData)
127 loadConfig = fmap (>>= parseConfig) . readConfig
128
129 -- | Wrapper over 'hPutStr' and 'encodeConfig'.
130 saveConfig :: Handle -> ConfigData -> IO ()
131 saveConfig fh = hPutStr fh . encodeConfig
132
133 -- * Query functions
134
135 -- | Annotate Nothing as missing parameter and apply the given
136 -- transformation otherwise
137 withMissingParam :: String -> (a -> ErrorResult b) -> Maybe a -> ErrorResult b
138 withMissingParam = maybe . Bad . ParameterError
139
140 -- | Computes the nodes covered by a disk.
141 computeDiskNodes :: Disk -> S.Set String
142 computeDiskNodes dsk =
143 case diskLogicalId dsk of
144 Just (LIDDrbd8 nodeA nodeB _ _ _ _) -> S.fromList [nodeA, nodeB]
145 _ -> S.empty
146
147 -- | Computes all disk-related nodes of an instance. For non-DRBD,
148 -- this will be empty, for DRBD it will contain both the primary and
149 -- the secondaries.
150 instDiskNodes :: ConfigData -> Instance -> S.Set String
151 instDiskNodes cfg inst =
152 case getInstDisksFromObj cfg inst of
153 Ok disks -> S.unions $ map computeDiskNodes disks
154 Bad _ -> S.empty
155
156 -- | Computes all nodes of an instance.
157 instNodes :: ConfigData -> Instance -> S.Set String
158 instNodes cfg inst = maybe id S.insert (instPrimaryNode inst)
159 $ instDiskNodes cfg inst
160
161 -- | Computes the secondary nodes of an instance. Since this is valid
162 -- only for DRBD, we call directly 'instDiskNodes', skipping over the
163 -- extra primary insert.
164 instSecondaryNodes :: ConfigData -> Instance -> S.Set String
165 instSecondaryNodes cfg inst =
166 maybe id S.delete (instPrimaryNode inst) $ instDiskNodes cfg inst
167
168 -- | Get instances of a given node.
169 -- The node is specified through its UUID.
170 getNodeInstances :: ConfigData -> String -> ([Instance], [Instance])
171 getNodeInstances cfg nname =
172 let all_inst = M.elems . fromContainer . configInstances $ cfg
173 pri_inst = filter ((== Just nname) . instPrimaryNode) all_inst
174 sec_inst = filter ((nname `S.member`) . instSecondaryNodes cfg) all_inst
175 in (pri_inst, sec_inst)
176
177 -- | Computes the role of a node.
178 getNodeRole :: ConfigData -> Node -> NodeRole
179 getNodeRole cfg node
180 | uuidOf node == clusterMasterNode (configCluster cfg) = NRMaster
181 | nodeMasterCandidate node = NRCandidate
182 | nodeDrained node = NRDrained
183 | nodeOffline node = NROffline
184 | otherwise = NRRegular
185
186 -- | Get the list of the master nodes (usually one).
187 getMasterNodes :: ConfigData -> [Node]
188 getMasterNodes cfg =
189 filter ((==) NRMaster . getNodeRole cfg) . F.toList . configNodes $ cfg
190
191 -- | Get the list of master candidates, /not including/ the master itself.
192 getMasterCandidates :: ConfigData -> [Node]
193 getMasterCandidates cfg =
194 filter ((==) NRCandidate . getNodeRole cfg) . F.toList . configNodes $ cfg
195
196 -- | Get the list of master candidates, /including/ the master.
197 getMasterOrCandidates :: ConfigData -> [Node]
198 getMasterOrCandidates cfg =
199 let isMC r = (r == NRCandidate) || (r == NRMaster)
200 in filter (isMC . getNodeRole cfg) . F.toList . configNodes $ cfg
201
202 -- | Get the network parameters for the master IP address.
203 getMasterNetworkParameters :: ConfigData -> MasterNetworkParameters
204 getMasterNetworkParameters cfg =
205 let cluster = configCluster cfg
206 in MasterNetworkParameters
207 { masterNetworkParametersUuid = clusterMasterNode cluster
208 , masterNetworkParametersIp = clusterMasterIp cluster
209 , masterNetworkParametersNetmask = clusterMasterNetmask cluster
210 , masterNetworkParametersNetdev = clusterMasterNetdev cluster
211 , masterNetworkParametersIpFamily = clusterPrimaryIpFamily cluster
212 }
213
214 -- | Get the list of online nodes.
215 getOnlineNodes :: ConfigData -> [Node]
216 getOnlineNodes = filter (not . nodeOffline) . F.toList . configNodes
217
218 -- | Returns the default cluster link.
219 getDefaultNicLink :: ConfigData -> String
220 getDefaultNicLink =
221 let ppDefault = UTF8.fromString C.ppDefault
222 in nicpLink . (M.! ppDefault) . fromContainer
223 . clusterNicparams . configCluster
224
225 -- | Returns the default cluster hypervisor.
226 getDefaultHypervisor :: ConfigData -> Hypervisor
227 getDefaultHypervisor cfg =
228 case clusterEnabledHypervisors $ configCluster cfg of
229 -- FIXME: this case shouldn't happen (configuration broken), but
230 -- for now we handle it here because we're not authoritative for
231 -- the config
232 [] -> XenPvm
233 x:_ -> x
234
235 -- | Returns instances of a given link.
236 getInstancesIpByLink :: LinkIpMap -> String -> [String]
237 getInstancesIpByLink linkipmap link =
238 M.keys $ M.findWithDefault M.empty link linkipmap
239
240 -- | Generic lookup function that converts from a possible abbreviated
241 -- name to a full name.
242 getItem :: String -> String -> M.Map String a -> ErrorResult a
243 getItem kind name allitems = do
244 let lresult = lookupName (M.keys allitems) name
245 err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
246 ECodeNoEnt
247 fullname <- case lrMatchPriority lresult of
248 PartialMatch -> Ok $ lrContent lresult
249 ExactMatch -> Ok $ lrContent lresult
250 MultipleMatch -> err "has multiple matches"
251 FailMatch -> err "not found"
252 maybe (err "not found after successfull match?!") Ok $
253 M.lookup fullname allitems
254
255 -- | Simple lookup function, insisting on exact matches and using
256 -- byte strings.
257 getItem' :: String -> String -> M.Map BS.ByteString a -> ErrorResult a
258 getItem' kind name allitems =
259 let name' = UTF8.fromString name
260 err = Bad $ OpPrereqError (kind ++ " uuid " ++ name ++ " not found")
261 ECodeNoEnt
262 in maybe err Ok $ M.lookup name' allitems
263
264 -- | Looks up a node by name or uuid.
265 getNode :: ConfigData -> String -> ErrorResult Node
266 getNode cfg name =
267 let nodes = fromContainer (configNodes cfg)
268 in case getItem' "Node" name nodes of
269 -- if not found by uuid, we need to look it up by name
270 Ok node -> Ok node
271 Bad _ -> let by_name = M.mapKeys
272 (nodeName . (M.!) nodes) nodes
273 in getItem "Node" name by_name
274
275 -- | Looks up an instance by name or uuid.
276 getInstance :: ConfigData -> String -> ErrorResult Instance
277 getInstance cfg name =
278 let instances = fromContainer (configInstances cfg)
279 in case getItem' "Instance" name instances of
280 -- if not found by uuid, we need to look it up by name
281 Ok inst -> Ok inst
282 Bad _ -> let by_name =
283 M.delete ""
284 . M.mapKeys (fromMaybe "" . instName . (M.!) instances)
285 $ instances
286 in getItem "Instance" name by_name
287
288 -- | Looks up a disk by uuid.
289 getDisk :: ConfigData -> String -> ErrorResult Disk
290 getDisk cfg name =
291 let disks = fromContainer (configDisks cfg)
292 in getItem' "Disk" name disks
293
294 -- | Looks up a filter by uuid.
295 getFilterRule :: ConfigData -> String -> ErrorResult FilterRule
296 getFilterRule cfg name =
297 let filters = fromContainer (configFilters cfg)
298 in getItem' "Filter" name filters
299
300 -- | Looks up a node group by name or uuid.
301 getGroup :: ConfigData -> String -> ErrorResult NodeGroup
302 getGroup cfg name =
303 let groups = fromContainer (configNodegroups cfg)
304 in case getItem' "NodeGroup" name groups of
305 -- if not found by uuid, we need to look it up by name, slow
306 Ok grp -> Ok grp
307 Bad _ -> let by_name = M.mapKeys
308 (groupName . (M.!) groups) groups
309 in getItem "NodeGroup" name by_name
310
311 -- | Computes a node group's node params.
312 getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
313 getGroupNdParams cfg ng =
314 fillParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
315
316 -- | Computes a node group's ipolicy.
317 getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
318 getGroupIpolicy cfg ng =
319 fillParams (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
320
321 -- | Computes a group\'s (merged) disk params.
322 getGroupDiskParams :: ConfigData -> NodeGroup -> GroupDiskParams
323 getGroupDiskParams cfg ng =
324 GenericContainer $
325 fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
326 (fromContainer $ groupDiskparams ng) []
327
328 -- | Get nodes of a given node group.
329 getGroupNodes :: ConfigData -> String -> [Node]
330 getGroupNodes cfg gname =
331 let all_nodes = M.elems . fromContainer . configNodes $ cfg in
332 filter ((==gname) . nodeGroup) all_nodes
333
334 -- | Get (primary, secondary) instances of a given node group.
335 getGroupInstances :: ConfigData -> String -> ([Instance], [Instance])
336 getGroupInstances cfg gname =
337 let gnodes = map uuidOf (getGroupNodes cfg gname)
338 ginsts = map (getNodeInstances cfg) gnodes in
339 (concatMap fst ginsts, concatMap snd ginsts)
340
341 -- | Retrieves the instance hypervisor params, missing values filled with
342 -- cluster defaults.
343 getFilledInstHvParams :: [String] -> ConfigData -> Instance -> HvParams
344 getFilledInstHvParams globals cfg inst =
345 -- First get the defaults of the parent
346 let maybeHvName = instHypervisor inst
347 hvParamMap = fromContainer . clusterHvparams $ configCluster cfg
348 parentHvParams =
349 maybe M.empty fromContainer (maybeHvName >>= flip M.lookup hvParamMap)
350 -- Then the os defaults for the given hypervisor
351 maybeOsName = UTF8.fromString <$> instOs inst
352 osParamMap = fromContainer . clusterOsHvp $ configCluster cfg
353 osHvParamMap =
354 maybe M.empty (maybe M.empty fromContainer . flip M.lookup osParamMap)
355 maybeOsName
356 osHvParams =
357 maybe M.empty (maybe M.empty fromContainer . flip M.lookup osHvParamMap)
358 maybeHvName
359 -- Then the child
360 childHvParams = fromContainer . instHvparams $ inst
361 -- Helper function
362 fillFn con val = fillDict con val $ fmap UTF8.fromString globals
363 in GenericContainer $ fillFn (fillFn parentHvParams osHvParams) childHvParams
364
365 -- | Retrieves the instance backend params, missing values filled with cluster
366 -- defaults.
367 getFilledInstBeParams :: ConfigData -> Instance -> ErrorResult FilledBeParams
368 getFilledInstBeParams cfg inst = do
369 let beParamMap = fromContainer . clusterBeparams . configCluster $ cfg
370 parentParams <- getItem' "FilledBeParams" C.ppDefault beParamMap
371 return $ fillParams parentParams (instBeparams inst)
372
373 -- | Retrieves the instance os params, missing values filled with cluster
374 -- defaults. This does NOT include private and secret parameters.
375 getFilledInstOsParams :: ConfigData -> Instance -> OsParams
376 getFilledInstOsParams cfg inst =
377 let maybeOsLookupName = liftM (takeWhile (/= '+')) (instOs inst)
378 osParamMap = fromContainer . clusterOsparams $ configCluster cfg
379 childOsParams = instOsparams inst
380 in case withMissingParam "Instance without OS"
381 (flip (getItem' "OsParams") osParamMap)
382 maybeOsLookupName of
383 Ok parentOsParams -> GenericContainer $
384 fillDict (fromContainer parentOsParams)
385 (fromContainer childOsParams) []
386 Bad _ -> childOsParams
387
388 -- | Looks up an instance's primary node.
389 getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
390 getInstPrimaryNode cfg name =
391 getInstance cfg name
392 >>= withMissingParam "Instance without primary node" return . instPrimaryNode
393 >>= getNode cfg
394
395 -- | Retrieves all nodes hosting a DRBD disk
396 getDrbdDiskNodes :: ConfigData -> Disk -> [Node]
397 getDrbdDiskNodes cfg disk =
398 let retrieved = case diskLogicalId disk of
399 Just (LIDDrbd8 nodeA nodeB _ _ _ _) ->
400 justOk [getNode cfg nodeA, getNode cfg nodeB]
401 _ -> []
402 in retrieved ++ concatMap (getDrbdDiskNodes cfg) (diskChildren disk)
403
404 -- | Retrieves all the nodes of the instance.
405 --
406 -- As instances not using DRBD can be sent as a parameter as well,
407 -- the primary node has to be appended to the results.
408 getInstAllNodes :: ConfigData -> String -> ErrorResult [Node]
409 getInstAllNodes cfg name = do
410 inst_disks <- getInstDisks cfg name
411 let disk_nodes = concatMap (getDrbdDiskNodes cfg) inst_disks
412 pNode <- getInstPrimaryNode cfg name
413 return . nub $ pNode:disk_nodes
414
415 -- | Get disks for a given instance.
416 -- The instance is specified by name or uuid.
417 getInstDisks :: ConfigData -> String -> ErrorResult [Disk]
418 getInstDisks cfg iname =
419 getInstance cfg iname >>= mapM (getDisk cfg) . instDisks
420
421 -- | Get disks for a given instance object.
422 getInstDisksFromObj :: ConfigData -> Instance -> ErrorResult [Disk]
423 getInstDisksFromObj cfg =
424 getInstDisks cfg . uuidOf
425
426 -- | Collects a value for all DRBD disks
427 collectFromDrbdDisks
428 :: (Monoid a)
429 => (String -> String -> Int -> Int -> Int -> Private DRBDSecret -> a)
430 -- ^ NodeA, NodeB, Port, MinorA, MinorB, Secret
431 -> Disk -> a
432 collectFromDrbdDisks f = col
433 where
434 col (diskLogicalId &&& diskChildren ->
435 (Just (LIDDrbd8 nA nB port mA mB secret), ch)) =
436 f nA nB port mA mB secret <> F.foldMap col ch
437 col d = F.foldMap col (diskChildren d)
438
439 -- | Returns the DRBD secrets of a given 'Disk'
440 getDrbdSecretsForDisk :: Disk -> [DRBDSecret]
441 getDrbdSecretsForDisk = collectFromDrbdDisks
442 (\_ _ _ _ _ (Private secret) -> [secret])
443
444 -- | Returns the DRBD minors of a given 'Disk'
445 getDrbdMinorsForDisk :: Disk -> [(Int, String)]
446 getDrbdMinorsForDisk =
447 collectFromDrbdDisks (\nA nB _ mnA mnB _ -> [(mnA, nA), (mnB, nB)])
448
449 -- | Filters DRBD minors for a given node.
450 getDrbdMinorsForNode :: String -> Disk -> [(Int, String)]
451 getDrbdMinorsForNode node disk =
452 let child_minors = concatMap (getDrbdMinorsForNode node) (diskChildren disk)
453 this_minors =
454 case diskLogicalId disk of
455 Just (LIDDrbd8 nodeA nodeB _ minorA minorB _)
456 | nodeA == node -> [(minorA, nodeB)]
457 | nodeB == node -> [(minorB, nodeA)]
458 _ -> []
459 in this_minors ++ child_minors
460
461 -- | Returns the DRBD minors of a given instance
462 getDrbdMinorsForInstance :: ConfigData -> Instance
463 -> ErrorResult [(Int, String)]
464 getDrbdMinorsForInstance cfg =
465 liftM (concatMap getDrbdMinorsForDisk) . getInstDisksFromObj cfg
466
467 -- | String for primary role.
468 rolePrimary :: String
469 rolePrimary = "primary"
470
471 -- | String for secondary role.
472 roleSecondary :: String
473 roleSecondary = "secondary"
474
475 -- | Gets the list of DRBD minors for an instance that are related to
476 -- a given node.
477 getInstMinorsForNode :: ConfigData
478 -> String -- ^ The UUID of a node.
479 -> Instance
480 -> [(String, Int, String, String, String, String)]
481 getInstMinorsForNode cfg node inst =
482 let role = if Just node == instPrimaryNode inst
483 then rolePrimary
484 else roleSecondary
485 iname = fromMaybe "" $ instName inst
486 inst_disks = case getInstDisksFromObj cfg inst of
487 Ok disks -> disks
488 Bad _ -> []
489 -- FIXME: the disk/ build there is hack-ish; unify this in a
490 -- separate place, or reuse the iv_name (but that is deprecated on
491 -- the Python side)
492 in concatMap (\(idx, dsk) ->
493 [(node, minor, iname, "disk/" ++ show idx, role, peer)
494 | (minor, peer) <- getDrbdMinorsForNode node dsk]) .
495 zip [(0::Int)..] $ inst_disks
496
497 -- | Builds link -> ip -> instname map.
498 -- For instances without a name, we insert the uuid instead.
499 --
500 -- TODO: improve this by splitting it into multiple independent functions:
501 --
502 -- * abstract the \"fetch instance with filled params\" functionality
503 --
504 -- * abstsract the [instance] -> [(nic, instance_name)] part
505 --
506 -- * etc.
507 buildLinkIpInstnameMap :: ConfigData -> LinkIpMap
508 buildLinkIpInstnameMap cfg =
509 let cluster = configCluster cfg
510 instances = M.elems . fromContainer . configInstances $ cfg
511 defparams = (M.!) (fromContainer $ clusterNicparams cluster)
512 $ UTF8.fromString C.ppDefault
513 nics = concatMap (\i -> [(fromMaybe (uuidOf i) $ instName i, nic)
514 | nic <- instNics i])
515 instances
516 in foldl' (\accum (iname, nic) ->
517 let pparams = nicNicparams nic
518 fparams = fillParams defparams pparams
519 link = nicpLink fparams
520 in case nicIp nic of
521 Nothing -> accum
522 Just ip -> let oldipmap = M.findWithDefault M.empty
523 link accum
524 newipmap = M.insert ip iname oldipmap
525 in M.insert link newipmap accum
526 ) M.empty nics
527
528
529 -- | Returns a node's group, with optional failure if we can't find it
530 -- (configuration corrupt).
531 getGroupOfNode :: ConfigData -> Node -> Maybe NodeGroup
532 getGroupOfNode cfg node =
533 M.lookup (UTF8.fromString $ nodeGroup node)
534 (fromContainer . configNodegroups $ cfg)
535
536 -- | Returns a node's ndparams, filled.
537 getNodeNdParams :: ConfigData -> Node -> Maybe FilledNDParams
538 getNodeNdParams cfg node = do
539 group <- getGroupOfNode cfg node
540 let gparams = getGroupNdParams cfg group
541 return $ fillParams gparams (nodeNdparams node)
542
543 -- * Network
544
545 -- | Looks up a network. If looking up by uuid fails, we look up
546 -- by name.
547 getNetwork :: ConfigData -> String -> ErrorResult Network
548 getNetwork cfg name =
549 let networks = fromContainer (configNetworks cfg)
550 in case getItem' "Network" name networks of
551 Ok net -> Ok net
552 Bad _ -> let by_name = M.mapKeys
553 (fromNonEmpty . networkName . (M.!) networks)
554 networks
555 in getItem "Network" name by_name
556
557 -- ** MACs
558
559 type MAC = String
560
561 -- | Returns all MAC addresses used in the cluster.
562 getAllMACs :: ConfigData -> [MAC]
563 getAllMACs = F.foldMap (map nicMac . instNics) . configInstances
564
565 -- ** DRBD secrets
566
567 getAllDrbdSecrets :: ConfigData -> [DRBDSecret]
568 getAllDrbdSecrets = F.foldMap getDrbdSecretsForDisk . configDisks
569
570 -- ** LVs
571
572 -- | A map from node UUIDs to
573 --
574 -- FIXME: After adding designated types for UUIDs,
575 -- use them to replace 'String' here.
576 type NodeLVsMap = MM.MultiMap String LogicalVolume
577
578 getInstanceLVsByNode :: ConfigData -> Instance -> ErrorResult NodeLVsMap
579 getInstanceLVsByNode cd inst =
580 withMissingParam "Instance without Primary Node"
581 (\i -> return $ MM.fromList . lvsByNode i)
582 (instPrimaryNode inst)
583 <*> getInstDisksFromObj cd inst
584 where
585 lvsByNode :: String -> [Disk] -> [(String, LogicalVolume)]
586 lvsByNode node = concatMap (lvsByNode1 node)
587 lvsByNode1 :: String -> Disk -> [(String, LogicalVolume)]
588 lvsByNode1 _ (diskLogicalId &&& diskChildren
589 -> (Just (LIDDrbd8 nA nB _ _ _ _), ch)) =
590 lvsByNode nA ch ++ lvsByNode nB ch
591 lvsByNode1 node (diskLogicalId -> (Just (LIDPlain lv))) =
592 [(node, lv)]
593 lvsByNode1 node (diskChildren -> ch) = lvsByNode node ch
594
595 getAllLVs :: ConfigData -> ErrorResult (S.Set LogicalVolume)
596 getAllLVs cd = mconcat <$> mapM (liftM MM.values . getInstanceLVsByNode cd)
597 (F.toList $ configInstances cd)
598
599 -- * ND params
600
601 -- | Type class denoting objects which have node parameters.
602 class NdParamObject a where
603 getNdParamsOf :: ConfigData -> a -> Maybe FilledNDParams
604
605 instance NdParamObject Node where
606 getNdParamsOf = getNodeNdParams
607
608 instance NdParamObject NodeGroup where
609 getNdParamsOf cfg = Just . getGroupNdParams cfg
610
611 instance NdParamObject Cluster where
612 getNdParamsOf _ = Just . clusterNdparams