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   , rsUnavail
  29   , rsNormal
  30   , rsMaybe
  31   , rsUnknown
  32   , missingRuntime
  33   , rpcErrorToStatus
  34   , timeStampFields
  35   , uuidFields
  36   , serialFields
  37   , tagsFields
  38   , dictFieldGetter
  39   , buildQFTLookup
  40   , buildNdParamField
  41   ) where
  42
  43 import qualified Data.Map as Map
  44 import Data.Maybe (fromMaybe)
  45 import Text.JSON (JSON, showJSON)
  46
  47 import qualified Ganeti.Constants as C
  48 import Ganeti.Config
  49 import Ganeti.Objects
  50 import Ganeti.Rpc
  51 import Ganeti.Query.Language
  52 import Ganeti.Query.Types
  53
  54 -- * Generic functions
  55
  56 -- | Conversion from 'VType' to 'FieldType'.
  57 vTypeToQFT :: VType -> FieldType
  58 vTypeToQFT VTypeString      = QFTOther
  59 vTypeToQFT VTypeMaybeString = QFTOther
  60 vTypeToQFT VTypeBool        = QFTBool
  61 vTypeToQFT VTypeSize        = QFTUnit
  62 vTypeToQFT VTypeInt         = QFTNumber
  63
  64 -- * Result helpers
  65
  66 -- | Helper for a result with no data.
  67 rsNoData :: ResultEntry
  68 rsNoData = ResultEntry RSNoData Nothing
  69
  70 -- | Helper for result for an entity which supports no such field.
  71 rsUnavail :: ResultEntry
  72 rsUnavail = ResultEntry RSUnavail Nothing
  73
  74 -- | Helper to declare a normal result.
  75 rsNormal :: (JSON a) => a -> ResultEntry
  76 rsNormal a = ResultEntry RSNormal $ Just (showJSON a)
  77
  78 -- | Helper to declare a result from a 'Maybe' (the item might be
  79 -- missing, in which case we return no data). Note that there's some
  80 -- ambiguity here: in some cases, we mean 'RSNoData', but in other
  81 -- 'RSUnavail'; this is easy to solve in simple cases, but not in
  82 -- nested dicts.
  83 rsMaybe :: (JSON a) => Maybe a -> ResultEntry
  84 rsMaybe = maybe rsNoData rsNormal
  85
  86 -- | Helper for unknown field result.
  87 rsUnknown :: ResultEntry
  88 rsUnknown = ResultEntry RSUnknown Nothing
  89
  90 -- | Helper for a missing runtime parameter.
  91 missingRuntime :: FieldGetter a b
  92 missingRuntime = FieldRuntime (\_ _ -> ResultEntry RSNoData Nothing)
  93
  94 -- * Error conversion
  95
  96 -- | Convert RpcError to ResultStatus
  97 rpcErrorToStatus :: RpcError -> ResultStatus
  98 rpcErrorToStatus (OfflineNodeError _) = RSOffline
  99 rpcErrorToStatus _ = RSNoData
 100
 101 -- * Common fields
 102
 103 -- | The list of timestamp fields.
 104 timeStampFields :: (TimeStampObject a) => FieldList a b
 105 timeStampFields =
 106   [ (FieldDefinition "ctime" "CTime" QFTTimestamp "Creation timestamp",
 107      FieldSimple (rsNormal . cTimeOf))
 108   , (FieldDefinition "mtime" "MTime" QFTTimestamp "Modification timestamp",
 109      FieldSimple (rsNormal . mTimeOf))
 110   ]
 111
 112 -- | The list of UUID fields.
 113 uuidFields :: (UuidObject a) => String -> FieldList a b
 114 uuidFields name =
 115   [ (FieldDefinition "uuid" "UUID" QFTText  (name ++ " UUID"),
 116      FieldSimple (rsNormal . uuidOf)) ]
 117
 118 -- | The list of serial number fields.
 119 serialFields :: (SerialNoObject a) => String -> FieldList a b
 120 serialFields name =
 121   [ (FieldDefinition "serial_no" "SerialNo" QFTNumber
 122      (name ++ " object serial number, incremented on each modification"),
 123      FieldSimple (rsNormal . serialOf)) ]
 124
 125 -- | The list of tag fields.
 126 tagsFields :: (TagsObject a) => FieldList a b
 127 tagsFields =
 128   [ (FieldDefinition "tags" "Tags" QFTOther "Tags",
 129      FieldSimple (rsNormal . tagsOf)) ]
 130
 131 -- * Generic parameter functions
 132
 133 -- | Returns a field from a (possibly missing) 'DictObject'. This is
 134 -- used by parameter dictionaries, usually. Note that we have two
 135 -- levels of maybe: the top level dict might be missing, or one key in
 136 -- the dictionary might be.
 137 dictFieldGetter :: (DictObject a) => String -> Maybe a -> ResultEntry
 138 dictFieldGetter k = maybe rsNoData (rsMaybe . lookup k . toDict)
 139
 140 -- | Build an optimised lookup map from a Python _PARAMETER_TYPES
 141 -- association list.
 142 buildQFTLookup :: [(String, String)] -> Map.Map String FieldType
 143 buildQFTLookup =
 144   Map.fromList .
 145   map (\(k, v) -> (k, maybe QFTOther vTypeToQFT (vTypeFromRaw v)))
 146
 147 -- | Ndparams optimised lookup map.
 148 ndParamTypes :: Map.Map String FieldType
 149 ndParamTypes = buildQFTLookup C.ndsParameterTypes
 150
 151 -- | Ndparams title map.
 152 ndParamTitles :: Map.Map String FieldTitle
 153 ndParamTitles = Map.fromList C.ndsParameterTitles
 154
 155 -- | Ndparam getter builder: given a field, it returns a FieldConfig
 156 -- getter, that is a function that takes the config and the object and
 157 -- returns the Ndparam field specified when the getter was built.
 158 ndParamGetter :: (NdParamObject a) =>
 159                  String -- ^ The field we're building the getter for
 160               -> ConfigData -> a -> ResultEntry
 161 ndParamGetter field config =
 162   dictFieldGetter field . getNdParamsOf config
 163
 164 -- | Builds the ndparam fields for an object.
 165 buildNdParamField :: (NdParamObject a) => String -> FieldData a b
 166 buildNdParamField field =
 167   let full_name = "ndp/" ++ field
 168       title = fromMaybe field $ field `Map.lookup` ndParamTitles
 169       qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
 170       desc = "The \"" ++ field ++ "\" node parameter"
 171   in (FieldDefinition full_name title qft desc,
 172       FieldConfig (ndParamGetter field))