This patch adds some very simple IPv4 address/network types, and uses them in the 'Network' config object.
We need these in order to properly compute the reserved IP addresses, without depending on an external library (which I haven't found, by the way). Currently the only operation supported is 'get next IP address', which is enough for us. Signed-off-by: Iustin Pop <[email protected]> --- src/Ganeti/Objects.hs | 79 +++++++++++++++++++++++++++++++++++++-- test/hs/Test/Ganeti/Objects.hs | 45 +++++++++++++++++++--- test/hs/Test/Ganeti/TestCommon.hs | 3 +- 3 files changed, 117 insertions(+), 10 deletions(-) diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs index bb7f841..6f2055c 100644 --- a/src/Ganeti/Objects.hs +++ b/src/Ganeti/Objects.hs @@ -9,7 +9,7 @@ commented out below. {- -Copyright (C) 2011, 2012 Google Inc. +Copyright (C) 2011, 2012, 2013 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -88,19 +88,26 @@ module Ganeti.Objects , DictObject(..) -- re-exported from THH , TagSet -- re-exported from THH , Network(..) + , Ip4Address(..) + , Ip4Network(..) + , readIp4Address + , nextIp4Address ) where +import Control.Applicative import Data.List (foldl') import Data.Maybe import qualified Data.Map as Map import qualified Data.Set as Set -import Text.JSON (showJSON, readJSON, JSON, JSValue(..)) +import Data.Word +import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString) import qualified Text.JSON as J import qualified Ganeti.Constants as C import Ganeti.JSON import Ganeti.Types import Ganeti.THH +import Ganeti.Utils (sepSplit, tryRead) -- * Generic definitions @@ -168,17 +175,81 @@ roleDescription NRMaster = "master" -- * Network definitions +-- ** Ipv4 types + +-- | Custom type for a simple IPv4 address. +data Ip4Address = Ip4Address Word8 Word8 Word8 Word8 + deriving Eq + +instance Show Ip4Address where + show (Ip4Address a b c d) = show a ++ "." ++ show b ++ "." ++ + show c ++ "." ++ show d + +-- | Parses an IPv4 address from a string. +readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address +readIp4Address s = + case sepSplit '.' s of + [a, b, c, d] -> Ip4Address <$> + tryRead "first octect" a <*> + tryRead "second octet" b <*> + tryRead "third octet" c <*> + tryRead "fourth octet" d + _ -> fail $ "Can't parse IPv4 address from string " ++ s + +-- | JSON instance for 'Ip4Address'. +instance JSON Ip4Address where + showJSON = showJSON . show + readJSON (JSString s) = readIp4Address (fromJSString s) + readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address" + +-- | \"Next\" address implementation for IPv4 addresses. +-- +-- Note that this loops! Note also that this is a very dumb +-- implementation. +nextIp4Address :: Ip4Address -> Ip4Address +nextIp4Address (Ip4Address a b c d) = + let inc xs y = if all (==0) xs then y + 1 else y + d' = d + 1 + c' = inc [d'] c + b' = inc [c', d'] b + a' = inc [b', c', d'] a + in Ip4Address a' b' c' d' + +-- | Custom type for an IPv4 network. +data Ip4Network = Ip4Network Ip4Address Word8 + deriving Eq + +instance Show Ip4Network where + show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask + +-- | JSON instance for 'Ip4Network'. +instance JSON Ip4Network where + showJSON = showJSON . show + readJSON (JSString s) = + case sepSplit '/' (fromJSString s) of + [ip, nm] -> do + ip' <- readIp4Address ip + nm' <- tryRead "parsing netmask" nm + if nm' >= 0 && nm' <= 32 + then return $ Ip4Network ip' nm' + else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++ + fromJSString s + _ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s + readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network" + +-- ** Ganeti \"network\" config object. + -- FIXME: Not all types might be correct here, since they -- haven't been exhaustively deduced from the python code yet. $(buildObject "Network" "network" $ [ simpleField "name" [t| NonEmptyString |] , optionalField $ simpleField "mac_prefix" [t| String |] - , simpleField "network" [t| NonEmptyString |] + , simpleField "network" [t| Ip4Network |] , optionalField $ simpleField "network6" [t| String |] , optionalField $ - simpleField "gateway" [t| String |] + simpleField "gateway" [t| Ip4Address |] , optionalField $ simpleField "gateway6" [t| String |] , optionalField $ diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs index 1bcbbb7..1655aaf 100644 --- a/test/hs/Test/Ganeti/Objects.hs +++ b/test/hs/Test/Ganeti/Objects.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances, + OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. @@ -44,7 +45,9 @@ import Control.Monad import Data.Char import qualified Data.List as List import qualified Data.Map as Map +import Data.Maybe (fromMaybe) import qualified Data.Set as Set +import GHC.Exts (IsString(..)) import qualified Text.JSON as J import Test.Ganeti.TestHelper @@ -182,17 +185,17 @@ instance Arbitrary Network where genValidNetwork :: Gen Objects.Network genValidNetwork = do -- generate netmask for the IPv4 network - netmask <- choose (24::Int, 30) + netmask <- fromIntegral <$> choose (24::Int, 30) name <- genName >>= mkNonEmpty mac_prefix <- genMaybe genName - net <- genIp4NetWithNetmask netmask + net <- arbitrary net6 <- genMaybe genIp6Net - gateway <- genMaybe genIp4AddrStr + gateway <- genMaybe arbitrary gateway6 <- genMaybe genIp6Addr res <- liftM Just (genBitString $ netmask2NumHosts netmask) ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask) uuid <- arbitrary - let n = Network name mac_prefix net net6 gateway + let n = Network name mac_prefix (Ip4Network net netmask) net6 gateway gateway6 res ext_res uuid 0 Set.empty return n @@ -408,6 +411,36 @@ genNodeGroup = do instance Arbitrary NodeGroup where arbitrary = genNodeGroup +$(genArbitrary ''Ip4Address) + +$(genArbitrary ''Ip4Network) + +-- | Helper to compute absolute value of an IPv4 address. +ip4AddrValue :: Ip4Address -> Integer +ip4AddrValue (Ip4Address a b c d) = + fromIntegral a * (2^(24::Integer)) + + fromIntegral b * (2^(16::Integer)) + + fromIntegral c * (2^(8::Integer)) + fromIntegral d + +-- | Tests that any difference between IPv4 consecutive addresses is 1. +prop_nextIp4Address :: Ip4Address -> Property +prop_nextIp4Address ip4 = + ip4AddrValue (nextIp4Address ip4) ==? ip4AddrValue ip4 + 1 + +-- | IsString instance for 'Ip4Address', to help write the tests. +instance IsString Ip4Address where + fromString s = + fromMaybe (error $ "Failed to parse address from " ++ s) (readIp4Address s) + +-- | Tests a few simple cases of IPv4 next address. +caseNextIp4Address :: HUnit.Assertion +caseNextIp4Address = do + HUnit.assertEqual "" "0.0.0.1" $ nextIp4Address "0.0.0.0" + HUnit.assertEqual "" "0.0.0.0" $ nextIp4Address "255.255.255.255" + HUnit.assertEqual "" "1.2.3.5" $ nextIp4Address "1.2.3.4" + HUnit.assertEqual "" "1.3.0.0" $ nextIp4Address "1.2.255.255" + HUnit.assertEqual "" "1.2.255.63" $ nextIp4Address "1.2.255.62" + testSuite "Objects" [ 'prop_fillDict , 'prop_Disk_serialisation @@ -417,4 +450,6 @@ testSuite "Objects" , 'prop_Config_serialisation , 'casePyCompatNetworks , 'casePyCompatNodegroups + , 'prop_nextIp4Address + , 'caseNextIp4Address ] diff --git a/test/hs/Test/Ganeti/TestCommon.hs b/test/hs/Test/Ganeti/TestCommon.hs index 43765e5..7c861a5 100644 --- a/test/hs/Test/Ganeti/TestCommon.hs +++ b/test/hs/Test/Ganeti/TestCommon.hs @@ -65,6 +65,7 @@ import Control.Applicative import Control.Exception (catchJust) import Control.Monad import Data.List +import Data.Word import qualified Data.Set as Set import System.Environment (getEnv) import System.Exit (ExitCode(..)) @@ -280,7 +281,7 @@ genIp4Net = do -- | Helper function to compute the number of hosts in a network -- given the netmask. (For IPv4 only.) -netmask2NumHosts :: Int -> Int +netmask2NumHosts :: Word8 -> Int netmask2NumHosts n = 2^(32-n) -- | Generates an arbitrary IPv6 network address in textual form. -- 1.8.1.3
