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