Commit 88b58ed6 authored by Hrvoje Ribicic's avatar Hrvoje Ribicic
Browse files

Add instance disk fields



The instance disk fields have been added. As these are the first
fields to be duplicated, some helper functions are present to support
easier specification of fields which have to be duplicated for every
entry in an array of configuration objects, and numbered accordingly.
A newtype of Maybe was introduced to fix serialization issues, as well
as a minor utility function.
Signed-off-by: default avatarHrvoje Ribicic <riba@google.com>
Reviewed-by: default avatarJose A. Lopes <jabolopes@google.com>
parent 4e6f1cde
......@@ -48,6 +48,7 @@ module Ganeti.JSON
, HasStringRepr(..)
, GenericContainer(..)
, Container
, MaybeForJSON(..)
)
where
......@@ -288,3 +289,12 @@ instance (HasStringRepr a, Ord a, J.JSON b) =>
readJSON (J.JSObject o) = readContainer o
readJSON v = fail $ "Failed to load container, expected object but got "
++ show (pp_value v)
-- | A Maybe newtype that allows for serialization more appropriate to the
-- semantics of Maybe and JSON in our calls. Does not produce needless
-- and confusing dictionaries.
newtype MaybeForJSON a = MaybeForJSON { unMaybeForJSON :: Maybe a }
instance (J.JSON a) => J.JSON (MaybeForJSON a) where
readJSON = J.readJSON
showJSON (MaybeForJSON (Just x)) = J.showJSON x
showJSON (MaybeForJSON Nothing) = J.JSNull
......@@ -47,6 +47,7 @@ module Ganeti.Objects
, allBeParamFields
, Instance(..)
, toDictInstance
, getDiskSizeRequirements
, PartialNDParams(..)
, FilledNDParams(..)
, fillNDParams
......@@ -459,6 +460,19 @@ 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"
......
......@@ -35,6 +35,7 @@ import Data.Maybe
import Data.Monoid
import qualified Data.Map as Map
import qualified Text.JSON as J
import Text.Printf
import Ganeti.BasicTypes
import Ganeti.Common
......@@ -50,6 +51,7 @@ import Ganeti.Query.Types
import Ganeti.Rpc
import Ganeti.Storage.Utils
import Ganeti.Types
import Ganeti.Utils (formatOrdinal)
-- | The LiveInfo structure packs additional information beside the
-- 'InstanceInfo'. We also need to know whether the instance information was
......@@ -134,6 +136,56 @@ instanceFields =
map (buildBeParamField beParamGetter) allBeParamFields ++
map (buildHvParamField hvParamGetter) (C.toList C.hvsParameters) ++
-- Aggregate disk parameter fields
[ (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),
(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),
(FieldDefinition "disk.spindles" "Disk_spindles" QFTOther
"List of disk spindles",
FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) .
instDisks),
QffNormal),
(FieldDefinition "disk.names" "Disk_names" QFTOther
"List of disk names",
FieldSimple (rsNormal . map (MaybeForJSON . diskName) .
instDisks),
QffNormal),
(FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther
"List of disk UUIDs",
FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal)
] ++
-- Per-disk parameter fields
fillNumberFields C.maxDisks
[ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit
"Disk size of %s disk",
getFillableField instDisks diskSize, QffNormal),
(fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber
"Spindles of %s disk",
getFillableOptionalField instDisks diskSpindles, QffNormal),
(fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText
"Name of %s disk",
getFillableOptionalField instDisks diskName, QffNormal),
(fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText
"UUID of %s disk",
getFillableField instDisks diskUuid, QffNormal)
] ++
-- Live fields using special getters
[ (FieldDefinition "status" "Status" QFTText
statusDocText,
......@@ -153,6 +205,81 @@ instanceFields =
-- * Helper functions for node property retrieval
-- | Creates a function which produces a FieldGetter when fed an index. Works
-- for fields that may not return a value, expressed through the Maybe monad.
getFillableOptionalField :: (J.JSON b)
=> (Instance -> [a]) -- ^ Extracts a list of objects
-> (a -> Maybe b) -- ^ Possibly gets a property
-- from an object
-> Int -- ^ Index in list to use
-> FieldGetter Instance Runtime -- ^ Result
getFillableOptionalField extractor optPropertyGetter index =
FieldSimple(\inst -> rsMaybeUnavail $ do
obj <- maybeAt index $ extractor inst
optPropertyGetter obj)
-- | Creates a function which produces a FieldGetter when fed an index.
-- Works only for fields that surely return a value.
getFillableField :: (J.JSON b)
=> (Instance -> [a]) -- ^ Extracts a list of objects
-> (a -> b) -- ^ Gets a property from an object
-> Int -- ^ Index in list to use
-> FieldGetter Instance Runtime -- ^ Result
getFillableField extractor propertyGetter index =
let optPropertyGetter = Just . propertyGetter
in getFillableOptionalField extractor optPropertyGetter index
-- | Retrieves a value from an array at an index, using the Maybe monad to
-- indicate failure.
maybeAt :: Int -> [a] -> Maybe a
maybeAt index list
| index >= length list = Nothing
| otherwise = Just $ list !! index
-- | Primed with format strings for everything but the type, it consumes two
-- values and uses them to complete the FieldDefinition.
-- Warning: a bit unsafe as it uses printf. Handle with care.
fieldDefinitionCompleter :: (PrintfArg t1) => (PrintfArg t2)
=> FieldName
-> FieldTitle
-> FieldType
-> FieldDoc
-> t1
-> t2
-> FieldDefinition
fieldDefinitionCompleter fName fTitle fType fDoc firstVal secondVal =
FieldDefinition (printf fName firstVal)
(printf fTitle firstVal)
fType
(printf fDoc secondVal)
-- | Given an incomplete field definition and values that can complete it,
-- return a fully functional FieldData. Cannot work for all cases, should be
-- extended as necessary.
fillIncompleteFields :: (t1 -> t2 -> FieldDefinition,
t1 -> FieldGetter a b,
QffMode)
-> t1
-> t2
-> FieldData a b
fillIncompleteFields (iDef, iGet, mode) firstVal secondVal =
(iDef firstVal secondVal, iGet firstVal, mode)
-- | Given fields that describe lists, fill their definitions with appropriate
-- index representations.
fillNumberFields :: (Integral t1)
=> Int
-> [(t1 -> String -> FieldDefinition,
t1 -> FieldGetter a b,
QffMode)]
-> FieldList a b
fillNumberFields numFills fieldsToFill = do
index <- take numFills [0..]
field <- fieldsToFill
return . fillIncompleteFields field index . formatOrdinal $ index + 1
-- * Various helper functions for property retrieval
-- | Helper function for primary node retrieval
getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node
getPrimaryNode cfg = getInstPrimaryNode cfg . instName
......
......@@ -59,6 +59,7 @@ module Ganeti.Utils
, recombineEithers
, resolveAddr
, setOwnerAndGroupFromNames
, formatOrdinal
) where
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
......@@ -473,3 +474,14 @@ setOwnerAndGroupFromNames filename daemon dGroup = do
let uid = fst ents M.! daemon
let gid = snd ents M.! dGroup
setOwnerAndGroup filename uid gid
-- | Formats an integral number, appending a suffix.
formatOrdinal :: (Integral a, Show a) => a -> String
formatOrdinal num
| num > 10 && num < 20 = suffix "th"
| tens == 1 = suffix "st"
| tens == 2 = suffix "nd"
| tens == 3 = suffix "rd"
| otherwise = suffix "th"
where tens = num `mod` 10
suffix s = show num ++ s
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment