{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module HaskellWorks.Data.Network.Ip.Ip
( IpBlock(..)
, Unaligned, Canonical
, IpAddress(..)
, isCanonical
, canonicalise
, canonicaliseIpBlock
, blockToRange
, firstIpAddress
, lastIpAddress
) where
import Control.Monad
import Data.Word
import GHC.Generics
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Network.Ip.Range (Range (..))
import HaskellWorks.Data.Network.Ip.SafeEnum
import HaskellWorks.Data.Network.Ip.Validity
import Text.Read
import qualified HaskellWorks.Data.Network.Ip.Ipv4 as V4
import qualified HaskellWorks.Data.Network.Ip.Ipv6 as V6
data IpBlock v = IpBlockV4 (V4.IpBlock v) | IpBlockV6 (V6.IpBlock v)
deriving (IpBlock v -> IpBlock v -> Bool
(IpBlock v -> IpBlock v -> Bool)
-> (IpBlock v -> IpBlock v -> Bool) -> Eq (IpBlock v)
forall v. IpBlock v -> IpBlock v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpBlock v -> IpBlock v -> Bool
$c/= :: forall v. IpBlock v -> IpBlock v -> Bool
== :: IpBlock v -> IpBlock v -> Bool
$c== :: forall v. IpBlock v -> IpBlock v -> Bool
Eq, Eq (IpBlock v)
Eq (IpBlock v)
-> (IpBlock v -> IpBlock v -> Ordering)
-> (IpBlock v -> IpBlock v -> Bool)
-> (IpBlock v -> IpBlock v -> Bool)
-> (IpBlock v -> IpBlock v -> Bool)
-> (IpBlock v -> IpBlock v -> Bool)
-> (IpBlock v -> IpBlock v -> IpBlock v)
-> (IpBlock v -> IpBlock v -> IpBlock v)
-> Ord (IpBlock v)
IpBlock v -> IpBlock v -> Bool
IpBlock v -> IpBlock v -> Ordering
IpBlock v -> IpBlock v -> IpBlock v
forall v. Eq (IpBlock v)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. IpBlock v -> IpBlock v -> Bool
forall v. IpBlock v -> IpBlock v -> Ordering
forall v. IpBlock v -> IpBlock v -> IpBlock v
min :: IpBlock v -> IpBlock v -> IpBlock v
$cmin :: forall v. IpBlock v -> IpBlock v -> IpBlock v
max :: IpBlock v -> IpBlock v -> IpBlock v
$cmax :: forall v. IpBlock v -> IpBlock v -> IpBlock v
>= :: IpBlock v -> IpBlock v -> Bool
$c>= :: forall v. IpBlock v -> IpBlock v -> Bool
> :: IpBlock v -> IpBlock v -> Bool
$c> :: forall v. IpBlock v -> IpBlock v -> Bool
<= :: IpBlock v -> IpBlock v -> Bool
$c<= :: forall v. IpBlock v -> IpBlock v -> Bool
< :: IpBlock v -> IpBlock v -> Bool
$c< :: forall v. IpBlock v -> IpBlock v -> Bool
compare :: IpBlock v -> IpBlock v -> Ordering
$ccompare :: forall v. IpBlock v -> IpBlock v -> Ordering
$cp1Ord :: forall v. Eq (IpBlock v)
Ord, (forall x. IpBlock v -> Rep (IpBlock v) x)
-> (forall x. Rep (IpBlock v) x -> IpBlock v)
-> Generic (IpBlock v)
forall x. Rep (IpBlock v) x -> IpBlock v
forall x. IpBlock v -> Rep (IpBlock v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (IpBlock v) x -> IpBlock v
forall v x. IpBlock v -> Rep (IpBlock v) x
$cto :: forall v x. Rep (IpBlock v) x -> IpBlock v
$cfrom :: forall v x. IpBlock v -> Rep (IpBlock v) x
Generic)
data IpAddress = IpAddressV4 V4.IpAddress | IpAddressV6 V6.IpAddress
deriving (IpAddress -> IpAddress -> Bool
(IpAddress -> IpAddress -> Bool)
-> (IpAddress -> IpAddress -> Bool) -> Eq IpAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpAddress -> IpAddress -> Bool
$c/= :: IpAddress -> IpAddress -> Bool
== :: IpAddress -> IpAddress -> Bool
$c== :: IpAddress -> IpAddress -> Bool
Eq, Eq IpAddress
Eq IpAddress
-> (IpAddress -> IpAddress -> Ordering)
-> (IpAddress -> IpAddress -> Bool)
-> (IpAddress -> IpAddress -> Bool)
-> (IpAddress -> IpAddress -> Bool)
-> (IpAddress -> IpAddress -> Bool)
-> (IpAddress -> IpAddress -> IpAddress)
-> (IpAddress -> IpAddress -> IpAddress)
-> Ord IpAddress
IpAddress -> IpAddress -> Bool
IpAddress -> IpAddress -> Ordering
IpAddress -> IpAddress -> IpAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IpAddress -> IpAddress -> IpAddress
$cmin :: IpAddress -> IpAddress -> IpAddress
max :: IpAddress -> IpAddress -> IpAddress
$cmax :: IpAddress -> IpAddress -> IpAddress
>= :: IpAddress -> IpAddress -> Bool
$c>= :: IpAddress -> IpAddress -> Bool
> :: IpAddress -> IpAddress -> Bool
$c> :: IpAddress -> IpAddress -> Bool
<= :: IpAddress -> IpAddress -> Bool
$c<= :: IpAddress -> IpAddress -> Bool
< :: IpAddress -> IpAddress -> Bool
$c< :: IpAddress -> IpAddress -> Bool
compare :: IpAddress -> IpAddress -> Ordering
$ccompare :: IpAddress -> IpAddress -> Ordering
$cp1Ord :: Eq IpAddress
Ord, (forall x. IpAddress -> Rep IpAddress x)
-> (forall x. Rep IpAddress x -> IpAddress) -> Generic IpAddress
forall x. Rep IpAddress x -> IpAddress
forall x. IpAddress -> Rep IpAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IpAddress x -> IpAddress
$cfrom :: forall x. IpAddress -> Rep IpAddress x
Generic)
instance Show (IpBlock v) where
showsPrec :: Int -> IpBlock v -> ShowS
showsPrec Int
_ (IpBlockV4 IpBlock v
a) = IpBlock v -> ShowS
forall a. Show a => a -> ShowS
shows IpBlock v
a
showsPrec Int
_ (IpBlockV6 IpBlock v
a) = IpBlock v -> ShowS
forall a. Show a => a -> ShowS
shows IpBlock v
a
instance Show IpAddress where
showsPrec :: Int -> IpAddress -> ShowS
showsPrec Int
_ (IpAddressV4 IpAddress
ip) = IpAddress -> ShowS
forall a. Show a => a -> ShowS
shows IpAddress
ip
showsPrec Int
_ (IpAddressV6 IpAddress
ip) = IpAddress -> ShowS
forall a. Show a => a -> ShowS
shows IpAddress
ip
instance Read (IpBlock Unaligned) where
readsPrec :: Int -> ReadS (IpBlock Unaligned)
readsPrec Int
_ String
s =
case String -> Maybe (IpBlock Unaligned)
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe (V4.IpBlock Unaligned) of
Just IpBlock Unaligned
ip -> [(IpBlock Unaligned -> IpBlock Unaligned
forall v. IpBlock v -> IpBlock v
IpBlockV4 IpBlock Unaligned
ip, String
"")]
Maybe (IpBlock Unaligned)
Nothing ->
case String -> Maybe (IpBlock Unaligned)
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe (V6.IpBlock Unaligned) of
Just IpBlock Unaligned
ipv6 -> [(IpBlock Unaligned -> IpBlock Unaligned
forall v. IpBlock v -> IpBlock v
IpBlockV6 IpBlock Unaligned
ipv6, String
"")]
Maybe (IpBlock Unaligned)
Nothing -> []
instance Read IpAddress where
readsPrec :: Int -> ReadS IpAddress
readsPrec Int
_ String
s =
case String -> Maybe IpAddress
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe V4.IpAddress of
Just IpAddress
ip -> [(IpAddress -> IpAddress
IpAddressV4 IpAddress
ip, String
"")]
Maybe IpAddress
Nothing ->
case String -> Maybe IpAddress
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe V6.IpAddress of
Just IpAddress
ip -> [(IpAddress -> IpAddress
IpAddressV6 IpAddress
ip, String
"")]
Maybe IpAddress
Nothing -> []
instance SafeEnum IpAddress where
safePred :: IpAddress -> Maybe IpAddress
safePred (IpAddressV4 IpAddress
ip) = IpAddress -> IpAddress
IpAddressV4 (IpAddress -> IpAddress) -> Maybe IpAddress -> Maybe IpAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IpAddress -> Maybe IpAddress
forall a. SafeEnum a => a -> Maybe a
safePred IpAddress
ip
safePred (IpAddressV6 IpAddress
ip) = IpAddress -> IpAddress
IpAddressV6 (IpAddress -> IpAddress) -> Maybe IpAddress -> Maybe IpAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IpAddress -> Maybe IpAddress
forall a. SafeEnum a => a -> Maybe a
safePred IpAddress
ip
safeSucc :: IpAddress -> Maybe IpAddress
safeSucc (IpAddressV4 IpAddress
ip) = IpAddress -> IpAddress
IpAddressV4 (IpAddress -> IpAddress) -> Maybe IpAddress -> Maybe IpAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IpAddress -> Maybe IpAddress
forall a. SafeEnum a => a -> Maybe a
safeSucc IpAddress
ip
safeSucc (IpAddressV6 IpAddress
ip) = IpAddress -> IpAddress
IpAddressV6 (IpAddress -> IpAddress) -> Maybe IpAddress -> Maybe IpAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IpAddress -> Maybe IpAddress
forall a. SafeEnum a => a -> Maybe a
safeSucc IpAddress
ip
isCanonical :: IpBlock v -> Bool
isCanonical :: IpBlock v -> Bool
isCanonical (IpBlockV4 IpBlock v
b) = IpBlock v -> Bool
forall v. IpBlock v -> Bool
V4.isCanonical IpBlock v
b
isCanonical (IpBlockV6 IpBlock v
b) = IpBlock v -> Bool
forall v. IpBlock v -> Bool
V6.isCanonical IpBlock v
b
canonicalise :: IpBlock Unaligned -> Maybe (IpBlock Canonical)
canonicalise :: IpBlock Unaligned -> Maybe (IpBlock Canonical)
canonicalise (IpBlockV4 (V4.IpBlock IpAddress
a IpNetMask
m)) = (IpBlock Canonical -> Bool)
-> Maybe (IpBlock Canonical) -> Maybe (IpBlock Canonical)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter IpBlock Canonical -> Bool
forall v. IpBlock v -> Bool
isCanonical (IpBlock Canonical -> Maybe (IpBlock Canonical)
forall a. a -> Maybe a
Just (IpBlock Canonical -> Maybe (IpBlock Canonical))
-> IpBlock Canonical -> Maybe (IpBlock Canonical)
forall a b. (a -> b) -> a -> b
$ IpBlock Canonical -> IpBlock Canonical
forall v. IpBlock v -> IpBlock v
IpBlockV4 (IpAddress -> IpNetMask -> IpBlock Canonical
forall v. IpAddress -> IpNetMask -> IpBlock v
V4.IpBlock IpAddress
a IpNetMask
m))
canonicalise (IpBlockV6 (V6.IpBlock IpAddress
a IpNetMask
m)) = (IpBlock Canonical -> Bool)
-> Maybe (IpBlock Canonical) -> Maybe (IpBlock Canonical)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter IpBlock Canonical -> Bool
forall v. IpBlock v -> Bool
isCanonical (IpBlock Canonical -> Maybe (IpBlock Canonical)
forall a. a -> Maybe a
Just (IpBlock Canonical -> Maybe (IpBlock Canonical))
-> IpBlock Canonical -> Maybe (IpBlock Canonical)
forall a b. (a -> b) -> a -> b
$ IpBlock Canonical -> IpBlock Canonical
forall v. IpBlock v -> IpBlock v
IpBlockV6 (IpAddress -> IpNetMask -> IpBlock Canonical
forall v. IpAddress -> IpNetMask -> IpBlock v
V6.IpBlock IpAddress
a IpNetMask
m))
canonicaliseIpBlock :: IpBlock v -> IpBlock Canonical
canonicaliseIpBlock :: IpBlock v -> IpBlock Canonical
canonicaliseIpBlock (IpBlockV4 IpBlock v
b) = IpBlock Canonical -> IpBlock Canonical
forall v. IpBlock v -> IpBlock v
IpBlockV4 (IpBlock v -> IpBlock Canonical
forall v. IpBlock v -> IpBlock Canonical
V4.canonicaliseIpBlock IpBlock v
b)
canonicaliseIpBlock (IpBlockV6 IpBlock v
b) = IpBlock Canonical -> IpBlock Canonical
forall v. IpBlock v -> IpBlock v
IpBlockV6 (IpBlock v -> IpBlock Canonical
forall v. IpBlock v -> IpBlock Canonical
V6.canonicaliseIpBlock IpBlock v
b)
blockToRange :: IpBlock Canonical -> Range IpAddress
blockToRange :: IpBlock Canonical -> Range IpAddress
blockToRange (IpBlockV4 IpBlock Canonical
b) = let Range IpAddress
s IpAddress
e = IpBlock Canonical -> Range IpAddress
V4.blockToRange IpBlock Canonical
b in IpAddress -> IpAddress -> Range IpAddress
forall a. a -> a -> Range a
Range (IpAddress -> IpAddress
IpAddressV4 IpAddress
s) (IpAddress -> IpAddress
IpAddressV4 IpAddress
e)
blockToRange (IpBlockV6 IpBlock Canonical
b) = let Range IpAddress
s IpAddress
e = IpBlock Canonical -> Range IpAddress
V6.blockToRange IpBlock Canonical
b in IpAddress -> IpAddress -> Range IpAddress
forall a. a -> a -> Range a
Range (IpAddress -> IpAddress
IpAddressV6 IpAddress
s) (IpAddress -> IpAddress
IpAddressV6 IpAddress
e)
firstIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32)
firstIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32)
firstIpAddress (IpBlockV4 IpBlock Canonical
v4Block) = IpBlock Canonical -> (Word32, Word32, Word32, Word32)
firstIpAddress (IpBlock Canonical -> IpBlock Canonical
forall v. IpBlock v -> IpBlock v
IpBlockV6 (IpBlock Canonical -> IpBlock Canonical
forall v. IpBlock Canonical -> IpBlock v
V6.fromIpv4Block IpBlock Canonical
v4Block))
firstIpAddress (IpBlockV6 (V6.IpBlock (V6.IpAddress (Word32, Word32, Word32, Word32)
ip) IpNetMask
_)) = (Word32, Word32, Word32, Word32)
ip
lastIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32)
lastIpAddress :: IpBlock Canonical -> (Word32, Word32, Word32, Word32)
lastIpAddress (IpBlockV4 IpBlock Canonical
ib) = (Word32
0, Word32
0, Word32
0xFFFF, IpAddress -> Word32
V4.word (IpBlock Canonical -> IpAddress
forall v. IpBlock v -> IpAddress
V4.lastIpAddress IpBlock Canonical
ib))
lastIpAddress (IpBlockV6 (V6.IpBlock (V6.IpAddress (Word32, Word32, Word32, Word32)
ip) (V6.IpNetMask Word8
msk))) =
let (Word32
w1, Word32
w2, Word32
w3, Word32
w4) = (Word32, Word32, Word32, Word32)
ip
lt :: [Word32]
lt = Word8 -> [Word32]
V6.masksIp (Word8 -> [Word32]) -> Word8 -> [Word32]
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
msk
w1' :: Word32
w1' = Word32
w1 Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. ([Word32]
lt [Word32] -> Int -> Word32
forall a. [a] -> Int -> a
!! Int
0)
w2' :: Word32
w2' = Word32
w2 Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. ([Word32]
lt [Word32] -> Int -> Word32
forall a. [a] -> Int -> a
!! Int
1)
w3' :: Word32
w3' = Word32
w3 Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. ([Word32]
lt [Word32] -> Int -> Word32
forall a. [a] -> Int -> a
!! Int
2)
w4' :: Word32
w4' = Word32
w4 Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. ([Word32]
lt [Word32] -> Int -> Word32
forall a. [a] -> Int -> a
!! Int
3) in
(Word32
w1', Word32
w2', Word32
w3', Word32
w4')