Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Query / Common.hs @ 3e02cd3c

History | View | Annotate | Download (5.6 kB)

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), QffNormal)
108
  , (FieldDefinition "mtime" "MTime" QFTTimestamp "Modification timestamp",
109
     FieldSimple (rsNormal . mTimeOf), QffNormal)
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), QffNormal) ]
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), QffNormal) ]
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), QffNormal) ]
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), QffNormal)