Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Confd / Types.hs @ 11e90588

History | View | Annotate | Download (6.1 kB)

1
{-# LANGUAGE TemplateHaskell #-}
2

    
3
{-| Implementation of the Ganeti confd types.
4

    
5
-}
6

    
7
{-
8

    
9
Copyright (C) 2011, 2012 Google Inc.
10

    
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.
15

    
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.
20

    
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
24
02110-1301, USA.
25

    
26
-}
27

    
28
module Ganeti.Confd.Types
29
  ( C.confdProtocolVersion
30
  , C.confdMaxClockSkew
31
  , C.confdConfigReloadTimeout
32
  , C.confdConfigReloadRatelimit
33
  , C.confdMagicFourcc
34
  , C.confdDefaultReqCoverage
35
  , C.confdClientExpireTimeout
36
  , C.maxUdpDataSize
37
  , ConfdClient(..)
38
  , ConfdRequestType(..)
39
  , ConfdReqQ(..)
40
  , ConfdReqField(..)
41
  , ConfdReplyStatus(..)
42
  , ConfdNodeRole(..)
43
  , ConfdErrorType(..)
44
  , ConfdRequest(..)
45
  , newConfdRequest
46
  , ConfdReply(..)
47
  , ConfdQuery(..)
48
  , SignedMessage(..)
49
  ) where
50

    
51
import Text.JSON
52
import qualified Network.Socket as S
53

    
54
import qualified Ganeti.Constants as C
55
import Ganeti.Hash
56
import Ganeti.THH
57
import Ganeti.Utils (newUUID)
58

    
59
{-
60
   Note that we re-export as is from Constants the following simple items:
61
   - confdProtocolVersion
62
   - confdMaxClockSkew
63
   - confdConfigReloadTimeout
64
   - confdConfigReloadRatelimit
65
   - confdMagicFourcc
66
   - confdDefaultReqCoverage
67
   - confdClientExpireTimeout
68
   - maxUdpDataSize
69

    
70
-}
71

    
72
$(declareIADT "ConfdRequestType"
73
  [ ("ReqPing",             'C.confdReqPing )
74
  , ("ReqNodeRoleByName",   'C.confdReqNodeRoleByname )
75
  , ("ReqNodePipList",      'C.confdReqNodePipList )
76
  , ("ReqNodePipByInstPip", 'C.confdReqNodePipByInstanceIp )
77
  , ("ReqClusterMaster",    'C.confdReqClusterMaster )
78
  , ("ReqMcPipList",        'C.confdReqMcPipList )
79
  , ("ReqInstIpsList",      'C.confdReqInstancesIpsList )
80
  , ("ReqNodeDrbd",         'C.confdReqNodeDrbd )
81
  , ("ReqNodeInstances",    'C.confdReqNodeInstances)
82
  ])
83
$(makeJSONInstance ''ConfdRequestType)
84

    
85
$(declareSADT "ConfdReqField"
86
  [ ("ReqFieldName",     'C.confdReqfieldName )
87
  , ("ReqFieldIp",       'C.confdReqfieldIp )
88
  , ("ReqFieldMNodePip", 'C.confdReqfieldMnodePip )
89
  ])
90
$(makeJSONInstance ''ConfdReqField)
91

    
92
-- Confd request query fields. These are used to narrow down queries.
93
-- These must be strings rather than integers, because json-encoding
94
-- converts them to strings anyway, as they're used as dict-keys.
95

    
96
$(buildObject "ConfdReqQ" "confdReqQ"
97
  [ renameField "Ip" .
98
                optionalField $ simpleField C.confdReqqIp [t| String   |]
99
  , renameField "IpList" .
100
                defaultField [| [] |] $
101
                simpleField C.confdReqqIplist [t| [String] |]
102
  , renameField "Link" . optionalField $
103
                simpleField C.confdReqqLink [t| String   |]
104
  , renameField "Fields" . defaultField [| [] |] $
105
                simpleField C.confdReqqFields [t| [ConfdReqField] |]
106
  ])
107

    
108
-- | Confd query type. This is complex enough that we can't
109
-- automatically derive it via THH.
110
data ConfdQuery = EmptyQuery
111
                | PlainQuery String
112
                | DictQuery  ConfdReqQ
113
                  deriving (Show, Eq)
114

    
115
instance JSON ConfdQuery where
116
  readJSON o = case o of
117
                 JSNull     -> return EmptyQuery
118
                 JSString s -> return . PlainQuery . fromJSString $ s
119
                 JSObject _ -> fmap DictQuery (readJSON o::Result ConfdReqQ)
120
                 _ -> fail $ "Cannot deserialise into ConfdQuery\
121
                             \ the value '" ++ show o ++ "'"
122
  showJSON cq = case cq of
123
                  EmptyQuery -> JSNull
124
                  PlainQuery s -> showJSON s
125
                  DictQuery drq -> showJSON drq
126

    
127
$(declareIADT "ConfdReplyStatus"
128
  [ ( "ReplyStatusOk",      'C.confdReplStatusOk )
129
  , ( "ReplyStatusError",   'C.confdReplStatusError )
130
  , ( "ReplyStatusNotImpl", 'C.confdReplStatusNotimplemented )
131
  ])
132
$(makeJSONInstance ''ConfdReplyStatus)
133

    
134
$(declareIADT "ConfdNodeRole"
135
  [ ( "NodeRoleMaster",    'C.confdNodeRoleMaster )
136
  , ( "NodeRoleCandidate", 'C.confdNodeRoleCandidate )
137
  , ( "NodeRoleOffline",   'C.confdNodeRoleOffline )
138
  , ( "NodeRoleDrained",   'C.confdNodeRoleDrained )
139
  , ( "NodeRoleRegular",   'C.confdNodeRoleRegular )
140
  ])
141
$(makeJSONInstance ''ConfdNodeRole)
142

    
143

    
144
-- Note that the next item is not a frozenset in Python, but we make
145
-- it a separate type for safety
146

    
147
$(declareIADT "ConfdErrorType"
148
  [ ( "ConfdErrorUnknownEntry", 'C.confdErrorUnknownEntry )
149
  , ( "ConfdErrorInternal",     'C.confdErrorInternal )
150
  , ( "ConfdErrorArgument",     'C.confdErrorArgument )
151
  ])
152
$(makeJSONInstance ''ConfdErrorType)
153

    
154
$(buildObject "ConfdRequest" "confdRq"
155
  [ simpleField "protocol" [t| Int |]
156
  , simpleField "type"     [t| ConfdRequestType |]
157
  , defaultField [| EmptyQuery |] $ simpleField "query" [t| ConfdQuery |]
158
  , simpleField "rsalt"    [t| String |]
159
  ])
160

    
161
-- | Client side helper function for creating requests. It automatically fills
162
-- in some default values.
163
newConfdRequest :: ConfdRequestType -> ConfdQuery -> IO ConfdRequest
164
newConfdRequest reqType query = do
165
  rsalt <- newUUID
166
  return $ ConfdRequest C.confdProtocolVersion reqType query rsalt
167

    
168
$(buildObject "ConfdReply" "confdReply"
169
  [ simpleField "protocol" [t| Int              |]
170
  , simpleField "status"   [t| ConfdReplyStatus |]
171
  , simpleField "answer"   [t| JSValue          |]
172
  , simpleField "serial"   [t| Int              |]
173
  ])
174

    
175
$(buildObject "SignedMessage" "signedMsg"
176
  [ simpleField "hmac" [t| String |]
177
  , simpleField "msg"  [t| String |]
178
  , simpleField "salt" [t| String |]
179
  ])
180

    
181
-- | Data type containing information used by the Confd client.
182
data ConfdClient = ConfdClient
183
  { hmacKey :: HashKey         -- ^ The hmac used for authentication
184
  , peers :: [String]          -- ^ The list of nodes to query
185
  , serverPort :: S.PortNumber -- ^ The port where confd server is listening
186
  }