Revision 3a991f2d

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 $
b/test/hs/Test/Ganeti/Objects.hs
1
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
1
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances,
2
  OverloadedStrings #-}
2 3
{-# OPTIONS_GHC -fno-warn-orphans #-}
3 4

  
4 5
{-| Unittests for ganeti-htools.
......
44 45
import Data.Char
45 46
import qualified Data.List as List
46 47
import qualified Data.Map as Map
48
import Data.Maybe (fromMaybe)
47 49
import qualified Data.Set as Set
50
import GHC.Exts (IsString(..))
48 51
import qualified Text.JSON as J
49 52

  
50 53
import Test.Ganeti.TestHelper
......
182 185
genValidNetwork :: Gen Objects.Network
183 186
genValidNetwork = do
184 187
  -- generate netmask for the IPv4 network
185
  netmask <- choose (24::Int, 30)
188
  netmask <- fromIntegral <$> choose (24::Int, 30)
186 189
  name <- genName >>= mkNonEmpty
187 190
  mac_prefix <- genMaybe genName
188
  net <- genIp4NetWithNetmask netmask
191
  net <- arbitrary
189 192
  net6 <- genMaybe genIp6Net
190
  gateway <- genMaybe genIp4AddrStr
193
  gateway <- genMaybe arbitrary
191 194
  gateway6 <- genMaybe genIp6Addr
192 195
  res <- liftM Just (genBitString $ netmask2NumHosts netmask)
193 196
  ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask)
194 197
  uuid <- arbitrary
195
  let n = Network name mac_prefix net net6 gateway
198
  let n = Network name mac_prefix (Ip4Network net netmask) net6 gateway
196 199
          gateway6 res ext_res uuid 0 Set.empty
197 200
  return n
198 201

  
......
408 411
instance Arbitrary NodeGroup where
409 412
  arbitrary = genNodeGroup
410 413

  
414
$(genArbitrary ''Ip4Address)
415

  
416
$(genArbitrary ''Ip4Network)
417

  
418
-- | Helper to compute absolute value of an IPv4 address.
419
ip4AddrValue :: Ip4Address -> Integer
420
ip4AddrValue (Ip4Address a b c d) =
421
  fromIntegral a * (2^(24::Integer)) +
422
  fromIntegral b * (2^(16::Integer)) +
423
  fromIntegral c * (2^(8::Integer)) + fromIntegral d
424

  
425
-- | Tests that any difference between IPv4 consecutive addresses is 1.
426
prop_nextIp4Address :: Ip4Address -> Property
427
prop_nextIp4Address ip4 =
428
  ip4AddrValue (nextIp4Address ip4) ==? ip4AddrValue ip4 + 1
429

  
430
-- | IsString instance for 'Ip4Address', to help write the tests.
431
instance IsString Ip4Address where
432
  fromString s =
433
    fromMaybe (error $ "Failed to parse address from " ++ s) (readIp4Address s)
434

  
435
-- | Tests a few simple cases of IPv4 next address.
436
caseNextIp4Address :: HUnit.Assertion
437
caseNextIp4Address = do
438
  HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0"
439
  HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255"
440
  HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4"
441
  HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255"
442
  HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62"
443

  
411 444
testSuite "Objects"
412 445
  [ 'prop_fillDict
413 446
  , 'prop_Disk_serialisation
......
417 450
  , 'prop_Config_serialisation
418 451
  , 'casePyCompatNetworks
419 452
  , 'casePyCompatNodegroups
453
  , 'prop_nextIp4Address
454
  , 'caseNextIp4Address
420 455
  ]
b/test/hs/Test/Ganeti/TestCommon.hs
65 65
import Control.Exception (catchJust)
66 66
import Control.Monad
67 67
import Data.List
68
import Data.Word
68 69
import qualified Data.Set as Set
69 70
import System.Environment (getEnv)
70 71
import System.Exit (ExitCode(..))
......
280 281

  
281 282
-- | Helper function to compute the number of hosts in a network
282 283
-- given the netmask. (For IPv4 only.)
283
netmask2NumHosts :: Int -> Int
284
netmask2NumHosts :: Word8 -> Int
284 285
netmask2NumHosts n = 2^(32-n)
285 286

  
286 287
-- | Generates an arbitrary IPv6 network address in textual form.

Also available in: Unified diff