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