-> BT.ResultT String IO [Ganeti.Objects.Disk]
getDisks inst srvAddr srvPort = do
client <- liftIO $ getConfdClient srvAddr srvPort
- reply <- liftIO . query client ReqInstanceDisks . PlainQuery . instUuid $ inst
+ reply <- liftIO . query client ReqInstanceDisks . PlainQuery . uuidOf $ inst
case fmap (J.readJSON . confdReplyAnswer) reply of
Just (J.Ok disks) -> return disks
Just (J.Error msg) -> fail msg
PlainQuery str -> return str
_ -> fail $ "Invalid query type " ++ show (confdRqQuery req)
node <- gntErrorToResult $ getNode cfg node_name
- let minors = concatMap (getInstMinorsForNode cfg (nodeUuid node)) .
+ let minors = concatMap (getInstMinorsForNode cfg (uuidOf node)) .
M.elems . fromContainer . configInstances $ cfg
encoded <- mapM (encodeMinors cfg) minors
return (ReplyStatusOk, J.showJSON encoded, nodeSerial node)
case getNode cfg node_name of
Ok n -> return n
Bad e -> fail $ "Node not found in the configuration: " ++ show e
- let node_uuid = nodeUuid node
+ let node_uuid = uuidOf node
instances = getNodeInstances cfg node_uuid
return (ReplyStatusOk, J.showJSON instances, nodeSerial node)
case getInstance cfg inst_name of
Ok i -> return i
Bad e -> fail $ "Instance not found in the configuration: " ++ show e
- case getInstDisks cfg . instUuid $ inst of
+ case getInstDisks cfg . uuidOf $ inst of
Ok disks -> return (ReplyStatusOk, J.showJSON disks, instSerial inst)
Bad e -> fail $ "Could not retrieve disks: " ++ show e
-- | Computes the role of a node.
getNodeRole :: ConfigData -> Node -> NodeRole
getNodeRole cfg node
- | nodeUuid node == clusterMasterNode (configCluster cfg) = NRMaster
+ | uuidOf node == clusterMasterNode (configCluster cfg) = NRMaster
| nodeMasterCandidate node = NRCandidate
| nodeDrained node = NRDrained
| nodeOffline node = NROffline
-- | Get (primary, secondary) instances of a given node group.
getGroupInstances :: ConfigData -> String -> ([Instance], [Instance])
getGroupInstances cfg gname =
- let gnodes = map nodeUuid (getGroupNodes cfg gname)
+ let gnodes = map uuidOf (getGroupNodes cfg gname)
ginsts = map (getNodeInstances cfg) gnodes in
(concatMap fst ginsts, concatMap snd ginsts)
-- | Get disks for a given instance object.
getInstDisksFromObj :: ConfigData -> Instance -> ErrorResult [Disk]
getInstDisksFromObj cfg =
- getInstDisks cfg . instUuid
+ getInstDisks cfg . uuidOf
-- | Collects a value for all DRBD disks
collectFromDrbdDisks
let cluster = configCluster cfg
instances = M.elems . fromContainer . configInstances $ cfg
defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault
- nics = concatMap (\i -> [(fromMaybe (instUuid i) $ instName i, nic)
+ nics = concatMap (\i -> [(fromMaybe (uuidOf i) $ instName i, nic)
| nic <- instNics i])
instances
in foldl' (\accum (iname, nic) ->
forM_ jobsToCancel $ \(job, fr) -> do
let jid = qjId job
logDebug $ "Cancelling job " ++ show (fromJobId jid)
- ++ " because it was REJECTed by filter rule " ++ frUuid fr
+ ++ " because it was REJECTed by filter rule " ++ uuidOf fr
-- First dequeue, then cancel.
dequeueResult <- dequeueJob qstate jid
case dequeueResult of
, (FieldDefinition "ndparams" "NDParams" QFTOther "Node parameters",
FieldConfig (\cfg ng -> rsNormal (getGroupNdParams cfg ng)), QffNormal)
, (FieldDefinition "node_cnt" "Nodes" QFTNumber "Number of nodes",
- FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . groupUuid),
+ FieldConfig (\cfg -> rsNormal . length . getGroupNodes cfg . uuidOf),
QffNormal)
, (FieldDefinition "node_list" "NodeList" QFTOther "List of nodes",
FieldConfig (\cfg -> rsNormal . map nodeName .
- getGroupNodes cfg . groupUuid), QffNormal)
+ getGroupNodes cfg . uuidOf), QffNormal)
, (FieldDefinition "pinst_cnt" "Instances" QFTNumber
"Number of primary instances",
FieldConfig
- (\cfg -> rsNormal . length . fst . getGroupInstances cfg . groupUuid),
+ (\cfg -> rsNormal . length . fst . getGroupInstances cfg . uuidOf),
QffNormal)
, (FieldDefinition "pinst_list" "InstanceList" QFTOther
"List of primary instances",
FieldConfig (\cfg -> rsNormal . niceSort . mapMaybe instName . fst .
- getGroupInstances cfg . groupUuid), QffNormal)
+ getGroupInstances cfg . uuidOf), QffNormal)
] ++
map buildNdParamField allNDParamFields ++
timeStampFields ++
FieldConfig (getSecondaryNodeGroupAttribute groupName), QffNormal)
, (FieldDefinition "snodes.group.uuid" "SecondaryNodesGroupsUUID" QFTOther
"Node group UUIDs of secondary nodes",
- FieldConfig (getSecondaryNodeGroupAttribute groupUuid), QffNormal)
+ FieldConfig (getSecondaryNodeGroupAttribute uuidOf), QffNormal)
] ++
-- Instance parameter fields, whole
getIndexedOptionalConfField getInstDisksFromObj diskName, QffNormal)
, (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText
"UUID of %s disk",
- getIndexedConfField getInstDisksFromObj diskUuid, QffNormal)
+ getIndexedConfField getInstDisksFromObj uuidOf, QffNormal)
] ++
-- Aggregate nic parameter fields
QffNormal)
, (FieldDefinition "nic.uuids" "NIC_UUIDs" QFTOther
(nicAggDescPrefix ++ "UUID"),
- FieldSimple (rsNormal . map nicUuid . instNics), QffNormal)
+ FieldSimple (rsNormal . map uuidOf . instNics), QffNormal)
, (FieldDefinition "nic.modes" "NIC_modes" QFTOther
(nicAggDescPrefix ++ "mode"),
FieldConfig (\cfg -> rsNormal . map
getIndexedOptionalField instNics nicIp, QffNormal)
, (fieldDefinitionCompleter "nic.uuid/%d" "NicUUID/%d" QFTText
("UUID address" ++ nicDescSuffix),
- getIndexedField instNics nicUuid, QffNormal)
+ getIndexedField instNics uuidOf, QffNormal)
, (fieldDefinitionCompleter "nic.mac/%d" "NicMAC/%d" QFTText
("MAC address" ++ nicDescSuffix),
getIndexedField instNics nicMac, QffNormal)
-- | Get a list of disk UUIDs for an instance
getDiskUuids :: ConfigData -> Instance -> ResultEntry
getDiskUuids cfg =
- rsErrorNoData . liftA (map diskUuid) . getInstDisksFromObj cfg
+ rsErrorNoData . liftA (map uuidOf) . getInstDisksFromObj cfg
-- | Creates a functions which produces a FieldConfig 'FieldGetter' when fed
-- an index. Works for fields that may not return a value, expressed through
-- | Get primary node group uuid
getPrimaryNodeGroupUuid :: ConfigData -> Instance -> ResultEntry
getPrimaryNodeGroupUuid cfg inst =
- rsErrorNoData $ groupUuid <$> getPrimaryNodeGroup cfg inst
+ rsErrorNoData $ uuidOf <$> getPrimaryNodeGroup cfg inst
-- | Get secondary nodes - the configuration objects themselves
getSecondaryNodes :: ConfigData -> Instance -> ErrorResult [Node]
-> Instance
-> Runtime
extractLiveInfo nodeResultList nodeConsoleList inst =
- let uuidConvert = map (\(x, y) -> (nodeUuid x, y))
+ let uuidConvert = map (\(x, y) -> (uuidOf x, y))
uuidResultList = uuidConvert nodeResultList
uuidConsoleList = uuidConvert nodeConsoleList
in case getInstanceInfo uuidResultList inst of
QffNormal)
, (FieldDefinition "group_list" "GroupList" QFTOther
"List of nodegroups (group name, NIC mode, NIC link)",
- FieldConfig (\cfg -> rsNormal . getGroupConnections cfg . networkUuid),
+ FieldConfig (\cfg -> rsNormal . getGroupConnections cfg . uuidOf),
QffNormal)
, (FieldDefinition "group_cnt" "NodeGroups" QFTNumber "Number of nodegroups",
FieldConfig (\cfg -> rsNormal . length . getGroupConnections cfg
- . networkUuid), QffNormal)
+ . uuidOf), QffNormal)
, (FieldDefinition "inst_list" "InstanceList" QFTOther "List of instances",
- FieldConfig (\cfg -> rsNormal . getInstances cfg . networkUuid),
+ FieldConfig (\cfg -> rsNormal . getInstances cfg . uuidOf),
QffNormal)
, (FieldDefinition "inst_cnt" "Instances" QFTNumber "Number of instances",
FieldConfig (\cfg -> rsNormal . length . getInstances cfg
- . networkUuid), QffNormal)
+ . uuidOf), QffNormal)
, (FieldDefinition "external_reservations" "ExternalReservations" QFTText
"External reservations",
FieldSimple getExtReservationsString, QffNormal)
getNetworkUuid cfg name =
let net = find (\n -> name == fromNonEmpty (networkName n))
((Map.elems . fromContainer . configNetworks) cfg)
- in fmap networkUuid net
+ in fmap uuidOf net
-- | Computes the reservations list for a network.
--
FieldSimple (rsNormal . nodeSecondaryIp), QffNormal)
, (FieldDefinition "master" "IsMaster" QFTBool "Whether node is master",
FieldConfig (\cfg node ->
- rsNormal (nodeUuid node ==
+ rsNormal (uuidOf node ==
clusterMasterNode (configCluster cfg))),
QffNormal)
, (FieldDefinition "group" "Group" QFTText "Node group",
, (FieldDefinition "pinst_list" "PriInstances" QFTOther
"List of instances with this node as primary",
FieldConfig (\cfg -> rsNormal . niceSort . mapMaybe instName . fst .
- getNodeInstances cfg . nodeUuid), QffNormal)
+ getNodeInstances cfg . uuidOf), QffNormal)
, (FieldDefinition "sinst_list" "SecInstances" QFTOther
"List of instances with this node as secondary",
FieldConfig (\cfg -> rsNormal . niceSort . mapMaybe instName . snd .
- getNodeInstances cfg . nodeUuid), QffNormal)
+ getNodeInstances cfg . uuidOf), QffNormal)
, (FieldDefinition "role" "Role" QFTText nodeRoleDoc,
FieldConfig ((rsNormal .) . getNodeRole), QffNormal)
, (FieldDefinition "powered" "Powered" QFTBool
-- | Helper function to retrieve the number of (primary or secondary) instances
getNumInstances :: (([Instance], [Instance]) -> [Instance])
-> ConfigData -> Node -> Int
-getNumInstances get_fn cfg = length . get_fn . getNodeInstances cfg . nodeUuid
+getNumInstances get_fn cfg = length . get_fn . getNodeInstances cfg . uuidOf
-- | The node fields map.
fieldsMap :: FieldMap Node Runtime
storage_units = if queryDomainRequired storageFields fields
then getStorageUnitsOfNodes cfg good_nodes
else Map.fromList
- (map (\n -> (nodeUuid n, [])) good_nodes)
+ (map (\n -> (uuidOf n, [])) good_nodes)
rpcres <- executeRpcCall good_nodes (RpcCallNodeInfo storage_units hvs)
return $ fillUpList (fillPairFromMaybe rpcResultNodeBroken pickPairUnique)
nodes rpcres
queryInner cfg live (Query (ItemTypeLuxi QRFilter) fields qfilter) wanted =
genericQuery FilterRules.fieldsMap (CollectorSimple dummyCollectLiveData)
- frUuid configFilters getFilterRule cfg live fields qfilter wanted
+ uuidOf configFilters getFilterRule cfg live fields qfilter wanted
queryInner _ _ (Query qkind _ _) _ =
return . Bad . GenericError $ "Query '" ++ show qkind ++ "' not supported"
rpcCallData n call = J.encode
( fromMaybe (error $ "Programmer error: missing parameter for node named "
++ nodeName n)
- $ Map.lookup (nodeUuid n) (rpcCallNodeInfoStorageUnits call)
+ $ Map.lookup (uuidOf n) (rpcCallNodeInfoStorageUnits call)
, rpcCallNodeInfoHypervisors call
)
-- | Get the storage unit map for all nodes
getStorageUnitsOfNodes :: ConfigData -> [Node] -> M.Map String [StorageUnit]
getStorageUnitsOfNodes cfg ns =
- M.fromList (map (\n -> (nodeUuid n, getStorageUnitsOfNode cfg n)) ns)
+ M.fromList (map (\n -> (uuidOf n, getStorageUnitsOfNode cfg n)) ns)
, (SSMaintainNodeHealth, return . show . clusterMaintainNodeHealth
$ cluster)
, (SSUidPool, mapLines formatUidRange . clusterUidPool $ cluster)
- , (SSNodegroups, mapLines (spcPair . (groupUuid &&& groupName))
+ , (SSNodegroups, mapLines (spcPair . (uuidOf &&& groupName))
nodeGroups)
- , (SSNetworks, mapLines (spcPair . (networkUuid
+ , (SSNetworks, mapLines (spcPair . (uuidOf
&&& (fromNonEmpty . networkName)))
. configNetworks $ cdata)
, (SSEnabledUserShutdown, return . show . clusterEnabledUserShutdown
nodes <- vector ncount
version <- arbitrary
grp <- arbitrary
- let guuid = groupUuid grp
+ let guuid = uuidOf grp
nodes' = zipWith (\n idx ->
let newname = takeWhile (/= '.') (nodeName n)
++ "-" ++ show idx
let nets_unique = map ( \(name, net) -> net { networkName = name } )
(zip net_names nets)
net_map = GenericContainer $ Map.fromList
- (map (\n -> (networkUuid n, n)) nets_unique)
+ (map (\n -> (uuidOf n, n)) nets_unique)
new_cfg = old_cfg { configNetworks = net_map }
return new_cfg