Skip to content
Permalink
Browse files

Copy Saturn.Network into library

I'm planning to deprecate Saturn, since it's just a hodgepodge of random
functions that don't really go together. First step is to copy the
useful networking code from Saturn into here.
  • Loading branch information...
mdippery committed Aug 14, 2019
1 parent 942d477 commit ae002c547ac0fc200319f06d0d6ac0ec65c13908
Showing with 486 additions and 693 deletions.
  1. +159 −668 COPYING
  2. +5 −5 app/Main.hs
  3. +21 −2 package.yaml
  4. +160 −0 src/Network/IP/IPv4.hs
  5. +0 −3 stack.yaml
  6. +1 −15 stack.yaml.lock
  7. +139 −0 test/Network/IP/IPv4Spec.hs
  8. +1 −0 test/Spec.hs
827 COPYING

Large diffs are not rendered by default.

@@ -1,18 +1,18 @@
{-
Pyxis - A CIDR block calculator
Cider - A network calculator
Copyright (C) 2019 Michael Dippery <michael@monkey-robot.com>
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
the Free Software Foundation, either version 3 of the License, or
it under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}

@@ -26,7 +26,7 @@ import System.IO (hPutStrLn, stderr)
import Text.Printf (printf)
import Text.Read (readMaybe)

import Saturn.Network (IPAddressRange, addresses)
import Network.IP.IPv4 (IPAddressRange, addresses)

import qualified Paths_cider as P

@@ -19,7 +19,14 @@ extra-source-files:
description: Please see the README on GitHub at <https://github.com/mdippery/cider#readme>

dependencies:
- base >= 4.7 && < 5
- base >= 4.7 && < 5

library:
source-dirs: src
ghc-options:
- -Wall
dependencies:
- split

executables:
cider:
@@ -31,4 +38,16 @@ executables:
- -with-rtsopts=-N
- -Wall
dependencies:
- saturn
- cider

tests:
cider-test:
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- cider
- hspec
@@ -0,0 +1,160 @@
{-
Cider - A network calculator
Copyright (C) 2019 Michael Dippery <michael@monkey-robot.com>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}

{-# LANGUAGE TupleSections #-}


{-|
Module : Network.IP.IPv4
Description : Network-related data types and functions
License : LGPL
Maintainer : michael@monkey-robot.com
Models networks in Haskell.
-}
module Network.IP.IPv4
(
-- * Data types
IPAddress
, IPAddressRange

-- * Operations
, (.++.)
, (.:)

-- * Basic functions
, addresses
, length

-- * Searching
, contains
) where

import Prelude hiding (length)

import Control.Monad (ap)
import Data.Bits ((.&.), (.|.), Bits, shift)
import Data.Bool (bool)
import Data.List (intercalate, nub, sort)
import Data.Word (Word32)

import Data.List.Split (splitOn)

import qualified Prelude as P (length)

-- | A 32-bit IPv4 network address.
--
-- Create new IP addresses from their string representations using 'read':
--
-- >>> read "192.168.0.1" :: IPAddress
-- 192.168.0.1
newtype IPAddress = IPAddress { asInteger :: Word32 }

instance Show IPAddress where
show = addressToString . asInteger

instance Read IPAddress where
readsPrec _ = maybe [] (\a -> [(IPAddress a, "")]) . parseStringToAddress

instance Eq IPAddress where
(IPAddress x) == (IPAddress y) = x == y

instance Ord IPAddress where
(IPAddress x) `compare` (IPAddress y) = x `compare` y

instance Enum IPAddress where
toEnum = IPAddress . fromIntegral
fromEnum = fromIntegral . asInteger

instance Bounded IPAddress where
minBound = read "0.0.0.0"
maxBound = read "255.255.255.255"

-- | Represents a range of IP addresses.
--
-- Convert a string in CIDR notation to an address using 'read' to create
-- an @IPAddressRange@:
--
-- >>> read "192.168.0.0/24" :: IPAddressRange
newtype IPAddressRange = IPAddressRange
{ -- | List of all IP addresses in the address range.
addresses :: [IPAddress]
}

instance Show IPAddressRange where
show = show . addresses

instance Read IPAddressRange where
readsPrec _ = maybe [] (\as -> [(IPAddressRange as, "")]) . parseStringToRange

-- | '<>' is a synonym for '.++.'
instance Semigroup IPAddressRange where
(<>) = (.++.)

-- | 'mempty' returns an empty 'IPAddressRange'
instance Monoid IPAddressRange where
mempty = IPAddressRange []

addressToString :: (Show a, Bits a, Num a) => a -> String
addressToString n = intercalate "." $ map (show . shift') [24, 16, 8, 0]
where
shift' x = shift ((0xff `shift` x) .&. n) (-x)

parseStringToAddress :: String -> Maybe Word32
parseStringToAddress = fmap (foldr (.|.) 0 . zipWith (flip shift . (8 *)) [3, 2, 1, 0])
. mapM (maybeOctet . read)
. splitOn "."

parseStringToBlock :: String -> Maybe (Word32, Word32)
parseStringToBlock s =
case splitOn "/" s of
[ip, mask] -> (, read mask) <$> parseStringToAddress ip
_ -> Nothing

parseStringToRange :: String -> Maybe [IPAddress]
parseStringToRange s =
case parseStringToBlock s of
Nothing -> Nothing
Just (base, mask)
| mask > 32 -> Nothing
| otherwise ->
let mask' = 0xffffffff `shift` fromIntegral (32 - mask)
f a = a .&. mask' == base .&. mask'
in Just $ map IPAddress $ takeWhile f [base ..]

isOctet :: Word32 -> Bool
isOctet n = n >= 0 && n < 256

maybeOctet :: Word32 -> Maybe Word32
maybeOctet = ap (bool Nothing . Just) isOctet

-- | Combines two IP addresses into a single range.
(.++.) :: IPAddressRange -> IPAddressRange -> IPAddressRange
lhs .++. rhs = IPAddressRange $ sort $ nub $ addresses lhs ++ addresses rhs

-- | Adds an IP address to an existing range.
(.:) :: IPAddress -> IPAddressRange -> IPAddressRange
addr .: addrs = IPAddressRange $ sort $ nub $ addr : addresses addrs

-- | True if the given address is part of the given address range.
contains :: IPAddressRange -> IPAddress -> Bool
contains = flip elem . addresses

-- | Number of IP addresses contained in the block.
length :: IPAddressRange -> Int
length = P.length . addresses
@@ -1,6 +1,3 @@
resolver: lts-14.0
packages:
- .
extra-deps:
- git: https://github.com/mdippery/saturn.git
commit: 001cad974ef0fa602b6237589257e00c11fdf7e8
@@ -3,21 +3,7 @@
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files

packages:
- completed:
cabal-file:
size: 1679
sha256: ca88f20f5968694a4172b0d59e95f6c28f3bbd07fd03fa2f4e5ce09c1b0c48f6
name: saturn
version: 0.2.0.0
git: https://github.com/mdippery/saturn.git
pantry-tree:
size: 1602
sha256: 1e8be924ef804f77f8979e73a468767e6c342a0855042afcb63b3e5620a83413
commit: 001cad974ef0fa602b6237589257e00c11fdf7e8
original:
git: https://github.com/mdippery/saturn.git
commit: 001cad974ef0fa602b6237589257e00c11fdf7e8
packages: []
snapshots:
- completed:
size: 523443
@@ -0,0 +1,139 @@
module Network.IP.IPv4Spec where

import Prelude hiding (length)

import Control.Exception (evaluate)
import Test.Hspec
import Network.IP.IPv4

spec :: Spec
spec = do
describe "IPAddress" $ do
describe "==" $ do
it "returns true if two IP addresses are equal" $ do
(read "192.168.0.4" :: IPAddress) == (read "192.168.0.4" :: IPAddress) `shouldBe` True

it "returns false if two IP addresses are not equal" $ do
(read "192.168.0.4" :: IPAddress) == (read "192.168.0.5" :: IPAddress) `shouldBe` False

describe "<=" $ do
it "compares two IP addresses" $ do
(read "192.168.0.4" :: IPAddress) <= (read "192.168.0.4" :: IPAddress) `shouldBe` True
(read "192.168.0.4" :: IPAddress) <= (read "192.168.0.5" :: IPAddress) `shouldBe` True
(read "192.168.1.4" :: IPAddress) <= (read "192.168.0.5" :: IPAddress) `shouldBe` False

describe "read" $ do
describe "valid IP addresses" $ do
it "parses a valid IP address" $ do
let ip = read "68.42.3.254" :: IPAddress
show ip `shouldBe` "68.42.3.254"

describe "invalid IP addresses" $ do
it "fails to parse an empty string" $ do
evaluate (read "" :: IPAddress) `shouldThrow` anyException

it "fails to parse a string that is not an IP address" $ do
evaluate (read "foo" :: IPAddress) `shouldThrow` anyException

it "fails to parse an out-of-range IP address" $ do
evaluate (read "0.0.0.256" :: IPAddress) `shouldThrow` anyException

describe "show" $ do
it "returns a string representation of an IP address" $ do
let ip = read "192.168.0.2" :: IPAddress
show ip `shouldBe` "192.168.0.2"

describe "bounded" $ do
it "returns the minimum IP address" $ do
(minBound :: IPAddress) `shouldBe` read "0.0.0.0"

it "returns the maximum IP address" $ do
(maxBound :: IPAddress) `shouldBe` read "255.255.255.255"

describe "enum" $ do
it "should return the next IP address" $ do
succ (read "192.168.0.4" :: IPAddress) `shouldBe` (read "192.168.0.5")
succ (read "192.168.0.255" :: IPAddress) `shouldBe` (read "192.168.1.0")

it "should wrap around if the last IP address has been reached" $ do
succ (read "255.255.255.255" :: IPAddress) `shouldBe` (read "0.0.0.0")

it "should return the previous IP address" $ do
pred (read "192.168.0.4" :: IPAddress) `shouldBe` (read "192.168.0.3")
pred (read "192.168.0.0" :: IPAddress) `shouldBe` (read "192.167.255.255")

it "should wrap around if the first IP address has been reached" $ do
pred (read "0.0.0.0" :: IPAddress) `shouldBe` (read "255.255.255.255")

describe "IPAddressRange" $ do
describe "read" $ do
it "parses a valid IP address range" $ do
length (read "192.168.0.0/24" :: IPAddressRange) `shouldBe` 256

it "fails to parse an empty string" $ do
evaluate (read "" :: IPAddressRange) `shouldThrow` anyException

it "fails to parse a string that is not a CIDR block" $ do
evaluate (read "foo" :: IPAddressRange) `shouldThrow` anyException

it "fails to parse a string without a block" $ do
evaluate (read "192.168.0.1/" :: IPAddressRange) `shouldThrow` anyException

it "fails to parse a string with an invalid block" $ do
evaluate (read "192.168.0.0/foo" :: IPAddressRange) `shouldThrow` anyException

it "fails to parse a string with an invalid IP address" $ do
evaluate (read "192.168.0.256/24" :: IPAddressRange) `shouldThrow` anyException

it "fails to parse a string with an out-of-range block" $ do
evaluate (read "192.168.0.0/-1" :: IPAddressRange) `shouldThrow` anyException
evaluate (read "192.168.0.0/33" :: IPAddressRange) `shouldThrow` anyException

describe "show" $ do
it "returns a string representation of an IP address range" $ do
let r = read "192.168.0.0/30" :: IPAddressRange
show r `shouldBe` "[192.168.0.0,192.168.0.1,192.168.0.2,192.168.0.3]"

describe "length" $ do
it "returns the number of IP addresses in the range" $ do
let r27 = read "192.168.0.0/27" :: IPAddressRange
r32 = read "192.168.0.0/32" :: IPAddressRange
length r27 `shouldBe` 2 ^ (32 - 27)
length r32 `shouldBe` 2 ^ (32 - 32)

describe ".++." $ do
it "combines two IP address ranges" $ do
let x = read "192.168.0.0/30" :: IPAddressRange
y = read "10.10.10.10/30" :: IPAddressRange
z = x .++. y
show z `shouldBe` "[10.10.10.10,10.10.10.11,192.168.0.0,192.168.0.1,192.168.0.2,192.168.0.3]"

it "removes duplicate IP addresses" $ do
let x = read "192.168.0.0/30" :: IPAddressRange
y = read "192.168.0.2/30" :: IPAddressRange
z = x .++. y
show z `shouldBe` "[192.168.0.0,192.168.0.1,192.168.0.2,192.168.0.3]"

describe ".:" $ do
it "adds an IP adress to a range" $ do
let x = read "192.168.0.0/30" :: IPAddressRange
y = read "10.10.10.10" :: IPAddress
z = y .: x
show z `shouldBe` "[10.10.10.10,192.168.0.0,192.168.0.1,192.168.0.2,192.168.0.3]"

it "removes duplicate IP addresses" $ do
let x = read "192.168.0.0/30" :: IPAddressRange
y = read "192.168.0.2" :: IPAddress
z = y .: x
show z `shouldBe` "[192.168.0.0,192.168.0.1,192.168.0.2,192.168.0.3]"

describe "contains" $ do
it "returns true if an IP address is contained within a range" $ do
let x = read "192.168.0.0/24" :: IPAddressRange
ip = read "192.168.0.255" :: IPAddress
x `contains` ip `shouldBe` True

it "returns false if an IP address is not contained within a range" $ do
let x = read "192.168.0.0/24" :: IPAddressRange
ip = read "192.168.1.0" :: IPAddress
x `contains` ip `shouldBe` False
@@ -0,0 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

0 comments on commit ae002c5

Please sign in to comment.
You can’t perform that action at this time.