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