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

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