root / htools / Ganeti / Confd.hs @ 152e05e1
History | View | Annotate | Download (5.3 kB)
1 | 417cc253 | Iustin Pop | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | 417cc253 | Iustin Pop | |
3 | 417cc253 | Iustin Pop | {-| Implementation of the Ganeti confd types. |
4 | 417cc253 | Iustin Pop | |
5 | 417cc253 | Iustin Pop | -} |
6 | 417cc253 | Iustin Pop | |
7 | 417cc253 | Iustin Pop | {- |
8 | 417cc253 | Iustin Pop | |
9 | 417cc253 | Iustin Pop | Copyright (C) 2011, 2012 Google Inc. |
10 | 417cc253 | Iustin Pop | |
11 | 417cc253 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
12 | 417cc253 | Iustin Pop | it under the terms of the GNU General Public License as published by |
13 | 417cc253 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
14 | 417cc253 | Iustin Pop | (at your option) any later version. |
15 | 417cc253 | Iustin Pop | |
16 | 417cc253 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
17 | 417cc253 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | 417cc253 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 | 417cc253 | Iustin Pop | General Public License for more details. |
20 | 417cc253 | Iustin Pop | |
21 | 417cc253 | Iustin Pop | You should have received a copy of the GNU General Public License |
22 | 417cc253 | Iustin Pop | along with this program; if not, write to the Free Software |
23 | 417cc253 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 | 417cc253 | Iustin Pop | 02110-1301, USA. |
25 | 417cc253 | Iustin Pop | |
26 | 417cc253 | Iustin Pop | -} |
27 | 417cc253 | Iustin Pop | |
28 | 417cc253 | Iustin Pop | module Ganeti.Confd |
29 | 417cc253 | Iustin Pop | ( C.confdProtocolVersion |
30 | 417cc253 | Iustin Pop | , C.confdMaxClockSkew |
31 | 417cc253 | Iustin Pop | , C.confdConfigReloadTimeout |
32 | 417cc253 | Iustin Pop | , C.confdConfigReloadRatelimit |
33 | 417cc253 | Iustin Pop | , C.confdMagicFourcc |
34 | 417cc253 | Iustin Pop | , C.confdDefaultReqCoverage |
35 | 417cc253 | Iustin Pop | , C.confdClientExpireTimeout |
36 | 417cc253 | Iustin Pop | , C.maxUdpDataSize |
37 | 417cc253 | Iustin Pop | , ConfdRequestType(..) |
38 | 417cc253 | Iustin Pop | , ConfdReqQ(..) |
39 | 417cc253 | Iustin Pop | , ConfdReqField(..) |
40 | 417cc253 | Iustin Pop | , ConfdReplyStatus(..) |
41 | 417cc253 | Iustin Pop | , ConfdNodeRole(..) |
42 | 417cc253 | Iustin Pop | , ConfdErrorType(..) |
43 | 417cc253 | Iustin Pop | , ConfdRequest(..) |
44 | 417cc253 | Iustin Pop | , ConfdReply(..) |
45 | 417cc253 | Iustin Pop | , ConfdQuery(..) |
46 | 417cc253 | Iustin Pop | , SignedMessage(..) |
47 | 417cc253 | Iustin Pop | ) where |
48 | 417cc253 | Iustin Pop | |
49 | 417cc253 | Iustin Pop | import Text.JSON |
50 | 417cc253 | Iustin Pop | |
51 | 417cc253 | Iustin Pop | import qualified Ganeti.Constants as C |
52 | 417cc253 | Iustin Pop | import Ganeti.THH |
53 | 417cc253 | Iustin Pop | import Ganeti.HTools.JSON |
54 | 417cc253 | Iustin Pop | |
55 | 417cc253 | Iustin Pop | {- |
56 | 417cc253 | Iustin Pop | Note that we re-export as is from Constants the following simple items: |
57 | 417cc253 | Iustin Pop | - confdProtocolVersion |
58 | 417cc253 | Iustin Pop | - confdMaxClockSkew |
59 | 417cc253 | Iustin Pop | - confdConfigReloadTimeout |
60 | 417cc253 | Iustin Pop | - confdConfigReloadRatelimit |
61 | 417cc253 | Iustin Pop | - confdMagicFourcc |
62 | 417cc253 | Iustin Pop | - confdDefaultReqCoverage |
63 | 417cc253 | Iustin Pop | - confdClientExpireTimeout |
64 | 417cc253 | Iustin Pop | - maxUdpDataSize |
65 | 417cc253 | Iustin Pop | |
66 | 417cc253 | Iustin Pop | -} |
67 | 417cc253 | Iustin Pop | |
68 | 417cc253 | Iustin Pop | $(declareIADT "ConfdRequestType" |
69 | 417cc253 | Iustin Pop | [ ("ReqPing", 'C.confdReqPing ) |
70 | 417cc253 | Iustin Pop | , ("ReqNodeRoleByName", 'C.confdReqNodeRoleByname ) |
71 | 417cc253 | Iustin Pop | , ("ReqNodePipList", 'C.confdReqNodePipList ) |
72 | 417cc253 | Iustin Pop | , ("ReqNodePipByInstPip", 'C.confdReqNodePipByInstanceIp ) |
73 | 417cc253 | Iustin Pop | , ("ReqClusterMaster", 'C.confdReqClusterMaster ) |
74 | 417cc253 | Iustin Pop | , ("ReqMcPipList", 'C.confdReqMcPipList ) |
75 | 417cc253 | Iustin Pop | , ("ReqInstIpsList", 'C.confdReqInstancesIpsList ) |
76 | 417cc253 | Iustin Pop | ]) |
77 | 417cc253 | Iustin Pop | $(makeJSONInstance ''ConfdRequestType) |
78 | 417cc253 | Iustin Pop | |
79 | 417cc253 | Iustin Pop | $(declareSADT "ConfdReqField" |
80 | 417cc253 | Iustin Pop | [ ("ReqFieldName", 'C.confdReqfieldName ) |
81 | 417cc253 | Iustin Pop | , ("ReqFieldIp", 'C.confdReqfieldIp ) |
82 | 417cc253 | Iustin Pop | , ("ReqFieldMNodePip", 'C.confdReqfieldMnodePip ) |
83 | 417cc253 | Iustin Pop | ]) |
84 | 417cc253 | Iustin Pop | $(makeJSONInstance ''ConfdReqField) |
85 | 417cc253 | Iustin Pop | |
86 | 417cc253 | Iustin Pop | -- Confd request query fields. These are used to narrow down queries. |
87 | 417cc253 | Iustin Pop | -- These must be strings rather than integers, because json-encoding |
88 | 417cc253 | Iustin Pop | -- converts them to strings anyway, as they're used as dict-keys. |
89 | 417cc253 | Iustin Pop | |
90 | 417cc253 | Iustin Pop | $(buildObject "ConfdReqQ" "confdReqQ" |
91 | 417cc253 | Iustin Pop | [ renameField "Ip" $ |
92 | 417cc253 | Iustin Pop | optionalField $ simpleField C.confdReqqIp [t| String |] |
93 | 417cc253 | Iustin Pop | , renameField "IpList" $ |
94 | 417cc253 | Iustin Pop | defaultField [| [] |] $ |
95 | 417cc253 | Iustin Pop | simpleField C.confdReqqIplist [t| [String] |] |
96 | 417cc253 | Iustin Pop | , renameField "Link" $ optionalField $ |
97 | 417cc253 | Iustin Pop | simpleField C.confdReqqLink [t| String |] |
98 | 417cc253 | Iustin Pop | , renameField "Fields" $ defaultField [| [] |] $ |
99 | 417cc253 | Iustin Pop | simpleField C.confdReqqFields [t| [ConfdReqField] |] |
100 | 417cc253 | Iustin Pop | ]) |
101 | 417cc253 | Iustin Pop | |
102 | 417cc253 | Iustin Pop | -- | Confd query type. This is complex enough that we can't |
103 | 417cc253 | Iustin Pop | -- automatically derive it via THH. |
104 | 417cc253 | Iustin Pop | data ConfdQuery = EmptyQuery |
105 | 417cc253 | Iustin Pop | | PlainQuery String |
106 | 417cc253 | Iustin Pop | | DictQuery ConfdReqQ |
107 | 417cc253 | Iustin Pop | deriving (Show, Read, Eq) |
108 | 417cc253 | Iustin Pop | |
109 | 417cc253 | Iustin Pop | instance JSON ConfdQuery where |
110 | 417cc253 | Iustin Pop | readJSON o = case o of |
111 | 417cc253 | Iustin Pop | JSNull -> return EmptyQuery |
112 | 417cc253 | Iustin Pop | JSString s -> return . PlainQuery . fromJSString $ s |
113 | 417cc253 | Iustin Pop | JSObject _ -> fmap DictQuery (readJSON o::Result ConfdReqQ) |
114 | 417cc253 | Iustin Pop | _ -> fail $ "Cannot deserialise into ConfdQuery\ |
115 | 417cc253 | Iustin Pop | \ the value '" ++ show o ++ "'" |
116 | 417cc253 | Iustin Pop | showJSON cq = case cq of |
117 | 417cc253 | Iustin Pop | EmptyQuery -> JSNull |
118 | 417cc253 | Iustin Pop | PlainQuery s -> showJSON s |
119 | 417cc253 | Iustin Pop | DictQuery drq -> showJSON drq |
120 | 417cc253 | Iustin Pop | |
121 | 417cc253 | Iustin Pop | $(declareIADT "ConfdReplyStatus" |
122 | 417cc253 | Iustin Pop | [ ( "ReplyStatusOk", 'C.confdReplStatusOk ) |
123 | 417cc253 | Iustin Pop | , ( "ReplyStatusError", 'C.confdReplStatusError ) |
124 | 417cc253 | Iustin Pop | , ( "ReplyStatusNotImpl", 'C.confdReplStatusNotimplemented ) |
125 | 417cc253 | Iustin Pop | ]) |
126 | 417cc253 | Iustin Pop | $(makeJSONInstance ''ConfdReplyStatus) |
127 | 417cc253 | Iustin Pop | |
128 | 417cc253 | Iustin Pop | $(declareIADT "ConfdNodeRole" |
129 | 417cc253 | Iustin Pop | [ ( "NodeRoleMaster", 'C.confdNodeRoleMaster ) |
130 | 417cc253 | Iustin Pop | , ( "NodeRoleCandidate", 'C.confdNodeRoleCandidate ) |
131 | 417cc253 | Iustin Pop | , ( "NodeRoleOffline", 'C.confdNodeRoleOffline ) |
132 | 417cc253 | Iustin Pop | , ( "NodeRoleDrained", 'C.confdNodeRoleDrained ) |
133 | 417cc253 | Iustin Pop | , ( "NodeRoleRegular", 'C.confdNodeRoleRegular ) |
134 | 417cc253 | Iustin Pop | ]) |
135 | 417cc253 | Iustin Pop | $(makeJSONInstance ''ConfdNodeRole) |
136 | 417cc253 | Iustin Pop | |
137 | 417cc253 | Iustin Pop | |
138 | 417cc253 | Iustin Pop | -- Note that the next item is not a frozenset in Python, but we make |
139 | 417cc253 | Iustin Pop | -- it a separate type for safety |
140 | 417cc253 | Iustin Pop | |
141 | 417cc253 | Iustin Pop | $(declareIADT "ConfdErrorType" |
142 | 417cc253 | Iustin Pop | [ ( "ConfdErrorUnknownEntry", 'C.confdErrorUnknownEntry ) |
143 | 417cc253 | Iustin Pop | , ( "ConfdErrorInternal", 'C.confdErrorInternal ) |
144 | 417cc253 | Iustin Pop | , ( "ConfdErrorArgument", 'C.confdErrorArgument ) |
145 | 417cc253 | Iustin Pop | ]) |
146 | 417cc253 | Iustin Pop | $(makeJSONInstance ''ConfdErrorType) |
147 | 417cc253 | Iustin Pop | |
148 | 417cc253 | Iustin Pop | $(buildObject "ConfdRequest" "confdRq" $ |
149 | 417cc253 | Iustin Pop | [ simpleField "protocol" [t| Int |] |
150 | 417cc253 | Iustin Pop | , simpleField "type" [t| ConfdRequestType |] |
151 | 417cc253 | Iustin Pop | , defaultField [| EmptyQuery |] $ simpleField "query" [t| ConfdQuery |] |
152 | 417cc253 | Iustin Pop | , simpleField "rsalt" [t| String |] |
153 | 417cc253 | Iustin Pop | ]) |
154 | 417cc253 | Iustin Pop | |
155 | 417cc253 | Iustin Pop | $(buildObject "ConfdReply" "confdReply" |
156 | 417cc253 | Iustin Pop | [ simpleField "protocol" [t| Int |] |
157 | 417cc253 | Iustin Pop | , simpleField "status" [t| ConfdReplyStatus |] |
158 | 417cc253 | Iustin Pop | , simpleField "answer" [t| JSValue |] |
159 | 417cc253 | Iustin Pop | , simpleField "serial" [t| Int |] |
160 | 417cc253 | Iustin Pop | ]) |
161 | 417cc253 | Iustin Pop | |
162 | 417cc253 | Iustin Pop | $(buildObject "SignedMessage" "signedMsg" |
163 | 417cc253 | Iustin Pop | [ simpleField "hmac" [t| String |] |
164 | 417cc253 | Iustin Pop | , simpleField "msg" [t| String |] |
165 | 417cc253 | Iustin Pop | , simpleField "salt" [t| String |] |
166 | 417cc253 | Iustin Pop | ]) |