{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE OverloadedStrings          #-}

module HaskellWorks.Data.Network.Ip.Ipv6
  ( IpAddress(..)
  , IpNetMask(..)
  , IpBlock(..)
  , Unaligned, Canonical
  , fromIpv4
  , fromIpv4Block
  , isIpv4Block
  , toIpv4Block
  , fromV4
  , parseIpBlock
  , masksIp
  , showIpAddress
  , showsIpAddress
  , tshowIpAddress
  , tshowIpBlock
  , firstIpAddress
  , lastIpAddress
  , rangeToBlocks
  , rangeToBlocksDL
  , blockToRange
  , isCanonical
  , canonicaliseIpBlock
  , splitIpRange
  ) where

import Control.Applicative
import Control.Monad
import Data.Bifunctor
import Data.Maybe
import Data.Word
import GHC.Generics
import HaskellWorks.Data.Network.Ip.Range
import HaskellWorks.Data.Network.Ip.SafeEnum
import HaskellWorks.Data.Network.Ip.Validity
import Prelude                               hiding (words)
import Text.Read

import qualified Data.Bits                                   as B
import qualified Data.IP                                     as D
import qualified Data.Text                                   as T
import qualified HaskellWorks.Data.Network.Ip.Internal.Appar as I
import qualified HaskellWorks.Data.Network.Ip.Ipv4           as V4
import qualified HaskellWorks.Data.Network.Ip.Word128        as W
import qualified Text.Appar.String                           as AP

newtype IpAddress = IpAddress W.Word128 deriving (Int -> IpAddress
IpAddress -> Int
IpAddress -> [IpAddress]
IpAddress -> IpAddress
IpAddress -> IpAddress -> [IpAddress]
IpAddress -> IpAddress -> IpAddress -> [IpAddress]
(IpAddress -> IpAddress)
-> (IpAddress -> IpAddress)
-> (Int -> IpAddress)
-> (IpAddress -> Int)
-> (IpAddress -> [IpAddress])
-> (IpAddress -> IpAddress -> [IpAddress])
-> (IpAddress -> IpAddress -> [IpAddress])
-> (IpAddress -> IpAddress -> IpAddress -> [IpAddress])
-> Enum IpAddress
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IpAddress -> IpAddress -> IpAddress -> [IpAddress]
$cenumFromThenTo :: IpAddress -> IpAddress -> IpAddress -> [IpAddress]
enumFromTo :: IpAddress -> IpAddress -> [IpAddress]
$cenumFromTo :: IpAddress -> IpAddress -> [IpAddress]
enumFromThen :: IpAddress -> IpAddress -> [IpAddress]
$cenumFromThen :: IpAddress -> IpAddress -> [IpAddress]
enumFrom :: IpAddress -> [IpAddress]
$cenumFrom :: IpAddress -> [IpAddress]
fromEnum :: IpAddress -> Int
$cfromEnum :: IpAddress -> Int
toEnum :: Int -> IpAddress
$ctoEnum :: Int -> IpAddress
pred :: IpAddress -> IpAddress
$cpred :: IpAddress -> IpAddress
succ :: IpAddress -> IpAddress
$csucc :: IpAddress -> IpAddress
Enum, 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, IpAddress
IpAddress -> IpAddress -> Bounded IpAddress
forall a. a -> a -> Bounded a
maxBound :: IpAddress
$cmaxBound :: IpAddress
minBound :: IpAddress
$cminBound :: IpAddress
Bounded, (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, IpAddress -> Maybe IpAddress
(IpAddress -> Maybe IpAddress)
-> (IpAddress -> Maybe IpAddress) -> SafeEnum IpAddress
forall a. (a -> Maybe a) -> (a -> Maybe a) -> SafeEnum a
safeSucc :: IpAddress -> Maybe IpAddress
$csafeSucc :: IpAddress -> Maybe IpAddress
safePred :: IpAddress -> Maybe IpAddress
$csafePred :: IpAddress -> Maybe IpAddress
SafeEnum)

instance Show IpAddress where
  showsPrec :: Int -> IpAddress -> ShowS
showsPrec Int
_ (IpAddress Word128
w) = IPv6 -> ShowS
forall a. Show a => a -> ShowS
shows (Word128 -> IPv6
D.fromHostAddress6 Word128
w)

instance Read IpAddress where
  readsPrec :: Int -> String -> [(IpAddress, String)]
  readsPrec :: Int -> ReadS IpAddress
readsPrec Int
p String
s =
    case String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe String
s :: Maybe D.IPv6 of
      Just IPv6
ip -> [(Word128 -> IpAddress
IpAddress (IPv6 -> Word128
D.toHostAddress6 IPv6
ip), String
"")]
      Maybe IPv6
Nothing -> Parser IpAddress -> Int -> ReadS IpAddress
forall a. Parser a -> Int -> String -> [(a, String)]
I.readsPrecOnParser (Parser IpAddress -> Parser IpAddress
forall inp a. MkParser inp a -> MkParser inp a
AP.try Parser IpAddress
parse6052IpAddress) Int
p String
s

-- Data.IP doesn't support this encoding, so we have to do it ourselves. It's pretty unambiguous.
parse6052IpAddress :: AP.Parser IpAddress
parse6052IpAddress :: Parser IpAddress
parse6052IpAddress = do
  String
_ <- String -> MkParser String String
forall inp. Input inp => String -> MkParser inp String
AP.string String
"::ffff:"
  IpAddress -> IpAddress
fromIpv4 (IpAddress -> IpAddress)
-> MkParser String IpAddress -> Parser IpAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkParser String IpAddress
V4.parseIpAddress

newtype IpNetMask = IpNetMask
  { IpNetMask -> Word8
word :: Word8
  } deriving (Int -> IpNetMask
IpNetMask -> Int
IpNetMask -> [IpNetMask]
IpNetMask -> IpNetMask
IpNetMask -> IpNetMask -> [IpNetMask]
IpNetMask -> IpNetMask -> IpNetMask -> [IpNetMask]
(IpNetMask -> IpNetMask)
-> (IpNetMask -> IpNetMask)
-> (Int -> IpNetMask)
-> (IpNetMask -> Int)
-> (IpNetMask -> [IpNetMask])
-> (IpNetMask -> IpNetMask -> [IpNetMask])
-> (IpNetMask -> IpNetMask -> [IpNetMask])
-> (IpNetMask -> IpNetMask -> IpNetMask -> [IpNetMask])
-> Enum IpNetMask
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IpNetMask -> IpNetMask -> IpNetMask -> [IpNetMask]
$cenumFromThenTo :: IpNetMask -> IpNetMask -> IpNetMask -> [IpNetMask]
enumFromTo :: IpNetMask -> IpNetMask -> [IpNetMask]
$cenumFromTo :: IpNetMask -> IpNetMask -> [IpNetMask]
enumFromThen :: IpNetMask -> IpNetMask -> [IpNetMask]
$cenumFromThen :: IpNetMask -> IpNetMask -> [IpNetMask]
enumFrom :: IpNetMask -> [IpNetMask]
$cenumFrom :: IpNetMask -> [IpNetMask]
fromEnum :: IpNetMask -> Int
$cfromEnum :: IpNetMask -> Int
toEnum :: Int -> IpNetMask
$ctoEnum :: Int -> IpNetMask
pred :: IpNetMask -> IpNetMask
$cpred :: IpNetMask -> IpNetMask
succ :: IpNetMask -> IpNetMask
$csucc :: IpNetMask -> IpNetMask
Enum, IpNetMask -> IpNetMask -> Bool
(IpNetMask -> IpNetMask -> Bool)
-> (IpNetMask -> IpNetMask -> Bool) -> Eq IpNetMask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpNetMask -> IpNetMask -> Bool
$c/= :: IpNetMask -> IpNetMask -> Bool
== :: IpNetMask -> IpNetMask -> Bool
$c== :: IpNetMask -> IpNetMask -> Bool
Eq, Eq IpNetMask
Eq IpNetMask
-> (IpNetMask -> IpNetMask -> Ordering)
-> (IpNetMask -> IpNetMask -> Bool)
-> (IpNetMask -> IpNetMask -> Bool)
-> (IpNetMask -> IpNetMask -> Bool)
-> (IpNetMask -> IpNetMask -> Bool)
-> (IpNetMask -> IpNetMask -> IpNetMask)
-> (IpNetMask -> IpNetMask -> IpNetMask)
-> Ord IpNetMask
IpNetMask -> IpNetMask -> Bool
IpNetMask -> IpNetMask -> Ordering
IpNetMask -> IpNetMask -> IpNetMask
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 :: IpNetMask -> IpNetMask -> IpNetMask
$cmin :: IpNetMask -> IpNetMask -> IpNetMask
max :: IpNetMask -> IpNetMask -> IpNetMask
$cmax :: IpNetMask -> IpNetMask -> IpNetMask
>= :: IpNetMask -> IpNetMask -> Bool
$c>= :: IpNetMask -> IpNetMask -> Bool
> :: IpNetMask -> IpNetMask -> Bool
$c> :: IpNetMask -> IpNetMask -> Bool
<= :: IpNetMask -> IpNetMask -> Bool
$c<= :: IpNetMask -> IpNetMask -> Bool
< :: IpNetMask -> IpNetMask -> Bool
$c< :: IpNetMask -> IpNetMask -> Bool
compare :: IpNetMask -> IpNetMask -> Ordering
$ccompare :: IpNetMask -> IpNetMask -> Ordering
$cp1Ord :: Eq IpNetMask
Ord, Int -> IpNetMask -> ShowS
[IpNetMask] -> ShowS
IpNetMask -> String
(Int -> IpNetMask -> ShowS)
-> (IpNetMask -> String)
-> ([IpNetMask] -> ShowS)
-> Show IpNetMask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpNetMask] -> ShowS
$cshowList :: [IpNetMask] -> ShowS
show :: IpNetMask -> String
$cshow :: IpNetMask -> String
showsPrec :: Int -> IpNetMask -> ShowS
$cshowsPrec :: Int -> IpNetMask -> ShowS
Show, (forall x. IpNetMask -> Rep IpNetMask x)
-> (forall x. Rep IpNetMask x -> IpNetMask) -> Generic IpNetMask
forall x. Rep IpNetMask x -> IpNetMask
forall x. IpNetMask -> Rep IpNetMask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IpNetMask x -> IpNetMask
$cfrom :: forall x. IpNetMask -> Rep IpNetMask x
Generic)

instance Bounded IpNetMask where
  minBound :: IpNetMask
minBound = Word8 -> IpNetMask
IpNetMask Word8
0
  maxBound :: IpNetMask
maxBound = Word8 -> IpNetMask
IpNetMask Word8
128

instance Read IpNetMask where
  readsPrec :: Int -> ReadS IpNetMask
readsPrec Int
_ String
s =
    case Word8 -> IpNetMask
IpNetMask (Word8 -> IpNetMask) -> Maybe Word8 -> Maybe IpNetMask
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word8
m of
      Just IpNetMask
maskv6 -> [(IpNetMask
maskv6, String
"")]
      Maybe IpNetMask
Nothing     -> []
    where
      m :: Maybe Word8
m = (Word8 -> Bool) -> Maybe Word8 -> Maybe Word8
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (\Word8
a -> Word8
a Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0 Bool -> Bool -> Bool
&& Word8
a Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
128) (String -> Maybe Word8
forall a. Read a => String -> Maybe a
readMaybe String
s)

data IpBlock v = IpBlock
  { IpBlock v -> IpAddress
base :: !IpAddress
  , IpBlock v -> IpNetMask
mask :: !IpNetMask
  } 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, IpBlock v
IpBlock v -> IpBlock v -> Bounded (IpBlock v)
forall v. IpBlock v
forall a. a -> a -> Bounded a
maxBound :: IpBlock v
$cmaxBound :: forall v. IpBlock v
minBound :: IpBlock v
$cminBound :: forall v. IpBlock v
Bounded, (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)

instance Read (IpBlock Unaligned) where
  readsPrec :: Int -> ReadS (IpBlock Unaligned)
readsPrec Int
_ String
s =
    case Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> Text
T.pack String
s) of
      [String
addr, String
msk] ->
        case String -> Maybe IpAddress
forall a. Read a => String -> Maybe a
readMaybe String
addr :: Maybe IpAddress of
          Just IpAddress
ipv6 ->
            case String -> Maybe IpNetMask
forall a. Read a => String -> Maybe a
readMaybe String
msk of
              Just IpNetMask
mskv6 ->
                let i6b :: IpBlock v
i6b = IpAddress -> IpNetMask -> IpBlock v
forall v. IpAddress -> IpNetMask -> IpBlock v
IpBlock IpAddress
ipv6 IpNetMask
mskv6 in
                  [(IpBlock Unaligned
forall v. IpBlock v
i6b, String
"") | IpBlock Any -> Bool
forall v. IpBlock v -> Bool
isCanonical IpBlock Any
forall v. IpBlock v
i6b]
              Maybe IpNetMask
Nothing     -> []
          Maybe IpAddress
Nothing -> []
      [String
addr] ->
        case String -> Maybe IpAddress
forall a. Read a => String -> Maybe a
readMaybe String
addr :: Maybe IpAddress of
          Just IpAddress
ipv6 -> let i6b :: IpBlock v
i6b = IpAddress -> IpNetMask -> IpBlock v
forall v. IpAddress -> IpNetMask -> IpBlock v
IpBlock IpAddress
ipv6 (Word8 -> IpNetMask
IpNetMask Word8
128) in [(IpBlock Unaligned
forall v. IpBlock v
i6b, String
"") | IpBlock Any -> Bool
forall v. IpBlock v -> Bool
isCanonical IpBlock Any
forall v. IpBlock v
i6b]
          Maybe IpAddress
Nothing   -> []
      [String]
_ -> []

instance Show (IpBlock v) where
  showsPrec :: Int -> IpBlock v -> ShowS
showsPrec Int
_ (IpBlock IpAddress
b (IpNetMask Word8
m))  = IpAddress -> ShowS
forall a. Show a => a -> ShowS
shows IpAddress
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Show a => a -> ShowS
shows Word8
m

parseIpBlock :: T.Text -> Either T.Text (IpBlock Unaligned)
parseIpBlock :: Text -> Either Text (IpBlock Unaligned)
parseIpBlock Text
t =
  case Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t of
    [String
addr, String
msk] ->
      case String -> Maybe IpAddress
forall a. Read a => String -> Maybe a
readMaybe String
addr :: Maybe IpAddress of
        Just IpAddress
ipv6 ->
          case String -> Maybe IpNetMask
forall a. Read a => String -> Maybe a
readMaybe String
msk of
            Just IpNetMask
mskv6 -> IpBlock Unaligned -> Either Text (IpBlock Unaligned)
forall a b. b -> Either a b
Right (IpBlock Unaligned -> Either Text (IpBlock Unaligned))
-> IpBlock Unaligned -> Either Text (IpBlock Unaligned)
forall a b. (a -> b) -> a -> b
$ IpAddress -> IpNetMask -> IpBlock Unaligned
forall v. IpAddress -> IpNetMask -> IpBlock v
IpBlock IpAddress
ipv6 IpNetMask
mskv6
            Maybe IpNetMask
Nothing    -> Text -> Either Text (IpBlock Unaligned)
forall a b. a -> Either a b
Left Text
"cannot read mask"
        Maybe IpAddress
Nothing -> Text -> Either Text (IpBlock Unaligned)
forall a b. a -> Either a b
Left Text
"cannot read addr"
    [String]
_ -> Text -> Either Text (IpBlock Unaligned)
forall a b. a -> Either a b
Left Text
"invalid input string"

showsIpAddress :: IpAddress -> String -> String
showsIpAddress :: IpAddress -> ShowS
showsIpAddress (IpAddress Word128
w) = IPv6 -> ShowS
forall a. Show a => a -> ShowS
shows (Word128 -> IPv6
D.fromHostAddress6 Word128
w)

showIpAddress :: IpAddress -> String
showIpAddress :: IpAddress -> String
showIpAddress IpAddress
ipAddress = IpAddress -> ShowS
showsIpAddress IpAddress
ipAddress String
""

tshowIpAddress :: IpAddress -> T.Text
tshowIpAddress :: IpAddress -> Text
tshowIpAddress = String -> Text
T.pack (String -> Text) -> (IpAddress -> String) -> IpAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpAddress -> String
showIpAddress

showsIpBlock :: IpBlock v -> String -> String
showsIpBlock :: IpBlock v -> ShowS
showsIpBlock (IpBlock IpAddress
b (IpNetMask Word8
m)) = IpAddress -> ShowS
forall a. Show a => a -> ShowS
shows IpAddress
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Show a => a -> ShowS
shows Word8
m

showIpBlock :: IpBlock v -> String
showIpBlock :: IpBlock v -> String
showIpBlock IpBlock v
ipBlock = IpBlock v -> ShowS
forall v. IpBlock v -> ShowS
showsIpBlock IpBlock v
ipBlock String
""

tshowIpBlock :: IpBlock v -> T.Text
tshowIpBlock :: IpBlock v -> Text
tshowIpBlock = String -> Text
T.pack (String -> Text) -> (IpBlock v -> String) -> IpBlock v -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpBlock v -> String
forall v. IpBlock v -> String
showIpBlock

masksIp :: Word8 -> [Word32]
masksIp :: Word8 -> [Word32]
masksIp Word8
m =
  let e :: Word32
e = Word32
0xFFFFFFFF :: Word32
      -- bits: number of bits which should be 1
      maskValue :: Int -> Word32
maskValue Int
bits = Word32
e Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`B.shiftR` (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bits) in
    if Word8
m Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 then
      [Int -> Word32
maskValue (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m), Word32
e, Word32
e, Word32
e]
    else if Word8
m Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
64 then
      [Word32
0, Int -> Word32
maskValue (Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m), Word32
e, Word32
e]
    else if Word8
m Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
96 then
      [Word32
0, Word32
0, Int -> Word32
maskValue (Int
96 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m), Word32
e]
    else if Word8
m Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
128 then
      [Word32
0, Word32
0, Word32
0, Int -> Word32
maskValue (Int
128 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m)]
    else
      [Word32
0, Word32
0, Word32
0, Word32
0]

isCanonical :: IpBlock v -> Bool
isCanonical :: IpBlock v -> Bool
isCanonical block :: IpBlock v
block@(IpBlock (IpAddress Word128
w) (IpNetMask Word8
m)) =
  let IpBlock (IpAddress Word128
cw) (IpNetMask Word8
cm) = IpBlock v -> IpBlock Canonical
forall v. IpBlock v -> IpBlock Canonical
canonicaliseIpBlock IpBlock v
block
  in Word128
cw Word128 -> Word128 -> Bool
forall a. Eq a => a -> a -> Bool
== Word128
w Bool -> Bool -> Bool
&& Word8
cm Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
m

{-# DEPRECATED fromV4 "Deprecated due to poor naming. Use fromIpv4Block instead." #-}
fromV4 :: V4.IpBlock Canonical -> IpBlock v
fromV4 :: IpBlock Canonical -> IpBlock v
fromV4 = IpBlock Canonical -> IpBlock v
forall v. IpBlock Canonical -> IpBlock v
fromIpv4Block

fromIpv4Block :: V4.IpBlock Canonical -> IpBlock v
fromIpv4Block :: IpBlock Canonical -> IpBlock v
fromIpv4Block (V4.IpBlock IpAddress
b IpNetMask
m) =
  -- RFC-4291, "IPv4-Mapped IPv6 Address"
  IpAddress -> IpNetMask -> IpBlock v
forall v. IpAddress -> IpNetMask -> IpBlock v
IpBlock (IpAddress -> IpAddress
fromIpv4 IpAddress
b) (Word8 -> IpNetMask
IpNetMask (Word8
96 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ IpNetMask -> Word8
V4.word8 IpNetMask
m))

fromIpv4 :: V4.IpAddress -> IpAddress
fromIpv4 :: IpAddress -> IpAddress
fromIpv4 (V4.IpAddress Word32
w32) = Word128 -> IpAddress
IpAddress (Word32
0, Word32
0, Word32
0xFFFF, Word32
w32)

isIpv4Block :: IpBlock v -> Bool
isIpv4Block :: IpBlock v -> Bool
isIpv4Block (IpBlock (IpAddress (Word32
a, Word32
b, Word32
c, Word32
_)) IpNetMask
_) = Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xffff

toIpv4Block :: IpBlock v -> Maybe (V4.IpBlock v)
toIpv4Block :: IpBlock v -> Maybe (IpBlock v)
toIpv4Block b :: IpBlock v
b@(IpBlock (IpAddress (Word32
_, Word32
_, Word32
_, Word32
d)) (IpNetMask Word8
m))
  | IpBlock v -> Bool
forall v. IpBlock v -> Bool
isIpv4Block IpBlock v
b =
    let v4Addr :: IpAddress
v4Addr = Word32 -> IpAddress
V4.IpAddress Word32
d
        v4Mask :: IpNetMask
v4Mask = Word8 -> IpNetMask
V4.IpNetMask (Word8
m Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
96)
    in IpBlock v -> Maybe (IpBlock v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IpBlock v -> Maybe (IpBlock v)) -> IpBlock v -> Maybe (IpBlock v)
forall a b. (a -> b) -> a -> b
$ IpAddress -> IpNetMask -> IpBlock v
forall v. IpAddress -> IpNetMask -> IpBlock v
V4.IpBlock IpAddress
v4Addr IpNetMask
v4Mask
  | Bool
otherwise = Maybe (IpBlock v)
forall a. Maybe a
Nothing


canonicaliseIpBlock :: IpBlock v -> IpBlock Canonical
canonicaliseIpBlock :: IpBlock v -> IpBlock Canonical
canonicaliseIpBlock (IpBlock (IpAddress Word128
w) (IpNetMask Word8
m))
  = case (Word32 -> Word32 -> Word32) -> [Word32] -> [Word32] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
(B..&.) [Word32]
ipv6 ((Word32 -> Word32 -> Word32) -> [Word32] -> [Word32] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
B.xor [Word32]
ipv6 [Word32]
masks) of
    [Word32
nw1,Word32
nw2,Word32
nw3,Word32
nw4] -> IpAddress -> IpNetMask -> IpBlock Canonical
forall v. IpAddress -> IpNetMask -> IpBlock v
IpBlock (Word128 -> IpAddress
IpAddress (Word32
nw1, Word32
nw2, Word32
nw3, Word32
nw4)) (Word8 -> IpNetMask
IpNetMask Word8
m)
    [Word32]
_                 -> String -> IpBlock Canonical
forall a. HasCallStack => String -> a
error String
"Very mal-formed IPv6. This should never happen."
  where
    masks :: [Word32]
masks = Word8 -> [Word32]
masksIp Word8
m
    ipv6 :: [Word32]
ipv6 = Word128 -> [Word32]
I.word32x4ToWords Word128
w


firstIpAddress :: IpBlock Canonical -> IpAddress
firstIpAddress :: IpBlock Canonical -> IpAddress
firstIpAddress (IpBlock IpAddress
b IpNetMask
_) = IpAddress
b

lastIpAddress :: IpBlock Canonical -> IpAddress
lastIpAddress :: IpBlock Canonical -> IpAddress
lastIpAddress (IpBlock (IpAddress Word128
b) (IpNetMask Word8
m)) = Word128 -> IpAddress
IpAddress (Word128
b Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ Integer -> Word128
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Integer
I.blockSize128 Word8
m) Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
- Word128
1)

splitIpRange :: Range IpAddress -> (IpBlock Canonical, Maybe (Range IpAddress))
splitIpRange :: Range IpAddress -> (IpBlock Canonical, Maybe (Range IpAddress))
splitIpRange (Range (IpAddress Word128
a) (IpAddress Word128
z)) = (IpBlock Canonical
forall v. IpBlock v
block, Maybe (Range IpAddress)
remainder)
  where bpOuter :: Int
bpOuter   = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word128 -> Int
forall b. FiniteBits b => b -> Int
B.countLeadingZeros (Word128
z Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ Word128
1 Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
- Word128
a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        bpInner :: Int
bpInner   = Word128 -> Int
forall b. FiniteBits b => b -> Int
B.countTrailingZeros ((Word128
forall a. Bounded a => a
maxBound Word128 -> Int -> Word128
forall a. Bits a => a -> Int -> a
`B.shiftL` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bpOuter) Word128 -> Word128 -> Word128
forall a. Bits a => a -> a -> a
B..|. Word128
a)
        block :: IpBlock v
block     = IpAddress -> IpNetMask -> IpBlock v
forall v. IpAddress -> IpNetMask -> IpBlock v
IpBlock (Word128 -> IpAddress
IpAddress Word128
a) (Word8 -> IpNetMask
IpNetMask (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bpInner)))
        hostMask :: Word128
hostMask  = Word128 -> Word128
forall a. Bits a => a -> a
B.complement (Word128
forall a. Bounded a => a
maxBound Word128 -> Int -> Word128
forall a. Bits a => a -> Int -> a
`B.shiftL` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bpInner)
        remainder :: Maybe (Range IpAddress)
remainder = if Word128
a Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ Word128
hostMask Word128 -> Word128 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word128
z
          then Maybe (Range IpAddress)
forall a. Maybe a
Nothing
          else Range IpAddress -> Maybe (Range IpAddress)
forall a. a -> Maybe a
Just (IpAddress -> IpAddress -> Range IpAddress
forall a. a -> a -> Range a
Range (Word128 -> IpAddress
IpAddress (Word128
a Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ Word128
hostMask Word128 -> Word128 -> Word128
forall a. Num a => a -> a -> a
+ Word128
1)) (Word128 -> IpAddress
IpAddress Word128
z))
        width :: Int
width = Word128 -> Int
forall b. FiniteBits b => b -> Int
B.finiteBitSize Word128
a

rangeToBlocksDL :: Range IpAddress -> [IpBlock Canonical] -> [IpBlock Canonical]
rangeToBlocksDL :: Range IpAddress -> [IpBlock Canonical] -> [IpBlock Canonical]
rangeToBlocksDL Range IpAddress
r = do
  let (IpBlock Canonical
b, Maybe (Range IpAddress)
remainder) = Range IpAddress -> (IpBlock Canonical, Maybe (Range IpAddress))
splitIpRange Range IpAddress
r
  case Maybe (Range IpAddress)
remainder of
    Just Range IpAddress
rmd -> (IpBlock Canonical
bIpBlock Canonical -> [IpBlock Canonical] -> [IpBlock Canonical]
forall a. a -> [a] -> [a]
:) ([IpBlock Canonical] -> [IpBlock Canonical])
-> ([IpBlock Canonical] -> [IpBlock Canonical])
-> [IpBlock Canonical]
-> [IpBlock Canonical]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range IpAddress -> [IpBlock Canonical] -> [IpBlock Canonical]
rangeToBlocksDL Range IpAddress
rmd
    Maybe (Range IpAddress)
Nothing  -> (IpBlock Canonical
bIpBlock Canonical -> [IpBlock Canonical] -> [IpBlock Canonical]
forall a. a -> [a] -> [a]
:)

rangeToBlocks :: Range IpAddress -> [IpBlock Canonical]
rangeToBlocks :: Range IpAddress -> [IpBlock Canonical]
rangeToBlocks Range IpAddress
r = Range IpAddress -> [IpBlock Canonical] -> [IpBlock Canonical]
rangeToBlocksDL Range IpAddress
r []

blockToRange :: IpBlock Canonical -> Range IpAddress
blockToRange :: IpBlock Canonical -> Range IpAddress
blockToRange IpBlock Canonical
b = (IpAddress -> IpAddress -> Range IpAddress)
-> (IpAddress, IpAddress) -> Range IpAddress
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IpAddress -> IpAddress -> Range IpAddress
forall a. a -> a -> Range a
Range ((IpAddress, IpAddress) -> Range IpAddress)
-> (IpAddress, IpAddress) -> Range IpAddress
forall a b. (a -> b) -> a -> b
$ (IpBlock Canonical -> IpAddress)
-> (IpBlock Canonical -> IpAddress)
-> (IpBlock Canonical, IpBlock Canonical)
-> (IpAddress, IpAddress)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap IpBlock Canonical -> IpAddress
firstIpAddress IpBlock Canonical -> IpAddress
lastIpAddress (IpBlock Canonical
b, IpBlock Canonical
b)

instance Contains (IpBlock Canonical) where
  contains :: IpBlock Canonical -> IpBlock Canonical -> Bool
contains IpBlock Canonical
l IpBlock Canonical
r = IpBlock Canonical -> IpAddress
firstIpAddress IpBlock Canonical
l IpAddress -> IpAddress -> Bool
forall a. Ord a => a -> a -> Bool
<= IpBlock Canonical -> IpAddress
firstIpAddress IpBlock Canonical
r Bool -> Bool -> Bool
&& IpBlock Canonical -> IpAddress
lastIpAddress IpBlock Canonical
l IpAddress -> IpAddress -> Bool
forall a. Ord a => a -> a -> Bool
>= IpBlock Canonical -> IpAddress
lastIpAddress IpBlock Canonical
r