LGTM. Thanks, Jose
On Apr 16 15:19, Ilias Tsitsimpis wrote: > 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 | 4 +- > src/Ganeti/Config.hs | 33 ++++++++++------ > src/Ganeti/Objects.hs | 14 ------- > src/Ganeti/Query/Common.hs | 11 ++++++ > src/Ganeti/Query/Instance.hs | 94 > ++++++++++++++++++++++++++++++++++++-------- > 5 files changed, 110 insertions(+), 46 deletions(-) > > diff --git a/src/Ganeti/Confd/Server.hs b/src/Ganeti/Confd/Server.hs > index 2b9efaf..795681d 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) > @@ -228,7 +228,7 @@ buildResponse cdata req@(ConfdRequest { confdRqType = > ReqInstanceDisks }) = do > case confdRqQuery req of > PlainQuery str -> return str > _ -> fail $ "Invalid query type " ++ show (confdRqQuery req) > - case getInstDisksByName cfg inst_uuid of > + case getInstDisks cfg inst_uuid of > Ok disks -> return (ReplyStatusOk, J.showJSON disks) > Bad e -> fail $ "Could not retrieve disks: " ++ show e > > diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs > index bfffc2e..a88076c 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 getInstDisksFromObj 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 <- getInstDisks 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 getInstDisksFromObj 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..c9ccbd8 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 getInstDisksFromObj diskSize, QffNormal) > , (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber > - "Spindles of %s disk", > - getIndexedOptionalField instDisks diskSpindles, QffNormal) > + "Spindles of %s disk", > + getIndexedOptionalConfField getInstDisksFromObj diskSpindles, QffNormal) > , (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText > - "Name of %s disk", > - getIndexedOptionalField instDisks diskName, QffNormal) > + "Name of %s disk", > + getIndexedOptionalConfField getInstDisksFromObj diskName, QffNormal) > , (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText > - "UUID of %s disk", > - getIndexedField instDisks diskUuid, QffNormal) > + "UUID of %s disk", > + getIndexedConfField getInstDisksFromObj diskUuid, QffNormal) > ] ++ > > -- Aggregate nic parameter fields > @@ -358,6 +354,70 @@ 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) . getInstDisksFromObj 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) . getInstDisksFromObj cfg > + > +-- | Get a list of disk spindles > +getDiskSpindles :: ConfigData -> Instance -> ResultEntry > +getDiskSpindles cfg = > + rsErrorNoData . liftA (map (MaybeForJSON . diskSpindles)) . > + getInstDisksFromObj cfg > + > +-- | Get a list of disk names for an instance > +getDiskNames :: ConfigData -> Instance -> ResultEntry > +getDiskNames cfg = > + rsErrorNoData . liftA (map (MaybeForJSON . diskName)) . > + getInstDisksFromObj cfg > + > +-- | Get a list of disk UUIDs for an instance > +getDiskUuids :: ConfigData -> Instance -> ResultEntry > +getDiskUuids cfg = > + rsErrorNoData . liftA (map diskUuid) . 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 > +-- 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 > -- Jose Antonio Lopes Ganeti Engineering Google Germany GmbH Dienerstr. 12, 80331, München Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Geschäftsführer: Graham Law, Christine Elizabeth Flores Steuernummer: 48/725/00206 Umsatzsteueridentifikationsnummer: DE813741370
