code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Query/Common.hs

   1 {-| Implementation of the Ganeti Query2 common objects.
   2
   3  -}
   4
   5 {-
   6
   7 Copyright (C) 2012 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.Query.Common
  27   ( rsNoData
  28   , rsNormal
  29   , rsMaybe
  30   , rsUnknown
  31   , missingRuntime
  32   , timeStampFields
  33   , uuidFields
  34   , serialFields
  35   , tagsFields
  36   , dictFieldGetter
  37   , buildQFTLookup
  38   , buildNdParamField
  39   ) where
  40
  41 import qualified Data.Map as Map
  42 import Data.Maybe (fromMaybe)
  43 import Text.JSON (JSON, showJSON)
  44
  45 import qualified Ganeti.Constants as C
  46 import Ganeti.Config
  47 import Ganeti.Objects
  48 import Ganeti.Qlang
  49 import Ganeti.Query.Types
  50
  51 -- * Generic functions
  52
  53 -- | Conversion from 'VType' to 'FieldType'.
  54 vTypeToQFT :: VType -> FieldType
  55 vTypeToQFT VTypeString      = QFTOther
  56 vTypeToQFT VTypeMaybeString = QFTOther
  57 vTypeToQFT VTypeBool        = QFTBool
  58 vTypeToQFT VTypeSize        = QFTUnit
  59 vTypeToQFT VTypeInt         = QFTNumber
  60
  61 -- * Result helpers
  62
  63 -- | Helper for a result with no data.
  64 rsNoData :: ResultEntry
  65 rsNoData = ResultEntry RSNoData Nothing
  66
  67 -- | Helper to declare a normal result.
  68 rsNormal :: (JSON a) => a -> ResultEntry
  69 rsNormal a = ResultEntry RSNormal $ Just (showJSON a)
  70
  71 -- | Helper to declare a result from a 'Maybe' (the item might be
  72 -- missing, in which case we return no data). Note that there's some
  73 -- ambiguity here: in some cases, we mean 'RSNoData', but in other
  74 -- 'RSUnavail'; this is easy to solve in simple cases, but not in
  75 -- nested dicts.
  76 rsMaybe :: (JSON a) => Maybe a -> ResultEntry
  77 rsMaybe = maybe rsNoData rsNormal
  78
  79 -- | Helper for unknown field result.
  80 rsUnknown :: ResultEntry
  81 rsUnknown = ResultEntry RSUnknown Nothing
  82
  83 -- | Helper for a missing runtime parameter.
  84 missingRuntime :: FieldGetter a b
  85 missingRuntime = FieldRuntime (\_ _ -> ResultEntry RSNoData Nothing)
  86
  87 -- * Common fields
  88
  89 -- | The list of timestamp fields.
  90 timeStampFields :: (TimeStampObject a) => FieldList a b
  91 timeStampFields =
  92   [ (FieldDefinition "ctime" "CTime" QFTTimestamp "Creation timestamp",
  93      FieldSimple (rsNormal . cTimeOf))
  94   , (FieldDefinition "mtime" "MTime" QFTTimestamp "Modification timestamp",
  95      FieldSimple (rsNormal . mTimeOf))
  96   ]
  97
  98 -- | The list of UUID fields.
  99 uuidFields :: (UuidObject a) => String -> FieldList a b
 100 uuidFields name =
 101   [ (FieldDefinition "uuid" "UUID" QFTText  (name ++ " UUID"),
 102      FieldSimple (rsNormal . uuidOf)) ]
 103
 104 -- | The list of serial number fields.
 105 serialFields :: (SerialNoObject a) => String -> FieldList a b
 106 serialFields name =
 107   [ (FieldDefinition "serial_no" "SerialNo" QFTNumber
 108      (name ++ " object serial number, incremented on each modification"),
 109      FieldSimple (rsNormal . serialOf)) ]
 110
 111 -- | The list of tag fields.
 112 tagsFields :: (TagsObject a) => FieldList a b
 113 tagsFields =
 114   [ (FieldDefinition "tags" "Tags" QFTOther "Tags",
 115      FieldSimple (rsNormal . tagsOf)) ]
 116
 117 -- * Generic parameter functions
 118
 119 -- | Returns a field from a (possibly missing) 'DictObject'. This is
 120 -- used by parameter dictionaries, usually. Note that we have two
 121 -- levels of maybe: the top level dict might be missing, or one key in
 122 -- the dictionary might be.
 123 dictFieldGetter :: (DictObject a) => String -> Maybe a -> ResultEntry
 124 dictFieldGetter k = maybe rsNoData (rsMaybe . lookup k . toDict)
 125
 126 -- | Build an optimised lookup map from a Python _PARAMETER_TYPES
 127 -- association list.
 128 buildQFTLookup :: [(String, String)] -> Map.Map String FieldType
 129 buildQFTLookup =
 130   Map.fromList .
 131   map (\(k, v) -> (k, maybe QFTOther vTypeToQFT (vTypeFromRaw v)))
 132
 133 -- | Ndparams optimised lookup map.
 134 ndParamTypes :: Map.Map String FieldType
 135 ndParamTypes = buildQFTLookup C.ndsParameterTypes
 136
 137 -- | Ndparams title map.
 138 ndParamTitles :: Map.Map String FieldTitle
 139 ndParamTitles = Map.fromList C.ndsParameterTitles
 140
 141 -- | Ndparam getter builder: given a field, it returns a FieldConfig
 142 -- getter, that is a function that takes the config and the object and
 143 -- returns the Ndparam field specified when the getter was built.
 144 ndParamGetter :: (NdParamObject a) =>
 145                  String -- ^ The field we're building the getter for
 146               -> ConfigData -> a -> ResultEntry
 147 ndParamGetter field config =
 148   dictFieldGetter field . getNdParamsOf config
 149
 150 -- | Builds the ndparam fields for an object.
 151 buildNdParamField :: (NdParamObject a) => String -> FieldData a b
 152 buildNdParamField field =
 153   let full_name = "ndp/" ++ field
 154       title = fromMaybe field $ field `Map.lookup` ndParamTitles
 155       qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
 156       desc = "The \"" ++ field ++ "\" node parameter"
 157   in (FieldDefinition full_name title qft desc,
 158       FieldConfig (ndParamGetter field))