Fix a few issues found by newer hlint

[ganeti-local] / htools / Ganeti / Config.hs

diff --git a/htools/Ganeti/Config.hs b/htools/Ganeti/Config.hs
index 54b9f46..6258273 100644 (file)
--- a/htools/Ganeti/Config.hs
+++ b/htools/Ganeti/Config.hs
@@ -31,11 +31,16 @@ module Ganeti.Config
     , getNodeRole
     , getNodeNdParams
     , getDefaultNicLink
+    , getDefaultHypervisor
     , getInstancesIpByLink
     , getNode
     , getInstance
     , getGroup
     , getGroupNdParams
+    , getGroupIpolicy
+    , getGroupDiskParams
+    , getGroupNodes
+    , getGroupInstances
     , getGroupOfNode
     , getInstPrimaryNode
     , getInstMinorsForNode
@@ -49,10 +54,10 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Text.JSON as J
 
-import Ganeti.JSON
 import Ganeti.BasicTypes
-
 import qualified Ganeti.Constants as C
+import Ganeti.Errors
+import Ganeti.JSON
 import Ganeti.Objects
 
 -- | Type alias for the link and ip map.
@@ -111,7 +116,7 @@ getNodeInstances cfg nname =
 -- | Computes the role of a node.
 getNodeRole :: ConfigData -> Node -> NodeRole
 getNodeRole cfg node
-  | nodeName node == (clusterMasterNode $ configCluster cfg) = NRMaster
+  | nodeName node == clusterMasterNode (configCluster cfg) = NRMaster
   | nodeMasterCandidate node = NRCandidate
   | nodeDrained node = NRDrained
   | nodeOffline node = NROffline
@@ -123,6 +128,16 @@ getDefaultNicLink =
   nicpLink . (M.! C.ppDefault) . fromContainer .
   clusterNicparams . configCluster
 
+-- | Returns the default cluster hypervisor.
+getDefaultHypervisor :: ConfigData -> Hypervisor
+getDefaultHypervisor cfg =
+  case clusterEnabledHypervisors $ configCluster cfg of
+    -- FIXME: this case shouldn't happen (configuration broken), but
+    -- for now we handle it here because we're not authoritative for
+    -- the config
+    []  -> XenPvm
+    x:_ -> x
+
 -- | Returns instances of a given link.
 getInstancesIpByLink :: LinkIpMap -> String -> [String]
 getInstancesIpByLink linkipmap link =
@@ -130,10 +145,11 @@ getInstancesIpByLink linkipmap link =
 
 -- | Generic lookup function that converts from a possible abbreviated
 -- name to a full name.
-getItem :: String -> String -> M.Map String a -> Result a
+getItem :: String -> String -> M.Map String a -> ErrorResult a
 getItem kind name allitems = do
   let lresult = lookupName (M.keys allitems) name
-      err = \details -> Bad $ kind ++ " name " ++ name ++ " " ++ details
+      err msg = Bad $ OpPrereqError (kind ++ " name " ++ name ++ " " ++ msg)
+                        ECodeNoEnt
   fullname <- case lrMatchPriority lresult of
                 PartialMatch -> Ok $ lrContent lresult
                 ExactMatch -> Ok $ lrContent lresult
@@ -143,24 +159,24 @@ getItem kind name allitems = do
         M.lookup fullname allitems
 
 -- | Looks up a node.
-getNode :: ConfigData -> String -> Result Node
+getNode :: ConfigData -> String -> ErrorResult Node
 getNode cfg name = getItem "Node" name (fromContainer $ configNodes cfg)
 
 -- | Looks up an instance.
-getInstance :: ConfigData -> String -> Result Instance
+getInstance :: ConfigData -> String -> ErrorResult Instance
 getInstance cfg name =
   getItem "Instance" name (fromContainer $ configInstances cfg)
 
 -- | Looks up a node group. This is more tricky than for
 -- node/instances since the groups map is indexed by uuid, not name.
-getGroup :: ConfigData -> String -> Result NodeGroup
+getGroup :: ConfigData -> String -> ErrorResult NodeGroup
 getGroup cfg name =
   let groups = fromContainer (configNodegroups cfg)
   in case getItem "NodeGroup" name groups of
        -- if not found by uuid, we need to look it up by name, slow
        Ok grp -> Ok grp
        Bad _ -> let by_name = M.mapKeys
-                              (\k -> groupName ((M.!) groups k )) groups
+                              (groupName . (M.!) groups) groups
                 in getItem "NodeGroup" name by_name
 
 -- | Computes a node group's node params.
@@ -168,8 +184,33 @@ getGroupNdParams :: ConfigData -> NodeGroup -> FilledNDParams
 getGroupNdParams cfg ng =
   fillNDParams (clusterNdparams $ configCluster cfg) (groupNdparams ng)
 
+-- | Computes a node group's ipolicy.
+getGroupIpolicy :: ConfigData -> NodeGroup -> FilledIPolicy
+getGroupIpolicy cfg ng =
+  fillIPolicy (clusterIpolicy $ configCluster cfg) (groupIpolicy ng)
+
+-- | Computes a group\'s (merged) disk params.
+getGroupDiskParams :: ConfigData -> NodeGroup -> DiskParams
+getGroupDiskParams cfg ng =
+  Container $
+  fillDict (fromContainer . clusterDiskparams $ configCluster cfg)
+           (fromContainer $ groupDiskparams ng) []
+
+-- | Get nodes of a given node group.
+getGroupNodes :: ConfigData -> String -> [Node]
+getGroupNodes cfg gname =
+  let all_nodes = M.elems . fromContainer . configNodes $ cfg in
+  filter ((==gname) . nodeGroup) all_nodes
+
+-- | Get (primary, secondary) instances of a given node group.
+getGroupInstances :: ConfigData -> String -> ([Instance], [Instance])
+getGroupInstances cfg gname =
+  let gnodes = map nodeName (getGroupNodes cfg gname)
+      ginsts = map (getNodeInstances cfg) gnodes in
+  (concatMap fst ginsts, concatMap snd ginsts)
+
 -- | Looks up an instance's primary node.
-getInstPrimaryNode :: ConfigData -> String -> Result Node
+getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
 getInstPrimaryNode cfg name =
   liftM instPrimaryNode (getInstance cfg name) >>= getNode cfg
 
@@ -232,7 +273,7 @@ buildLinkIpInstnameMap cfg =
                    link = nicpLink fparams
                in case nicIp nic of
                     Nothing -> accum
-                    Just ip -> let oldipmap = M.findWithDefault (M.empty)
+                    Just ip -> let oldipmap = M.findWithDefault M.empty
                                               link accum
                                    newipmap = M.insert ip iname oldipmap
                                in M.insert link newipmap accum