{-# 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

{- HLINT ignore "Use head" -}

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))

-- | Canonicalise the block by zero-ing out the host bits
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')