Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Common.hs @ e78a8c0b

History | View | Annotate | Download (6.1 kB)

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
  , buildQFTLookup
41
  , buildNdParamField
42
  ) where
43

    
44
import qualified Data.Map as Map
45
import Data.Maybe (fromMaybe)
46
import Text.JSON (JSON, showJSON)
47

    
48
import qualified Ganeti.Constants as C
49
import Ganeti.Config
50
import Ganeti.Objects
51
import Ganeti.Rpc
52
import Ganeti.Query.Language
53
import Ganeti.Query.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
-- | Build an optimised lookup map from a Python _PARAMETER_TYPES
150
-- association list.
151
buildQFTLookup :: [(String, String)] -> Map.Map String FieldType
152
buildQFTLookup =
153
  Map.fromList .
154
  map (\(k, v) -> (k, maybe QFTOther vTypeToQFT (vTypeFromRaw v)))
155

    
156
-- | Ndparams optimised lookup map.
157
ndParamTypes :: Map.Map String FieldType
158
ndParamTypes = buildQFTLookup C.ndsParameterTypes
159

    
160
-- | Ndparams title map.
161
ndParamTitles :: Map.Map String FieldTitle
162
ndParamTitles = Map.fromList C.ndsParameterTitles
163

    
164
-- | Ndparam getter builder: given a field, it returns a FieldConfig
165
-- getter, that is a function that takes the config and the object and
166
-- returns the Ndparam field specified when the getter was built.
167
ndParamGetter :: (NdParamObject a) =>
168
                 String -- ^ The field we're building the getter for
169
              -> ConfigData -> a -> ResultEntry
170
ndParamGetter field config =
171
  dictFieldGetter field . getNdParamsOf config
172

    
173
-- | Builds the ndparam fields for an object.
174
buildNdParamField :: (NdParamObject a) => String -> FieldData a b
175
buildNdParamField field =
176
  let full_name = "ndp/" ++ field
177
      title = fromMaybe field $ field `Map.lookup` ndParamTitles
178
      qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
179
      desc = "The \"" ++ field ++ "\" node parameter"
180
  in (FieldDefinition full_name title qft desc,
181
      FieldConfig (ndParamGetter field), QffNormal)