Change Haskell's Query code to use Config's 'getInstDisks' function in order to retrieve the instance's disks.
Signed-off-by: Ilias Tsitsimpis <[email protected]> --- src/Ganeti/Confd/Server.hs | 2 +- src/Ganeti/Config.hs | 33 +++++++++------- src/Ganeti/Objects.hs | 14 ------- src/Ganeti/Query/Common.hs | 11 ++++++ src/Ganeti/Query/Instance.hs | 92 ++++++++++++++++++++++++++++++++++++-------- 5 files changed, 107 insertions(+), 45 deletions(-) diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs index 7e497b7..fd0890c 100644 --- a/src/Ganeti/Confd/Server.hs +++ b/src/Ganeti/Confd/Server.hs @@ -201,7 +201,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = ReqNodeDrbd }) = do PlainQuery str -> return str _ -> fail $ "Invalid query type " ++ show (confdRqQuery req) node <- gntErrorToResult $ getNode cfg node_name - let minors = concatMap (getInstMinorsForNode (nodeUuid node)) . + let minors = concatMap (getInstMinorsForNode cfg (nodeUuid node)) . M.elems . fromContainer . configInstances $ cfg encoded <- mapM (encodeMinors cfg) minors return (ReplyStatusOk, J.showJSON encoded) diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs index de3da80..eb55b44 100644 --- a/src/Ganeti/Config.hs +++ b/src/Ganeti/Config.hs @@ -114,19 +114,22 @@ computeDiskNodes dsk = -- | Computes all disk-related nodes of an instance. For non-DRBD, -- this will be empty, for DRBD it will contain both the primary and -- the secondaries. -instDiskNodes :: Instance -> S.Set String -instDiskNodes = S.unions . map computeDiskNodes . instDisks +instDiskNodes :: ConfigData -> Instance -> S.Set String +instDiskNodes cfg inst = + case getInstDisks cfg inst of + Ok disks -> S.unions $ map computeDiskNodes disks + Bad _ -> S.empty -- | Computes all nodes of an instance. -instNodes :: Instance -> S.Set String -instNodes inst = instPrimaryNode inst `S.insert` instDiskNodes inst +instNodes :: ConfigData -> Instance -> S.Set String +instNodes cfg inst = instPrimaryNode inst `S.insert` instDiskNodes cfg inst -- | Computes the secondary nodes of an instance. Since this is valid -- only for DRBD, we call directly 'instDiskNodes', skipping over the -- extra primary insert. -instSecondaryNodes :: Instance -> S.Set String -instSecondaryNodes inst = - instPrimaryNode inst `S.delete` instDiskNodes inst +instSecondaryNodes :: ConfigData -> Instance -> S.Set String +instSecondaryNodes cfg inst = + instPrimaryNode inst `S.delete` instDiskNodes cfg inst -- | Get instances of a given node. -- The node is specified through its UUID. @@ -134,7 +137,7 @@ getNodeInstances :: ConfigData -> String -> ([Instance], [Instance]) getNodeInstances cfg nname = let all_inst = M.elems . fromContainer . configInstances $ cfg pri_inst = filter ((== nname) . instPrimaryNode) all_inst - sec_inst = filter ((nname `S.member`) . instSecondaryNodes) all_inst + sec_inst = filter ((nname `S.member`) . instSecondaryNodes cfg) all_inst in (pri_inst, sec_inst) -- | Computes the role of a node. @@ -338,8 +341,8 @@ getDrbdDiskNodes cfg disk = -- the primary node has to be appended to the results. getInstAllNodes :: ConfigData -> String -> ErrorResult [Node] getInstAllNodes cfg name = do - inst <- getInstance cfg name - let diskNodes = concatMap (getDrbdDiskNodes cfg) $ instDisks inst + inst_disks <- getInstDisksByName cfg name + let diskNodes = concatMap (getDrbdDiskNodes cfg) inst_disks pNode <- getInstPrimaryNode cfg name return . nub $ pNode:diskNodes @@ -377,21 +380,25 @@ roleSecondary = "secondary" -- | Gets the list of DRBD minors for an instance that are related to -- a given node. -getInstMinorsForNode :: String -- ^ The UUID of a node. +getInstMinorsForNode :: ConfigData + -> String -- ^ The UUID of a node. -> Instance -> [(String, Int, String, String, String, String)] -getInstMinorsForNode node inst = +getInstMinorsForNode cfg node inst = let role = if node == instPrimaryNode inst then rolePrimary else roleSecondary iname = instName inst + inst_disks = case getInstDisks cfg inst of + Ok disks -> disks + Bad _ -> [] -- FIXME: the disk/ build there is hack-ish; unify this in a -- separate place, or reuse the iv_name (but that is deprecated on -- the Python side) in concatMap (\(idx, dsk) -> [(node, minor, iname, "disk/" ++ show idx, role, peer) | (minor, peer) <- getDrbdMinorsForNode node dsk]) . - zip [(0::Int)..] . instDisks $ inst + zip [(0::Int)..] $ inst_disks -- | Builds link -> ip -> instname map. -- diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs index 8a0c5ac..e5f742c 100644 --- a/src/Ganeti/Objects.hs +++ b/src/Ganeti/Objects.hs @@ -47,7 +47,6 @@ module Ganeti.Objects , fillBeParams , allBeParamFields , Instance(..) - , getDiskSizeRequirements , PartialNDParams(..) , FilledNDParams(..) , fillNDParams @@ -485,19 +484,6 @@ instance SerialNoObject Instance where instance TagsObject Instance where tagsOf = instTags --- | Retrieves the real disk size requirements for all the disks of the --- instance. This includes the metadata etc. and is different from the values --- visible to the instance. -getDiskSizeRequirements :: Instance -> Int -getDiskSizeRequirements inst = - sum . map - (\disk -> case instDiskTemplate inst of - DTDrbd8 -> diskSize disk + C.drbdMetaSize - DTDiskless -> 0 - DTBlock -> 0 - _ -> diskSize disk ) - $ instDisks inst - -- * IPolicy definitions $(buildParam "ISpec" "ispec" diff --git a/src/Ganeti/Query/Common.hs b/src/Ganeti/Query/Common.hs index d53b0b4..f0b8cec 100644 --- a/src/Ganeti/Query/Common.hs +++ b/src/Ganeti/Query/Common.hs @@ -31,6 +31,7 @@ module Ganeti.Query.Common , rsMaybeNoData , rsMaybeUnavail , rsErrorNoData + , rsErrorMaybeUnavail , rsUnknown , missingRuntime , rpcErrorToStatus @@ -114,6 +115,16 @@ rsErrorNoData res = case res of rsMaybeUnavail :: (JSON a) => Maybe a -> ResultEntry rsMaybeUnavail = maybe rsUnavail rsNormal +-- | Helper to declare a result from 'ErrorResult Maybe'. This version +-- should be used if an error signals there was no data and at the same +-- time when we have optional fields that may not be setted (i.e. we +-- want to return a 'RSUnavail' in case of 'Nothing'). +rsErrorMaybeUnavail :: (JSON a) => ErrorResult (Maybe a) -> ResultEntry +rsErrorMaybeUnavail res = + case res of + Ok x -> rsMaybeUnavail x + Bad _ -> rsNoData + -- | Helper for unknown field result. rsUnknown :: ResultEntry rsUnknown = ResultEntry RSUnknown Nothing diff --git a/src/Ganeti/Query/Instance.hs b/src/Ganeti/Query/Instance.hs index 3b81a2f..62029c2 100644 --- a/src/Ganeti/Query/Instance.hs +++ b/src/Ganeti/Query/Instance.hs @@ -177,42 +177,38 @@ instanceFields = [ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit "Total disk space used by instance on each of its nodes; this is not the\ \ disk size visible to the instance, but the usage on the node", - FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal) + FieldConfig getDiskSizeRequirements, QffNormal) , (FieldDefinition "disk.count" "Disks" QFTNumber "Number of disks", FieldSimple (rsNormal . length . instDisks), QffNormal) , (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther "List of disk sizes", - FieldSimple (rsNormal . map diskSize . instDisks), QffNormal) + FieldConfig getDiskSizes, QffNormal) , (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther "List of disk spindles", - FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) . - instDisks), - QffNormal) + FieldConfig getDiskSpindles, QffNormal) , (FieldDefinition "disk.names" "Disk_names" QFTOther "List of disk names", - FieldSimple (rsNormal . map (MaybeForJSON . diskName) . - instDisks), - QffNormal) + FieldConfig getDiskNames, QffNormal) , (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther "List of disk UUIDs", - FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal) + FieldConfig getDiskUuids, QffNormal) ] ++ -- Per-disk parameter fields instantiateIndexedFields C.maxDisks [ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit - "Disk size of %s disk", - getIndexedField instDisks diskSize, QffNormal) + "Disk size of %s disk", + getIndexedConfField getInstDisks diskSize, QffNormal) , (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber - "Spindles of %s disk", - getIndexedOptionalField instDisks diskSpindles, QffNormal) + "Spindles of %s disk", + getIndexedOptionalConfField getInstDisks diskSpindles, QffNormal) , (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText - "Name of %s disk", - getIndexedOptionalField instDisks diskName, QffNormal) + "Name of %s disk", + getIndexedOptionalConfField getInstDisks diskName, QffNormal) , (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText - "UUID of %s disk", - getIndexedField instDisks diskUuid, QffNormal) + "UUID of %s disk", + getIndexedConfField getInstDisks diskUuid, QffNormal) ] ++ -- Aggregate nic parameter fields @@ -358,6 +354,68 @@ getDefaultNicParams :: ConfigData -> FilledNicParams getDefaultNicParams cfg = (Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) C.ppDefault +-- | Retrieves the real disk size requirements for all the disks of the +-- instance. This includes the metadata etc. and is different from the values +-- visible to the instance. +getDiskSizeRequirements :: ConfigData -> Instance -> ResultEntry +getDiskSizeRequirements cfg inst = + rsErrorNoData . liftA (sum . map getSizes) . getInstDisks cfg $ inst + where + getSizes :: Disk -> Int + getSizes disk = + case instDiskTemplate inst of + DTDrbd8 -> diskSize disk + C.drbdMetaSize + DTDiskless -> 0 + DTBlock -> 0 + _ -> diskSize disk + +-- | Get a list of disk sizes for an instance +getDiskSizes :: ConfigData -> Instance -> ResultEntry +getDiskSizes cfg = + rsErrorNoData . liftA (map diskSize) . getInstDisks cfg + +-- | Get a list of disk spindles +getDiskSpindles :: ConfigData -> Instance -> ResultEntry +getDiskSpindles cfg = + rsErrorNoData . liftA (map (MaybeForJSON . diskSpindles)) . getInstDisks cfg + +-- | Get a list of disk names for an instance +getDiskNames :: ConfigData -> Instance -> ResultEntry +getDiskNames cfg = + rsErrorNoData . liftA (map (MaybeForJSON . diskName)) . getInstDisks cfg + +-- | Get a list of disk UUIDs for an instance +getDiskUuids :: ConfigData -> Instance -> ResultEntry +getDiskUuids cfg = + rsErrorNoData . liftA (map diskUuid) . getInstDisks cfg + +-- | Creates a functions which produces a FieldConfig 'FieldGetter' when fed +-- an index. Works for fields that may not return a value, expressed through +-- the Maybe monad. +getIndexedOptionalConfField :: (J.JSON b) + -- | Extracts a list of objects + => (ConfigData -> Instance -> ErrorResult [a]) + -> (a -> Maybe b) -- ^ Possibly gets a property + -- from an object + -> Int -- ^ Index in list to use + -> FieldGetter Instance Runtime -- ^ Result +getIndexedOptionalConfField extractor optPropertyGetter index = + let getProperty x = maybeAt index x >>= optPropertyGetter + in FieldConfig (\cfg -> + rsErrorMaybeUnavail . liftA getProperty . extractor cfg) + +-- | Creates a function which produces a FieldConfig 'FieldGetter' when fed +-- an index. Works only for fields that surely return a value. +getIndexedConfField :: (J.JSON b) + -- | Extracts a list of objects + => (ConfigData -> Instance -> ErrorResult [a]) + -> (a -> b) -- ^ Gets a property from an object + -> Int -- ^ Index in list to use + -> FieldGetter Instance Runtime -- ^ Result +getIndexedConfField extractor propertyGetter index = + let optPropertyGetter = Just . propertyGetter + in getIndexedOptionalConfField extractor optPropertyGetter index + -- | Returns a field that retrieves a given NIC's network name. getIndexedNicNetworkNameField :: Int -> FieldGetter Instance Runtime getIndexedNicNetworkNameField index = -- 1.9.1
