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 )
76 , ("ReqNodeDrbd", 'C.confdReqNodeDrbd )
78 $(makeJSONInstance ''ConfdRequestType)
80 $(declareSADT "ConfdReqField"
81 [ ("ReqFieldName", 'C.confdReqfieldName )
82 , ("ReqFieldIp", 'C.confdReqfieldIp )
83 , ("ReqFieldMNodePip", 'C.confdReqfieldMnodePip )
85 $(makeJSONInstance ''ConfdReqField)
87 -- Confd request query fields. These are used to narrow down queries.
88 -- These must be strings rather than integers, because json-encoding
89 -- converts them to strings anyway, as they're used as dict-keys.
91 $(buildObject "ConfdReqQ" "confdReqQ"
93 optionalField $ simpleField C.confdReqqIp [t| String |]
94 , renameField "IpList" $
95 defaultField [| [] |] $
96 simpleField C.confdReqqIplist [t| [String] |]
97 , renameField "Link" $ optionalField $
98 simpleField C.confdReqqLink [t| String |]
99 , renameField "Fields" $ defaultField [| [] |] $
100 simpleField C.confdReqqFields [t| [ConfdReqField] |]
103 -- | Confd query type. This is complex enough that we can't
104 -- automatically derive it via THH.
105 data ConfdQuery = EmptyQuery
107 | DictQuery ConfdReqQ
108 deriving (Show, Read, Eq)
110 instance JSON ConfdQuery where
111 readJSON o = case o of
112 JSNull -> return EmptyQuery
113 JSString s -> return . PlainQuery . fromJSString $ s
114 JSObject _ -> fmap DictQuery (readJSON o::Result ConfdReqQ)
115 _ -> fail $ "Cannot deserialise into ConfdQuery\
116 \ the value '" ++ show o ++ "'"
117 showJSON cq = case cq of
119 PlainQuery s -> showJSON s
120 DictQuery drq -> showJSON drq
122 $(declareIADT "ConfdReplyStatus"
123 [ ( "ReplyStatusOk", 'C.confdReplStatusOk )
124 , ( "ReplyStatusError", 'C.confdReplStatusError )
125 , ( "ReplyStatusNotImpl", 'C.confdReplStatusNotimplemented )
127 $(makeJSONInstance ''ConfdReplyStatus)
129 $(declareIADT "ConfdNodeRole"
130 [ ( "NodeRoleMaster", 'C.confdNodeRoleMaster )
131 , ( "NodeRoleCandidate", 'C.confdNodeRoleCandidate )
132 , ( "NodeRoleOffline", 'C.confdNodeRoleOffline )
133 , ( "NodeRoleDrained", 'C.confdNodeRoleDrained )
134 , ( "NodeRoleRegular", 'C.confdNodeRoleRegular )
136 $(makeJSONInstance ''ConfdNodeRole)
139 -- Note that the next item is not a frozenset in Python, but we make
140 -- it a separate type for safety
142 $(declareIADT "ConfdErrorType"
143 [ ( "ConfdErrorUnknownEntry", 'C.confdErrorUnknownEntry )
144 , ( "ConfdErrorInternal", 'C.confdErrorInternal )
145 , ( "ConfdErrorArgument", 'C.confdErrorArgument )
147 $(makeJSONInstance ''ConfdErrorType)
149 $(buildObject "ConfdRequest" "confdRq" $
150 [ simpleField "protocol" [t| Int |]
151 , simpleField "type" [t| ConfdRequestType |]
152 , defaultField [| EmptyQuery |] $ simpleField "query" [t| ConfdQuery |]
153 , simpleField "rsalt" [t| String |]
156 $(buildObject "ConfdReply" "confdReply"
157 [ simpleField "protocol" [t| Int |]
158 , simpleField "status" [t| ConfdReplyStatus |]
159 , simpleField "answer" [t| JSValue |]
160 , simpleField "serial" [t| Int |]
163 $(buildObject "SignedMessage" "signedMsg"
164 [ simpleField "hmac" [t| String |]
165 , simpleField "msg" [t| String |]
166 , simpleField "salt" [t| String |]