Revision 3a991f2d src/Ganeti/Objects.hs
b/src/Ganeti/Objects.hs | ||
---|---|---|
9 | 9 |
|
10 | 10 |
{- |
11 | 11 |
|
12 |
Copyright (C) 2011, 2012 Google Inc. |
|
12 |
Copyright (C) 2011, 2012, 2013 Google Inc.
|
|
13 | 13 |
|
14 | 14 |
This program is free software; you can redistribute it and/or modify |
15 | 15 |
it under the terms of the GNU General Public License as published by |
... | ... | |
88 | 88 |
, DictObject(..) -- re-exported from THH |
89 | 89 |
, TagSet -- re-exported from THH |
90 | 90 |
, Network(..) |
91 |
, Ip4Address(..) |
|
92 |
, Ip4Network(..) |
|
93 |
, readIp4Address |
|
94 |
, nextIp4Address |
|
91 | 95 |
) where |
92 | 96 |
|
97 |
import Control.Applicative |
|
93 | 98 |
import Data.List (foldl') |
94 | 99 |
import Data.Maybe |
95 | 100 |
import qualified Data.Map as Map |
96 | 101 |
import qualified Data.Set as Set |
97 |
import Text.JSON (showJSON, readJSON, JSON, JSValue(..)) |
|
102 |
import Data.Word |
|
103 |
import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString) |
|
98 | 104 |
import qualified Text.JSON as J |
99 | 105 |
|
100 | 106 |
import qualified Ganeti.Constants as C |
101 | 107 |
import Ganeti.JSON |
102 | 108 |
import Ganeti.Types |
103 | 109 |
import Ganeti.THH |
110 |
import Ganeti.Utils (sepSplit, tryRead) |
|
104 | 111 |
|
105 | 112 |
-- * Generic definitions |
106 | 113 |
|
... | ... | |
168 | 175 |
|
169 | 176 |
-- * Network definitions |
170 | 177 |
|
178 |
-- ** Ipv4 types |
|
179 |
|
|
180 |
-- | Custom type for a simple IPv4 address. |
|
181 |
data Ip4Address = Ip4Address Word8 Word8 Word8 Word8 |
|
182 |
deriving Eq |
|
183 |
|
|
184 |
instance Show Ip4Address where |
|
185 |
show (Ip4Address a b c d) = show a ++ "." ++ show b ++ "." ++ |
|
186 |
show c ++ "." ++ show d |
|
187 |
|
|
188 |
-- | Parses an IPv4 address from a string. |
|
189 |
readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address |
|
190 |
readIp4Address s = |
|
191 |
case sepSplit '.' s of |
|
192 |
[a, b, c, d] -> Ip4Address <$> |
|
193 |
tryRead "first octect" a <*> |
|
194 |
tryRead "second octet" b <*> |
|
195 |
tryRead "third octet" c <*> |
|
196 |
tryRead "fourth octet" d |
|
197 |
_ -> fail $ "Can't parse IPv4 address from string " ++ s |
|
198 |
|
|
199 |
-- | JSON instance for 'Ip4Address'. |
|
200 |
instance JSON Ip4Address where |
|
201 |
showJSON = showJSON . show |
|
202 |
readJSON (JSString s) = readIp4Address (fromJSString s) |
|
203 |
readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address" |
|
204 |
|
|
205 |
-- | \"Next\" address implementation for IPv4 addresses. |
|
206 |
-- |
|
207 |
-- Note that this loops! Note also that this is a very dumb |
|
208 |
-- implementation. |
|
209 |
nextIp4Address :: Ip4Address -> Ip4Address |
|
210 |
nextIp4Address (Ip4Address a b c d) = |
|
211 |
let inc xs y = if all (==0) xs then y + 1 else y |
|
212 |
d' = d + 1 |
|
213 |
c' = inc [d'] c |
|
214 |
b' = inc [c', d'] b |
|
215 |
a' = inc [b', c', d'] a |
|
216 |
in Ip4Address a' b' c' d' |
|
217 |
|
|
218 |
-- | Custom type for an IPv4 network. |
|
219 |
data Ip4Network = Ip4Network Ip4Address Word8 |
|
220 |
deriving Eq |
|
221 |
|
|
222 |
instance Show Ip4Network where |
|
223 |
show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask |
|
224 |
|
|
225 |
-- | JSON instance for 'Ip4Network'. |
|
226 |
instance JSON Ip4Network where |
|
227 |
showJSON = showJSON . show |
|
228 |
readJSON (JSString s) = |
|
229 |
case sepSplit '/' (fromJSString s) of |
|
230 |
[ip, nm] -> do |
|
231 |
ip' <- readIp4Address ip |
|
232 |
nm' <- tryRead "parsing netmask" nm |
|
233 |
if nm' >= 0 && nm' <= 32 |
|
234 |
then return $ Ip4Network ip' nm' |
|
235 |
else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++ |
|
236 |
fromJSString s |
|
237 |
_ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s |
|
238 |
readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network" |
|
239 |
|
|
240 |
-- ** Ganeti \"network\" config object. |
|
241 |
|
|
171 | 242 |
-- FIXME: Not all types might be correct here, since they |
172 | 243 |
-- haven't been exhaustively deduced from the python code yet. |
173 | 244 |
$(buildObject "Network" "network" $ |
174 | 245 |
[ simpleField "name" [t| NonEmptyString |] |
175 | 246 |
, optionalField $ |
176 | 247 |
simpleField "mac_prefix" [t| String |] |
177 |
, simpleField "network" [t| NonEmptyString |]
|
|
248 |
, simpleField "network" [t| Ip4Network |]
|
|
178 | 249 |
, optionalField $ |
179 | 250 |
simpleField "network6" [t| String |] |
180 | 251 |
, optionalField $ |
181 |
simpleField "gateway" [t| String |]
|
|
252 |
simpleField "gateway" [t| Ip4Address |]
|
|
182 | 253 |
, optionalField $ |
183 | 254 |
simpleField "gateway6" [t| String |] |
184 | 255 |
, optionalField $ |
Also available in: Unified diff