This will allow to replace the implementation later, if we need more
complex operations on IP addresses, add IPv6 etc.
(Package 'iproute' would be a good candidate.)

Signed-off-by: Petr Pudlak <[email protected]>
---
 src/Ganeti/Objects.hs          | 65 ++++++++++++++++++++++++++++--------------
 src/Ganeti/Query/Network.hs    |  4 +--
 test/hs/Test/Ganeti/Objects.hs | 27 ++++++++++--------
 3 files changed, 60 insertions(+), 36 deletions(-)

diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs
index d89314d..730a39b 100644
--- a/src/Ganeti/Objects.hs
+++ b/src/Ganeti/Objects.hs
@@ -87,20 +87,30 @@ module Ganeti.Objects
   , DictObject(..) -- re-exported from THH
   , TagSet -- re-exported from THH
   , Network(..)
-  , Ip4Address(..)
-  , Ip4Network(..)
+  , Ip4Address()
+  , mkIp4Address
+  , Ip4Network()
+  , mkIp4Network
+  , ip4netAddr
+  , ip4netMask
   , readIp4Address
+  , ip4AddressToList
+  , ip4AddressToNumber
+  , ip4AddressFromNumber
   , nextIp4Address
   , IAllocatorParams
   , MasterNetworkParameters(..)
   ) where
 
 import Control.Applicative
+import Control.Arrow (first)
+import Control.Monad.State
 import Data.Char
-import Data.List (foldl', isPrefixOf, isInfixOf)
+import Data.List (foldl', isPrefixOf, isInfixOf, intercalate)
 import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import Data.Tuple (swap)
 import Data.Word
 import System.Time (ClockTime(..))
 import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString)
@@ -156,15 +166,15 @@ class TagsObject a where
 
 -- ** Ipv4 types
 
--- | Custom type for a simple IPv4 address.
 data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
-                  deriving Eq
+  deriving (Eq, Ord)
+
+mkIp4Address :: (Word8, Word8, Word8, Word8) -> Ip4Address
+mkIp4Address (a, b, c, d) = Ip4Address a b c d
 
 instance Show Ip4Address where
-  show (Ip4Address a b c d) = show a ++ "." ++ show b ++ "." ++
-                              show c ++ "." ++ show d
+  show (Ip4Address a b c d) = intercalate "." $ map show [a, b, c, d]
 
--- | Parses an IPv4 address from a string.
 readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address
 readIp4Address s =
   case sepSplit '.' s of
@@ -175,28 +185,39 @@ readIp4Address s =
                       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.
+-- Converts an address to a list of numbers
+ip4AddressToList :: Ip4Address -> [Word8]
+ip4AddressToList (Ip4Address a b c d) = [a, b, c, d]
+
+-- | Converts an address into its ordinal number.
+-- This is needed for indexing IP adresses in reservation pools.
+ip4AddressToNumber :: Ip4Address -> Integer
+ip4AddressToNumber = foldl (\n i -> 256 * n + toInteger i) 0 . ip4AddressToList
+
+-- | Converts a number into an address.
+-- This is needed for indexing IP adresses in reservation pools.
+ip4AddressFromNumber :: Integer -> Ip4Address
+ip4AddressFromNumber n =
+  let s = state $ first fromInteger . swap . (`divMod` 256)
+      (d, c, b, a) = evalState ((,,,) <$> s <*> s <*> s <*> s) n
+   in Ip4Address a b c d
+
 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'
+nextIp4Address = ip4AddressFromNumber . (+ 1) . ip4AddressToNumber
 
 -- | Custom type for an IPv4 network.
-data Ip4Network = Ip4Network Ip4Address Word8
-                  deriving Eq
+data Ip4Network = Ip4Network { ip4netAddr :: Ip4Address
+                             , ip4netMask :: Word8
+                             }
+                  deriving (Eq)
+
+mkIp4Network :: Ip4Address -> Word8 -> Ip4Network
+mkIp4Network = Ip4Network
 
 instance Show Ip4Network where
   show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask
diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs
index 2cfce05..3a4a31b 100644
--- a/src/Ganeti/Query/Network.hs
+++ b/src/Ganeti/Query/Network.hs
@@ -158,7 +158,7 @@ getNetworkUuid cfg name =
 -- This doesn't use the netmask for validation of the length, instead
 -- simply iterating over the reservations string.
 getReservations :: Ip4Network -> String -> [Ip4Address]
-getReservations (Ip4Network net _) =
+getReservations net =
   reverse .
   fst .
   foldl' (\(accu, addr) c ->
@@ -169,7 +169,7 @@ getReservations (Ip4Network net _) =
                           _ -> -- FIXME: the reservations string
                                -- should be a proper type
                                accu
-            in (accu', addr')) ([], net)
+            in (accu', addr')) ([], ip4netAddr net)
 
 -- | Computes the external reservations as string for a network.
 getExtReservationsString :: Network -> ResultEntry
diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs
index 98b8c81..8377a31 100644
--- a/test/hs/Test/Ganeti/Objects.hs
+++ b/test/hs/Test/Ganeti/Objects.hs
@@ -278,7 +278,7 @@ genValidNetwork = do
   uuid <- arbitrary
   ctime <- arbitrary
   mtime <- arbitrary
-  let n = Network name mac_prefix (Ip4Network net netmask) net6 gateway
+  let n = Network name mac_prefix (mkIp4Network net netmask) net6 gateway
           gateway6 res ext_res uuid ctime mtime 0 Set.empty
   return n
 
@@ -516,21 +516,23 @@ genNodeGroup = do
 instance Arbitrary NodeGroup where
   arbitrary = genNodeGroup
 
-$(genArbitrary ''Ip4Address)
+instance Arbitrary Ip4Address where
+  arbitrary = liftM mkIp4Address $ (,,,) <$> choose (0, 255)
+                                         <*> choose (0, 255)
+                                         <*> choose (0, 255)
+                                         <*> choose (0, 255)
 
 $(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 conversions of ip addresses from/to numbers.
+prop_ip4AddressAsNum :: Ip4Address -> Property
+prop_ip4AddressAsNum ip4 =
+  ip4AddressFromNumber (ip4AddressToNumber ip4) ==? ip4
 
 -- | Tests that any difference between IPv4 consecutive addresses is 1.
-prop_nextIp4Address :: Ip4Address -> Property
-prop_nextIp4Address ip4 =
-  ip4AddrValue (nextIp4Address ip4) ==? ip4AddrValue ip4 + 1
+prop_ip4AddressFromNumber :: Property
+prop_ip4AddressFromNumber =
+  ip4AddressToNumber <$> readIp4Address "1.2.3.4" ==? Just 0x01020304
 
 -- | IsString instance for 'Ip4Address', to help write the tests.
 instance IsString Ip4Address where
@@ -646,7 +648,8 @@ testSuite "Objects"
   , 'casePyCompatNetworks
   , 'casePyCompatNodegroups
   , 'casePyCompatInstances
-  , 'prop_nextIp4Address
+  , 'prop_ip4AddressAsNum
+  , 'prop_ip4AddressFromNumber
   , 'caseNextIp4Address
   , 'caseIncludeLogicalIdPlain
   , 'caseIncludeLogicalIdDrbd
-- 
2.0.0.526.g5318336

Reply via email to