{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Data.IP.Addr where

import Control.Monad
import Data.Bits
import Data.Char
import Data.Data (Data)
import Data.List (foldl', intersperse)
import Data.String
import Data.Typeable (Typeable)
import Data.Word
import GHC.Enum (predError, succError)
import GHC.Generics
import Network.Socket
import Numeric (showHex, showInt)
import System.ByteOrder
import Text.Appar.String

----------------------------------------------------------------

-- |
--   A unified IP data for 'IPv4' and 'IPv6'.
--   To create this, use the data constructors. Or use 'read' @\"192.0.2.1\"@ :: 'IP', for example. Also, @\"192.0.2.1\"@ can be used as literal with OverloadedStrings.
--
-- >>> (read "192.0.2.1" :: IP) == IPv4 (read "192.0.2.1" :: IPv4)
-- True
-- >>> (read "2001:db8:00:00:00:00:00:01" :: IP) == IPv6 (read "2001:db8:00:00:00:00:00:01" :: IPv6)
-- True
data IP
    = IPv4 {IP -> IPv4
ipv4 :: IPv4}
    | IPv6 {IP -> IPv6
ipv6 :: IPv6}
    deriving (Typeable IP
Typeable IP =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IP -> c IP)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IP)
-> (IP -> Constr)
-> (IP -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IP))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP))
-> ((forall b. Data b => b -> b) -> IP -> IP)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r)
-> (forall u. (forall d. Data d => d -> u) -> IP -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IP -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IP -> m IP)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IP -> m IP)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IP -> m IP)
-> Data IP
IP -> Constr
IP -> DataType
(forall b. Data b => b -> b) -> IP -> IP
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IP -> u
forall u. (forall d. Data d => d -> u) -> IP -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IP -> m IP
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IP)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
$ctoConstr :: IP -> Constr
toConstr :: IP -> Constr
$cdataTypeOf :: IP -> DataType
dataTypeOf :: IP -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IP)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IP)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP)
$cgmapT :: (forall b. Data b => b -> b) -> IP -> IP
gmapT :: (forall b. Data b => b -> b) -> IP -> IP
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IP -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IP -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IP -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IP -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IP -> m IP
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IP -> m IP
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
Data, (forall x. IP -> Rep IP x)
-> (forall x. Rep IP x -> IP) -> Generic IP
forall x. Rep IP x -> IP
forall x. IP -> Rep IP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IP -> Rep IP x
from :: forall x. IP -> Rep IP x
$cto :: forall x. Rep IP x -> IP
to :: forall x. Rep IP x -> IP
Generic, Typeable)

-- |
--   Equality over IP addresses. Correctly compare IPv4 and IPv4-embedded-in-IPv6 addresses.
--
-- >>> (read "2001:db8:00:00:00:00:00:01" :: IP) == (read "2001:db8:00:00:00:00:00:01" :: IP)
-- True
-- >>> (read "2001:db8:00:00:00:00:00:01" :: IP) == (read "2001:db8:00:00:00:00:00:05" :: IP)
-- False
-- >>> (read "127.0.0.1" :: IP) == (read "127.0.0.1" :: IP)
-- True
-- >>> (read "127.0.0.1" :: IP) == (read "10.0.0.1" :: IP)
-- False
-- >>> (read "::ffff:127.0.0.1" :: IP) == (read "127.0.0.1" :: IP)
-- True
-- >>> (read "::ffff:127.0.0.1" :: IP) == (read "127.0.0.9" :: IP)
-- False
-- >>> (read "::ffff:127.0.0.1" :: IP) >= (read "127.0.0.1" :: IP)
-- True
-- >>> (read "::ffff:127.0.0.1" :: IP) <= (read "127.0.0.1" :: IP)
-- True
instance Eq IP where
    (IPv4 IPv4
ip1) == :: IP -> IP -> Bool
== (IPv4 IPv4
ip2) = IPv4
ip1 IPv4 -> IPv4 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv4
ip2
    (IPv6 IPv6
ip1) == (IPv6 IPv6
ip2) = IPv6
ip1 IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6
ip2
    (IPv4 IPv4
ip1) == (IPv6 IPv6
ip2) = IPv4 -> IPv6
ipv4ToIPv6 IPv4
ip1 IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6
ip2
    (IPv6 IPv6
ip1) == (IPv4 IPv4
ip2) = IPv6
ip1 IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv4 -> IPv6
ipv4ToIPv6 IPv4
ip2

instance Ord IP where
    (IPv4 IPv4
ip1) compare :: IP -> IP -> Ordering
`compare` (IPv4 IPv4
ip2) = IPv4
ip1 IPv4 -> IPv4 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IPv4
ip2
    (IPv6 IPv6
ip1) `compare` (IPv6 IPv6
ip2) = IPv6
ip1 IPv6 -> IPv6 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IPv6
ip2
    (IPv4 IPv4
ip1) `compare` (IPv6 IPv6
ip2) = IPv4 -> IPv6
ipv4ToIPv6 IPv4
ip1 IPv6 -> IPv6 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IPv6
ip2
    (IPv6 IPv6
ip1) `compare` (IPv4 IPv4
ip2) = IPv6
ip1 IPv6 -> IPv6 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IPv4 -> IPv6
ipv4ToIPv6 IPv4
ip2

instance Show IP where
    show :: IP -> String
show (IPv4 IPv4
ip) = IPv4 -> String
forall a. Show a => a -> String
show IPv4
ip
    show (IPv6 IPv6
ip) = IPv6 -> String
forall a. Show a => a -> String
show IPv6
ip

----------------------------------------------------------------

-- This is host byte order
type IPv4Addr = Word32
type IPv6Addr = (Word32, Word32, Word32, Word32)

-- |
--   The abstract data type to express an IPv4 address.
--   To create this, use 'toIPv4'. Or use 'read' @\"192.0.2.1\"@ :: 'IPv4', for example. Also, @\"192.0.2.1\"@ can be used as literal with OverloadedStrings.
--
-- >>> read "192.0.2.1" :: IPv4
-- 192.0.2.1
newtype IPv4 = IP4 IPv4Addr
    deriving (IPv4 -> IPv4 -> Bool
(IPv4 -> IPv4 -> Bool) -> (IPv4 -> IPv4 -> Bool) -> Eq IPv4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv4 -> IPv4 -> Bool
== :: IPv4 -> IPv4 -> Bool
$c/= :: IPv4 -> IPv4 -> Bool
/= :: IPv4 -> IPv4 -> Bool
Eq, Eq IPv4
Eq IPv4 =>
(IPv4 -> IPv4 -> Ordering)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> IPv4)
-> (IPv4 -> IPv4 -> IPv4)
-> Ord IPv4
IPv4 -> IPv4 -> Bool
IPv4 -> IPv4 -> Ordering
IPv4 -> IPv4 -> IPv4
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
$ccompare :: IPv4 -> IPv4 -> Ordering
compare :: IPv4 -> IPv4 -> Ordering
$c< :: IPv4 -> IPv4 -> Bool
< :: IPv4 -> IPv4 -> Bool
$c<= :: IPv4 -> IPv4 -> Bool
<= :: IPv4 -> IPv4 -> Bool
$c> :: IPv4 -> IPv4 -> Bool
> :: IPv4 -> IPv4 -> Bool
$c>= :: IPv4 -> IPv4 -> Bool
>= :: IPv4 -> IPv4 -> Bool
$cmax :: IPv4 -> IPv4 -> IPv4
max :: IPv4 -> IPv4 -> IPv4
$cmin :: IPv4 -> IPv4 -> IPv4
min :: IPv4 -> IPv4 -> IPv4
Ord, IPv4
IPv4 -> IPv4 -> Bounded IPv4
forall a. a -> a -> Bounded a
$cminBound :: IPv4
minBound :: IPv4
$cmaxBound :: IPv4
maxBound :: IPv4
Bounded, Typeable IPv4
Typeable IPv4 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IPv4 -> c IPv4)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IPv4)
-> (IPv4 -> Constr)
-> (IPv4 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IPv4))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4))
-> ((forall b. Data b => b -> b) -> IPv4 -> IPv4)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r)
-> (forall u. (forall d. Data d => d -> u) -> IPv4 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IPv4 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IPv4 -> m IPv4)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IPv4 -> m IPv4)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IPv4 -> m IPv4)
-> Data IPv4
IPv4 -> Constr
IPv4 -> DataType
(forall b. Data b => b -> b) -> IPv4 -> IPv4
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IPv4 -> u
forall u. (forall d. Data d => d -> u) -> IPv4 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv4
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4 -> c IPv4
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv4)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4 -> c IPv4
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4 -> c IPv4
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv4
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv4
$ctoConstr :: IPv4 -> Constr
toConstr :: IPv4 -> Constr
$cdataTypeOf :: IPv4 -> DataType
dataTypeOf :: IPv4 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv4)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv4)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4)
$cgmapT :: (forall b. Data b => b -> b) -> IPv4 -> IPv4
gmapT :: (forall b. Data b => b -> b) -> IPv4 -> IPv4
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv4 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv4 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IPv4 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv4 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv4 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4 -> m IPv4
Data, (forall x. IPv4 -> Rep IPv4 x)
-> (forall x. Rep IPv4 x -> IPv4) -> Generic IPv4
forall x. Rep IPv4 x -> IPv4
forall x. IPv4 -> Rep IPv4 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IPv4 -> Rep IPv4 x
from :: forall x. IPv4 -> Rep IPv4 x
$cto :: forall x. Rep IPv4 x -> IPv4
to :: forall x. Rep IPv4 x -> IPv4
Generic, Typeable)

-- |
--   The abstract data type to express an IPv6 address.
--   To create this, use 'toIPv6'. Or use 'read' @\"2001:DB8::1\"@ :: 'IPv6', for example. Also, @\"2001:DB8::1\"@ can be used as literal with OverloadedStrings.
--
-- >>> read "2001:db8:00:00:00:00:00:01" :: IPv6
-- 2001:db8::1
-- >>> read "2001:db8:11e:c00::101" :: IPv6
-- 2001:db8:11e:c00::101
-- >>> read "2001:db8:11e:c00:aa:bb:192.0.2.1" :: IPv6
-- 2001:db8:11e:c00:aa:bb:c000:201
-- >>> read "2001:db8::192.0.2.1" :: IPv6
-- 2001:db8::c000:201
-- >>> read "0::ffff:192.0.2.1" :: IPv6
-- ::ffff:192.0.2.1
-- >>> read "0::0:c000:201" :: IPv6
-- ::192.0.2.1
-- >>> read "::0.0.0.1" :: IPv6
-- ::1
newtype IPv6 = IP6 IPv6Addr
    deriving (IPv6 -> IPv6 -> Bool
(IPv6 -> IPv6 -> Bool) -> (IPv6 -> IPv6 -> Bool) -> Eq IPv6
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv6 -> IPv6 -> Bool
== :: IPv6 -> IPv6 -> Bool
$c/= :: IPv6 -> IPv6 -> Bool
/= :: IPv6 -> IPv6 -> Bool
Eq, Eq IPv6
Eq IPv6 =>
(IPv6 -> IPv6 -> Ordering)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> IPv6)
-> (IPv6 -> IPv6 -> IPv6)
-> Ord IPv6
IPv6 -> IPv6 -> Bool
IPv6 -> IPv6 -> Ordering
IPv6 -> IPv6 -> IPv6
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
$ccompare :: IPv6 -> IPv6 -> Ordering
compare :: IPv6 -> IPv6 -> Ordering
$c< :: IPv6 -> IPv6 -> Bool
< :: IPv6 -> IPv6 -> Bool
$c<= :: IPv6 -> IPv6 -> Bool
<= :: IPv6 -> IPv6 -> Bool
$c> :: IPv6 -> IPv6 -> Bool
> :: IPv6 -> IPv6 -> Bool
$c>= :: IPv6 -> IPv6 -> Bool
>= :: IPv6 -> IPv6 -> Bool
$cmax :: IPv6 -> IPv6 -> IPv6
max :: IPv6 -> IPv6 -> IPv6
$cmin :: IPv6 -> IPv6 -> IPv6
min :: IPv6 -> IPv6 -> IPv6
Ord, IPv6
IPv6 -> IPv6 -> Bounded IPv6
forall a. a -> a -> Bounded a
$cminBound :: IPv6
minBound :: IPv6
$cmaxBound :: IPv6
maxBound :: IPv6
Bounded, Typeable IPv6
Typeable IPv6 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IPv6 -> c IPv6)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IPv6)
-> (IPv6 -> Constr)
-> (IPv6 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IPv6))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6))
-> ((forall b. Data b => b -> b) -> IPv6 -> IPv6)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r)
-> (forall u. (forall d. Data d => d -> u) -> IPv6 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IPv6 -> m IPv6)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IPv6 -> m IPv6)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IPv6 -> m IPv6)
-> Data IPv6
IPv6 -> Constr
IPv6 -> DataType
(forall b. Data b => b -> b) -> IPv6 -> IPv6
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u
forall u. (forall d. Data d => d -> u) -> IPv6 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6 -> c IPv6
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6 -> c IPv6
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6 -> c IPv6
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6
$ctoConstr :: IPv6 -> Constr
toConstr :: IPv6 -> Constr
$cdataTypeOf :: IPv6 -> DataType
dataTypeOf :: IPv6 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6)
$cgmapT :: (forall b. Data b => b -> b) -> IPv6 -> IPv6
gmapT :: (forall b. Data b => b -> b) -> IPv6 -> IPv6
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv6 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IPv6 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
Data, (forall x. IPv6 -> Rep IPv6 x)
-> (forall x. Rep IPv6 x -> IPv6) -> Generic IPv6
forall x. Rep IPv6 x -> IPv6
forall x. IPv6 -> Rep IPv6 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IPv6 -> Rep IPv6 x
from :: forall x. IPv6 -> Rep IPv6 x
$cto :: forall x. Rep IPv6 x -> IPv6
to :: forall x. Rep IPv6 x -> IPv6
Generic, Typeable)

----------------------------------------------------------------
--
-- Enum
--

instance Enum IPv4 where
    fromEnum :: IPv4 -> Int
fromEnum (IP4 Word32
a) = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
a
    toEnum :: Int -> IPv4
toEnum = Word32 -> IPv4
IP4 (Word32 -> IPv4) -> (Int -> Word32) -> Int -> IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a. Enum a => Int -> a
toEnum

instance Enum IPv6 where
    -- fromEnum and toEnum are not really useful, but I defined them anyway
    fromEnum :: IPv6 -> Int
fromEnum (IP6 (Word32
a, Word32
b, Word32
c, Word32
d)) =
        let a' :: Int
a' = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
96
            b' :: Int
b' = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
64
            c' :: Int
c' = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
32
            d' :: Int
d' = Word32 -> Int
forall a. Enum a => a -> Int
fromEnum Word32
d
         in Int
a' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
d'
    toEnum :: Int -> IPv6
toEnum Int
i =
        let i' :: Integer
i' = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Integer
            a :: Word32
a = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i' Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
96 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
            b :: Word32
b = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i' Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
64 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
            c :: Word32
c = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i' Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
            d :: Word32
d = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
         in IPv6Addr -> IPv6
IP6 (Word32
a, Word32
b, Word32
c, Word32
d)

    succ :: IPv6 -> IPv6
succ (IP6 (Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff)) = String -> IPv6
forall a. String -> a
succError String
"IPv6"
    succ (IP6 (Word32
a, Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff)) = IPv6Addr -> IPv6
IP6 (Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
a, Word32
0, Word32
0, Word32
0)
    succ (IP6 (Word32
a, Word32
b, Word32
0xffffffff, Word32
0xffffffff)) = IPv6Addr -> IPv6
IP6 (Word32
a, Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
b, Word32
0, Word32
0)
    succ (IP6 (Word32
a, Word32
b, Word32
c, Word32
0xffffffff)) = IPv6Addr -> IPv6
IP6 (Word32
a, Word32
b, Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
c, Word32
0)
    succ (IP6 (Word32
a, Word32
b, Word32
c, Word32
d)) = IPv6Addr -> IPv6
IP6 (Word32
a, Word32
b, Word32
c, Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
d)

    pred :: IPv6 -> IPv6
pred (IP6 (Word32
0, Word32
0, Word32
0, Word32
0)) = String -> IPv6
forall a. String -> a
predError String
"IPv6"
    pred (IP6 (Word32
a, Word32
0, Word32
0, Word32
0)) = IPv6Addr -> IPv6
IP6 (Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
a, Word32
0xffffffff, Word32
0xffffffff, Word32
0xffffffff)
    pred (IP6 (Word32
a, Word32
b, Word32
0, Word32
0)) = IPv6Addr -> IPv6
IP6 (Word32
a, Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
b, Word32
0xffffffff, Word32
0xffffffff)
    pred (IP6 (Word32
a, Word32
b, Word32
c, Word32
0)) = IPv6Addr -> IPv6
IP6 (Word32
a, Word32
b, Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
c, Word32
0xffffffff)
    pred (IP6 (Word32
a, Word32
b, Word32
c, Word32
d)) = IPv6Addr -> IPv6
IP6 (Word32
a, Word32
b, Word32
c, Word32 -> Word32
forall a. Enum a => a -> a
pred Word32
d)

    enumFrom :: IPv6 -> [IPv6]
enumFrom IPv6
ip = IPv6
ip IPv6 -> [IPv6] -> [IPv6]
forall a. a -> [a] -> [a]
: IPv6 -> [IPv6]
forall {t}. Enum t => t -> [t]
gen IPv6
ip
      where
        gen :: t -> [t]
gen t
i = let i' :: t
i' = t -> t
forall a. Enum a => a -> a
succ t
i in t
i' t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
gen t
i'

    enumFromTo :: IPv6 -> IPv6 -> [IPv6]
enumFromTo IPv6
ip IPv6
ip' = IPv6
ip IPv6 -> [IPv6] -> [IPv6]
forall a. a -> [a] -> [a]
: IPv6 -> [IPv6]
gen IPv6
ip
      where
        gen :: IPv6 -> [IPv6]
gen IPv6
i
            | IPv6
i IPv6 -> IPv6 -> Bool
forall a. Eq a => a -> a -> Bool
== IPv6
ip' = []
            | Bool
otherwise = let i' :: IPv6
i' = IPv6 -> IPv6
forall a. Enum a => a -> a
succ IPv6
i in IPv6
i' IPv6 -> [IPv6] -> [IPv6]
forall a. a -> [a] -> [a]
: IPv6 -> [IPv6]
gen IPv6
i'

    -- These two are implemented via the integer enum instance.
    -- A more correct implementation would essentially require
    -- implementing instance Num IPv6, which isn't something
    -- I wanna do. Another approach is to use Word128 to store
    -- an IPv6 address.
    enumFromThen :: IPv6 -> IPv6 -> [IPv6]
enumFromThen IPv6
ip IPv6
ip' = (Integer -> IPv6) -> [Integer] -> [IPv6]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> IPv6
integerToIP6 [IPv6 -> Integer
ip6ToInteger IPv6
ip, IPv6 -> Integer
ip6ToInteger IPv6
ip' ..]
    enumFromThenTo :: IPv6 -> IPv6 -> IPv6 -> [IPv6]
enumFromThenTo IPv6
ip IPv6
inc IPv6
fin = (Integer -> IPv6) -> [Integer] -> [IPv6]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> IPv6
integerToIP6 [IPv6 -> Integer
ip6ToInteger IPv6
ip, IPv6 -> Integer
ip6ToInteger IPv6
inc .. IPv6 -> Integer
ip6ToInteger IPv6
fin]

instance Enum IP where
    fromEnum :: IP -> Int
fromEnum (IPv4 IPv4
ip) = IPv4 -> Int
forall a. Enum a => a -> Int
fromEnum IPv4
ip
    fromEnum (IPv6 IPv6
ip) = IPv6 -> Int
forall a. Enum a => a -> Int
fromEnum IPv6
ip

    -- Because Int cannot hold an IPv6 anyway
    toEnum :: Int -> IP
toEnum = IPv4 -> IP
IPv4 (IPv4 -> IP) -> (Int -> IPv4) -> Int -> IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IPv4
forall a. Enum a => Int -> a
toEnum

    succ :: IP -> IP
succ (IPv4 IPv4
ip) = IPv4 -> IP
IPv4 (IPv4 -> IP) -> IPv4 -> IP
forall a b. (a -> b) -> a -> b
$ IPv4 -> IPv4
forall a. Enum a => a -> a
succ IPv4
ip
    succ (IPv6 IPv6
ip) = IPv6 -> IP
IPv6 (IPv6 -> IP) -> IPv6 -> IP
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6
forall a. Enum a => a -> a
succ IPv6
ip

    pred :: IP -> IP
pred (IPv4 IPv4
ip) = IPv4 -> IP
IPv4 (IPv4 -> IP) -> IPv4 -> IP
forall a b. (a -> b) -> a -> b
$ IPv4 -> IPv4
forall a. Enum a => a -> a
pred IPv4
ip
    pred (IPv6 IPv6
ip) = IPv6 -> IP
IPv6 (IPv6 -> IP) -> IPv6 -> IP
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6
forall a. Enum a => a -> a
pred IPv6
ip

    enumFrom :: IP -> [IP]
enumFrom (IPv4 IPv4
ip) = (IPv4 -> IP) -> [IPv4] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv4 -> IP
IPv4 ([IPv4] -> [IP]) -> [IPv4] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv4 -> [IPv4]
forall {t}. Enum t => t -> [t]
enumFrom IPv4
ip
    enumFrom (IPv6 IPv6
ip) = (IPv6 -> IP) -> [IPv6] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6 -> IP
IPv6 ([IPv6] -> [IP]) -> [IPv6] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv6 -> [IPv6]
forall {t}. Enum t => t -> [t]
enumFrom IPv6
ip

    enumFromTo :: IP -> IP -> [IP]
enumFromTo (IPv4 IPv4
ip) (IPv4 IPv4
ip') = (IPv4 -> IP) -> [IPv4] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv4 -> IP
IPv4 ([IPv4] -> [IP]) -> [IPv4] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv4 -> IPv4 -> [IPv4]
forall a. Enum a => a -> a -> [a]
enumFromTo IPv4
ip IPv4
ip'
    enumFromTo (IPv6 IPv6
ip) (IPv6 IPv6
ip') = (IPv6 -> IP) -> [IPv6] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6 -> IP
IPv6 ([IPv6] -> [IP]) -> [IPv6] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6 -> [IPv6]
forall a. Enum a => a -> a -> [a]
enumFromTo IPv6
ip IPv6
ip'
    enumFromTo IP
_ IP
_ = String -> [IP]
forall a. HasCallStack => String -> a
error String
"enumFromTo: Incompatible IP families"

    enumFromThen :: IP -> IP -> [IP]
enumFromThen (IPv4 IPv4
ip) (IPv4 IPv4
ip') = (IPv4 -> IP) -> [IPv4] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv4 -> IP
IPv4 ([IPv4] -> [IP]) -> [IPv4] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv4 -> IPv4 -> [IPv4]
forall a. Enum a => a -> a -> [a]
enumFromThen IPv4
ip IPv4
ip'
    enumFromThen (IPv6 IPv6
ip) (IPv6 IPv6
ip') = (IPv6 -> IP) -> [IPv6] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6 -> IP
IPv6 ([IPv6] -> [IP]) -> [IPv6] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6 -> [IPv6]
forall a. Enum a => a -> a -> [a]
enumFromThen IPv6
ip IPv6
ip'
    enumFromThen IP
_ IP
_ = String -> [IP]
forall a. HasCallStack => String -> a
error String
"enumFromThen: Incompatible IP families"

    enumFromThenTo :: IP -> IP -> IP -> [IP]
enumFromThenTo (IPv4 IPv4
ip) (IPv4 IPv4
inc) (IPv4 IPv4
fin) = (IPv4 -> IP) -> [IPv4] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv4 -> IP
IPv4 ([IPv4] -> [IP]) -> [IPv4] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv4 -> IPv4 -> IPv4 -> [IPv4]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo IPv4
ip IPv4
inc IPv4
fin
    enumFromThenTo (IPv6 IPv6
ip) (IPv6 IPv6
inc) (IPv6 IPv6
fin) = (IPv6 -> IP) -> [IPv6] -> [IP]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6 -> IP
IPv6 ([IPv6] -> [IP]) -> [IPv6] -> [IP]
forall a b. (a -> b) -> a -> b
$ IPv6 -> IPv6 -> IPv6 -> [IPv6]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo IPv6
ip IPv6
inc IPv6
fin
    enumFromThenTo IP
_ IP
_ IP
_ = String -> [IP]
forall a. HasCallStack => String -> a
error String
"enumFromThenTo: Incompatible IP families"

ip6ToInteger :: IPv6 -> Integer
ip6ToInteger :: IPv6 -> Integer
ip6ToInteger (IP6 (Word32
a, Word32
b, Word32
c, Word32
d)) =
    let a' :: Integer
a' = Word32 -> Integer
word32ToInteger Word32
a Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shift` Int
96
        b' :: Integer
b' = Word32 -> Integer
word32ToInteger Word32
b Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shift` Int
64
        c' :: Integer
c' = Word32 -> Integer
word32ToInteger Word32
c Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shift` Int
32
        d' :: Integer
d' = Word32 -> Integer
word32ToInteger Word32
d
     in Integer
a' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
b' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
c' Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
d'
  where
    word32ToInteger :: Word32 -> Integer
    word32ToInteger :: Word32 -> Integer
word32ToInteger = Int -> Integer
forall a. Enum a => Int -> a
toEnum (Int -> Integer) -> (Word32 -> Int) -> Word32 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a. Enum a => a -> Int
fromEnum

integerToIP6 :: Integer -> IPv6
integerToIP6 :: Integer -> IPv6
integerToIP6 Integer
i =
    let a :: Word32
a = Integer -> Word32
integerToWord32 (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
96 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
        b :: Word32
b = Integer -> Word32
integerToWord32 (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
64 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
        c :: Word32
c = Integer -> Word32
integerToWord32 (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
        d :: Word32
d = Integer -> Word32
integerToWord32 (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff)
     in IPv6Addr -> IPv6
IP6 (Word32
a, Word32
b, Word32
c, Word32
d)
  where
    integerToWord32 :: Integer -> Word32
    integerToWord32 :: Integer -> Word32
integerToWord32 = Int -> Word32
forall a. Enum a => Int -> a
toEnum (Int -> Word32) -> (Integer -> Int) -> Integer -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Enum a => a -> Int
fromEnum

----------------------------------------------------------------
--
-- Show
--

instance Show IPv4 where
    show :: IPv4 -> String
show IPv4
ip = IPv4 -> ShowS
showIPv4 IPv4
ip String
""

instance Show IPv6 where
    show :: IPv6 -> String
show IPv6
ip = IPv6 -> ShowS
showIPv6 IPv6
ip String
""

-- | Show an IPv4 address in the dot-decimal notation.
showIPv4 :: IPv4 -> ShowS
showIPv4 :: IPv4 -> ShowS
showIPv4 = (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([ShowS] -> ShowS) -> (IPv4 -> [ShowS]) -> IPv4 -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char -> ShowS
showChar Char
'.') ([ShowS] -> [ShowS]) -> (IPv4 -> [ShowS]) -> IPv4 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS) -> [Int] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ShowS
forall a. Integral a => a -> ShowS
showInt ([Int] -> [ShowS]) -> (IPv4 -> [Int]) -> IPv4 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> [Int]
fromIPv4

-- | Show an IPv6 address in the most appropriate notation, based on recommended
-- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.
--
-- /The implementation is completely compatible with the current implementation
-- of the `inet_ntop` function in glibc./
showIPv6 :: IPv6 -> ShowS
showIPv6 :: IPv6 -> ShowS
showIPv6 ip :: IPv6
ip@(IP6 (Word32
a1, Word32
a2, Word32
a3, Word32
a4))
    -- IPv4-Mapped IPv6 Address
    | Word32
a1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
a2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
a3 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xffff =
        String -> ShowS
showString String
"::ffff:" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> ShowS
showIPv4 (Word32 -> IPv4
IP4 Word32
a4)
    -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112)
    | Word32
a1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
a2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
a3 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
a4 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0x10000 =
        String -> ShowS
showString String
"::" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> ShowS
showIPv4 (Word32 -> IPv4
IP4 Word32
a4)
    -- length of longest run > 1, replace it with "::"
    | Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
begin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
        [Int] -> ShowS
showFields [Int]
prefix ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"::" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> ShowS
showFields [Int]
suffix
    -- length of longest run <= 1, don't use "::"
    | Bool
otherwise =
        [Int] -> ShowS
showFields [Int]
fields
  where
    fields :: [Int]
fields = IPv6 -> [Int]
fromIPv6 IPv6
ip
    showFields :: [Int] -> ShowS
showFields = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS) -> ([Int] -> [ShowS]) -> [Int] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char -> ShowS
showChar Char
':') ([ShowS] -> [ShowS]) -> ([Int] -> [ShowS]) -> [Int] -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS) -> [Int] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ShowS
forall a. Integral a => a -> ShowS
showHex
    prefix :: [Int]
prefix = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
begin [Int]
fields -- fields before "::"
    suffix :: [Int]
suffix = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
end [Int]
fields -- fields after "::"
    begin :: Int
begin = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
diff -- the longest run of zeros
    (Int
diff, Int
end) =
        [(Int, Int)] -> (Int, Int)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$
            (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
c Int
i -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
0) Int
0 [Int]
fields [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0 ..]

----------------------------------------------------------------
--
-- IntToIP
--

-- |
--   The 'toIPv4' function returns the 'IPv4' address corresponding to the given
--   list of 'Int' octets.  The function is strict in the four elements of the
--   list.  An error is returned if the list has a differnet length.  The input
--   elements are silently truncated to their 8 least-significant bits before they
--   are combined to form the IPv4 address.
--
-- >>> toIPv4 [192,0,2,1]
-- 192.0.2.1
toIPv4 :: [Int] -> IPv4
toIPv4 :: [Int] -> IPv4
toIPv4 [Int
a1, Int
a2, Int
a3, Int
a4] = Word32 -> IPv4
IP4 Word32
w
  where
    w :: Word32
w =
        (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a3 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a4 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
toIPv4 [Int]
_ = String -> IPv4
forall a. HasCallStack => String -> a
error String
"IPv4 field list length != 4"
{-# INLINE toIPv4 #-}

-- |
--   The 'toIPv4w' function constructs the 'IPv4' address corresponding to the
--   given 'Word32' value.  Unlike the 'fromHostAddress' function, it is strict in
--   the input value, which here is in host byte order.
--
-- >>> toIPv4w 0xc0000201
-- 192.0.2.1
--
-- @since 1.7.9
toIPv4w :: Word32 -> IPv4
toIPv4w :: Word32 -> IPv4
toIPv4w Word32
w = Word32 -> IPv4
IP4 Word32
w
{-# INLINE toIPv4w #-}

-- |
--   The 'toIPv6' function returns the 'IPv6' address corresponding to the given
--   list of eight 16-bit 'Int's.  The function is strict in the eight elements of
--   the list.  An error is returned if the list has a differnet length.  The
--   input elements are in host byte order and are silently truncated to their 16
--   least-signicant bits before they are combined to form the IPv6 address.
--
-- >>> toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]
-- 2001:db8::1
toIPv6 :: [Int] -> IPv6
toIPv6 :: [Int] -> IPv6
toIPv6 [Int
i1, Int
i2, Int
i3, Int
i4, Int
i5, Int
i6, Int
i7, Int
i8] = IPv6Addr -> IPv6
IP6 (Word32
x1, Word32
x2, Word32
x3, Word32
x4)
  where
    !x1 :: Word32
x1 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ (Int
i1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
i2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff)
    !x2 :: Word32
x2 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ (Int
i3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
i4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff)
    !x3 :: Word32
x3 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ (Int
i5 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
i6 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff)
    !x4 :: Word32
x4 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ (Int
i7 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
i8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff)
toIPv6 [Int]
_ = String -> IPv6
forall a. HasCallStack => String -> a
error String
"toIPv6 field list length != 8"
{-# INLINE toIPv6 #-}

-- |
--   The 'toIPv6b' function returns the IPv6 address corresponding to the given
--   list of sixteen 'Int' octets.  The function is strict in the sixteen elements
--   of the list.  An error is returned if the list has a differnet length.  The
--   input elements are silently truncated to their 8 least-signicant bits before
--   they are combined to form the IPv6 address.
--
-- >>> toIPv6b [0x20,0x01,0xD,0xB8,0,0,0,0,0,0,0,0,0,0,0,1]
-- 2001:db8::1
toIPv6b :: [Int] -> IPv6
toIPv6b :: [Int] -> IPv6
toIPv6b
    [ Int
h11
        , Int
h12
        , Int
l11
        , Int
l12
        , Int
h21
        , Int
h22
        , Int
l21
        , Int
l22
        , Int
h31
        , Int
h32
        , Int
l31
        , Int
l32
        , Int
h41
        , Int
h42
        , Int
l41
        , Int
l42
        ] = IPv6Addr -> IPv6
IP6 (Word32
x1, Word32
x2, Word32
x3, Word32
x4)
      where
        !x1 :: Word32
x1 =
            Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
                (Int
h11 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
h12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l11 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)
        !x2 :: Word32
x2 =
            Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
                (Int
h21 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
h22 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l21 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l22 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)
        !x3 :: Word32
x3 =
            Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
                (Int
h31 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
h32 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l31 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l32 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)
        !x4 :: Word32
x4 =
            Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$
                (Int
h41 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
24
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
h42 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l41 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8
                    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
l42 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)
toIPv6b [Int]
_ = String -> IPv6
forall a. HasCallStack => String -> a
error String
"toIPv6b field list length != 16"

-- |
--   The 'toIPv6w' function constructs the 'IPv6' address corresponding to the
--   given four-tuple of host byte order 'Word32' values.  This function differs
--   from the 'fromHostAddress6' function only in the fact that it is strict in
--   the elements of the tuple.
--
-- >>> toIPv6w (0x20010DB8,0x0,0x0,0x1)
-- 2001:db8::1
--
-- @since 1.7.9
toIPv6w :: (Word32, Word32, Word32, Word32) -> IPv6
toIPv6w :: IPv6Addr -> IPv6
toIPv6w w :: IPv6Addr
w@(!Word32
_, !Word32
_, !Word32
_, !Word32
_) = IPv6Addr -> IPv6
IP6 IPv6Addr
w
{-# INLINE toIPv6w #-}

----------------------------------------------------------------
--
-- IPToInt
--

-- |
--   The 'fromIPv4' function returns the list of four 'Int' octets corresponding
--   to the given 'IPv4' address.
--
-- >>> fromIPv4 (toIPv4 [192,0,2,1])
-- [192,0,2,1]
fromIPv4 :: IPv4 -> [Int]
fromIPv4 :: IPv4 -> [Int]
fromIPv4 (IP4 Word32
w) = Word32 -> Int -> Int
split Word32
w Int
0o30 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int -> Int
split Word32
w Int
0o20 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int -> Int
split Word32
w Int
0o10 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int -> Int
split Word32
w Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: []
  where
    split :: Word32 -> Int -> Int
    split :: Word32 -> Int -> Int
split Word32
a Int
n = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
n Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff
{-# INLINE fromIPv4 #-}

-- |
--   The 'fromIPv4w' function returns a single 'Word32' value corresponding to the
--   given the 'IPv4' address.  Unlike the 'toHostAddress' function, the returned
--   value is strictly evaluated, and is not converted to network byte order.
--
-- >>> fromIPv4w (toIPv4 [0xc0,0,2,1]) == 0xc0000201
-- True
--
-- @since 1.7.9
fromIPv4w :: IPv4 -> Word32
fromIPv4w :: IPv4 -> Word32
fromIPv4w (IP4 !Word32
ip4rep) = Word32
ip4rep
{-# INLINE fromIPv4w #-}

-- |
--   The 'fromIPv6' function returns a list eight 'Int's in host byte order
--   corresponding to the eight 16-bit fragments of the given IPv6 address.
--
-- >>> fromIPv6 (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1])
-- [8193,3512,0,0,0,0,0,1]
fromIPv6 :: IPv6 -> [Int]
fromIPv6 :: IPv6 -> [Int]
fromIPv6 (IP6 (Word32
w1, Word32
w2, Word32
w3, Word32
w4)) =
    Word32 -> [Int] -> [Int]
split Word32
w1 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Int] -> [Int]
split Word32
w2 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Int] -> [Int]
split Word32
w3 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Int] -> [Int]
split Word32
w4 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ []
  where
    split :: Word32 -> [Int] -> [Int]
    split :: Word32 -> [Int] -> [Int]
split Word32
n [Int]
acc =
        Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
0x10 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xffff)
            Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xffff)
            Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc
{-# INLINE fromIPv6 #-}

-- |
--   The 'fromIPv6b' function returns the 16 'Int' octets corresponding
--   to the 16 bytes of the given IPv6 address.
--
-- >>> fromIPv6b (toIPv6b [0x20,0x01,0xD,0xB8,0,0,0,0,0,0,0,0,0,0,0,1])
-- [32,1,13,184,0,0,0,0,0,0,0,0,0,0,0,1]
fromIPv6b :: IPv6 -> [Int]
fromIPv6b :: IPv6 -> [Int]
fromIPv6b (IP6 (Word32
w1, Word32
w2, Word32
w3, Word32
w4)) =
    Word32 -> [Int] -> [Int]
split Word32
w1 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Int] -> [Int]
split Word32
w2 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Int] -> [Int]
split Word32
w3 ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Int] -> [Int]
split Word32
w4 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ []
  where
    split :: Word32 -> [Int] -> [Int]
    split :: Word32 -> [Int] -> [Int]
split Word32
n [Int]
acc =
        Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
            Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
            Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
            Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
n Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
            Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc

-- |
--   The 'fromIPv6w' function returns a four-tuple of 'Word32' values in host byte
--   order corresponding to the given 'IPv6' address.  This is identical to the
--   'toHostAddress6' function, except that the elements of four-tuple are
--   first strictly evaluated.
--
-- >>> fromIPv6w (toIPv6 [0x2001,0xDB8,0,0,0,0,0,1]) == (0x20010DB8, 0, 0, 1)
-- True
--
-- @since 1.7.9
fromIPv6w :: IPv6 -> (Word32, Word32, Word32, Word32)
fromIPv6w :: IPv6 -> IPv6Addr
fromIPv6w (IP6 IPv6Addr
ip6rep) = IPv6Addr
ip6rep
{-# INLINE fromIPv6w #-}

----------------------------------------------------------------
--
-- Read
--

instance Read IP where
    readsPrec :: Int -> ReadS IP
readsPrec Int
_ = ReadS IP
parseIP

instance Read IPv4 where
    readsPrec :: Int -> ReadS IPv4
readsPrec Int
_ = ReadS IPv4
parseIPv4

instance Read IPv6 where
    readsPrec :: Int -> ReadS IPv6
readsPrec Int
_ = ReadS IPv6
parseIPv6

parseIP :: String -> [(IP, String)]
parseIP :: ReadS IP
parseIP String
cs = case MkParser String IPv4 -> String -> (Maybe IPv4, String)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser String IPv4
ip4 String
cs of
    (Just IPv4
ip, String
rest) -> [(IPv4 -> IP
IPv4 IPv4
ip, String
rest)]
    (Maybe IPv4
Nothing, String
_) -> case MkParser String IPv6 -> String -> (Maybe IPv6, String)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser String IPv6
ip6 String
cs of
        (Just IPv6
ip, String
rest) -> [(IPv6 -> IP
IPv6 IPv6
ip, String
rest)]
        (Maybe IPv6
Nothing, String
_) -> []

parseIPv4 :: String -> [(IPv4, String)]
parseIPv4 :: ReadS IPv4
parseIPv4 String
cs = case MkParser String IPv4 -> String -> (Maybe IPv4, String)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser String IPv4
ip4 String
cs of
    (Maybe IPv4
Nothing, String
_) -> []
    (Just IPv4
a4, String
rest) -> [(IPv4
a4, String
rest)]

parseIPv6 :: String -> [(IPv6, String)]
parseIPv6 :: ReadS IPv6
parseIPv6 String
cs = case MkParser String IPv6 -> String -> (Maybe IPv6, String)
forall inp a. MkParser inp a -> inp -> (Maybe a, inp)
runParser MkParser String IPv6
ip6 String
cs of
    (Maybe IPv6
Nothing, String
_) -> []
    (Just IPv6
a6, String
rest) -> [(IPv6
a6, String
rest)]

----------------------------------------------------------------
--
-- IsString
--

instance IsString IP where
    fromString :: String -> IP
fromString = String -> IP
forall a. Read a => String -> a
read

instance IsString IPv4 where
    fromString :: String -> IPv4
fromString = String -> IPv4
forall a. Read a => String -> a
read

instance IsString IPv6 where
    fromString :: String -> IPv6
fromString = String -> IPv6
forall a. Read a => String -> a
read

----------------------------------------------------------------
--
-- IPv4 Parser
--

octet :: Parser Int
octet :: Parser Int
octet =
    Int
0 Int -> MkParser String Char -> Parser Int
forall a b. a -> MkParser String b -> MkParser String a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
'0'
        Parser Int -> Parser Int -> Parser Int
forall a.
MkParser String a -> MkParser String a -> MkParser String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Parser Int
forall {m :: * -> *} {t :: * -> *}.
(MonadFail m, Foldable t) =>
t Char -> m Int
toInt (String -> Parser Int) -> MkParser String String -> Parser Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (:) (Char -> ShowS) -> MkParser String Char -> MkParser String ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> MkParser String Char
forall inp. Input inp => String -> MkParser inp Char
oneOf [Char
'1' .. Char
'9'] MkParser String ShowS
-> MkParser String String -> MkParser String String
forall a b.
MkParser String (a -> b) -> MkParser String a -> MkParser String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MkParser String Char -> MkParser String String
forall a. MkParser String a -> MkParser String [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many MkParser String Char
forall inp. Input inp => MkParser inp Char
digit)
  where
    toInt :: t Char -> m Int
toInt t Char
ds = m Int -> (Int -> m Int) -> Maybe Int -> m Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m Int
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv4 address") Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> m Int) -> Maybe Int -> m Int
forall a b. (a -> b) -> a -> b
$ (Char -> (Int -> Maybe Int) -> Int -> Maybe Int)
-> (Int -> Maybe Int) -> t Char -> Int -> Maybe Int
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> (Int -> Maybe Int) -> Int -> Maybe Int
forall {a}. Char -> (Int -> Maybe a) -> Int -> Maybe a
go Int -> Maybe Int
forall a. a -> Maybe a
Just t Char
ds Int
0
    go :: Char -> (Int -> Maybe a) -> Int -> Maybe a
go !Char
d !Int -> Maybe a
f !Int
n =
        let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
         in if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255 then Int -> Maybe a
f Int
n' else Maybe a
forall a. Maybe a
Nothing

ip4 :: Parser IPv4
ip4 :: MkParser String IPv4
ip4 = Parser ()
skipSpaces Parser () -> MkParser String IPv4 -> MkParser String IPv4
forall a b.
MkParser String a -> MkParser String b -> MkParser String b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> IPv4
toIPv4 ([Int] -> IPv4) -> MkParser String [Int] -> MkParser String IPv4
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> MkParser String [Int]
ip4' Bool
True

ip4' :: Bool -> Parser [Int]
ip4' :: Bool -> MkParser String [Int]
ip4' Bool
checkTermination = do
    Int
a0 <- Parser Int
octet
    Char
_ <- Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
'.'
    Int
a1 <- Parser Int
octet
    Char
_ <- Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
'.'
    Int
a2 <- Parser Int
octet
    Char
_ <- Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
'.'
    Int
a3 <- Parser Int
octet
    let as :: [Int]
as = [Int
a0, Int
a1, Int
a2, Int
a3]
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkTermination (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
        Parser ()
skipSpaces Parser () -> Parser () -> Parser ()
forall a b.
MkParser String a -> MkParser String b -> MkParser String b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
termination
    [Int] -> MkParser String [Int]
forall a. a -> MkParser String a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
as

skipSpaces :: Parser ()
skipSpaces :: Parser ()
skipSpaces = MkParser String String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MkParser String String -> Parser ())
-> MkParser String String -> Parser ()
forall a b. (a -> b) -> a -> b
$ MkParser String Char -> MkParser String String
forall a. MkParser String a -> MkParser String [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
' ')

termination :: Parser ()
termination :: Parser ()
termination = (String -> (Maybe (), String)) -> Parser ()
forall inp a. (inp -> (Maybe a, inp)) -> MkParser inp a
P ((String -> (Maybe (), String)) -> Parser ())
-> (String -> (Maybe (), String)) -> Parser ()
forall a b. (a -> b) -> a -> b
$ \String
str -> case String
str of
    [] -> (() -> Maybe ()
forall a. a -> Maybe a
Just (), String
"")
    String
_ -> (Maybe ()
forall a. Maybe a
Nothing, String
str)

----------------------------------------------------------------
--
-- IPv6 Parser (RFC 4291)
--

hex :: Parser Int
hex :: Parser Int
hex = do
    String
ns <- MkParser String Char -> MkParser String String
forall a. MkParser String a -> MkParser String [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some MkParser String Char
forall inp. Input inp => MkParser inp Char
hexDigit
    String -> Parser ()
forall {f :: * -> *} {t :: * -> *} {a}.
(Foldable t, MonadFail f) =>
t a -> f ()
check String
ns
    let ms :: [Int]
ms = (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt String
ns
        val :: Int
val = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
x Int
y -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int
0 [Int]
ms
    Int -> Parser Int
forall a. a -> MkParser String a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
val
  where
    check :: t a -> f ()
check t a
ns = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) (String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 address -- more than 4 hex")

colon2 :: Parser ()
colon2 :: Parser ()
colon2 = MkParser String String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MkParser String String -> Parser ())
-> MkParser String String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> MkParser String String
forall inp. Input inp => String -> MkParser inp String
string String
"::"

format :: [Int] -> [Int] -> Parser [Int]
format :: [Int] -> [Int] -> MkParser String [Int]
format [Int]
bs1 [Int]
bs2 = do
    let len1 :: Int
len1 = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bs1
        len2 :: Int
len2 = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bs2
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7) (String -> Parser ()
forall a. String -> MkParser String a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 address1")
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7) (String -> Parser ()
forall a. String -> MkParser String a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 address2")
    let len :: Int
len = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len2
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (String -> Parser ()
forall a. String -> MkParser String a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 address3")
    let spring :: [Int]
spring = Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
len Int
0
    [Int] -> MkParser String [Int]
forall a. a -> MkParser String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> MkParser String [Int]) -> [Int] -> MkParser String [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
bs1 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
spring [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
bs2

ip6 :: Parser IPv6
ip6 :: MkParser String IPv6
ip6 = Bool -> MkParser String IPv6
ip6' Bool
True

ip6' :: Bool -> Parser IPv6
ip6' :: Bool -> MkParser String IPv6
ip6' Bool
checkTermination = Parser ()
skipSpaces Parser () -> MkParser String IPv6 -> MkParser String IPv6
forall a b.
MkParser String a -> MkParser String b -> MkParser String b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> IPv6
toIPv6 ([Int] -> IPv6) -> MkParser String [Int] -> MkParser String IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkParser String [Int]
ip6arr
  where
    ip6arr :: MkParser String [Int]
ip6arr =
        Bool -> MkParser String [Int]
ip4Embedded' Bool
checkTermination
            MkParser String [Int]
-> MkParser String [Int] -> MkParser String [Int]
forall a.
MkParser String a -> MkParser String a -> MkParser String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
                Parser ()
colon2
                [Int]
bs <- [Int] -> MkParser String [Int] -> MkParser String [Int]
forall a inp. a -> MkParser inp a -> MkParser inp a
option [] MkParser String [Int]
hexcolon
                [Int] -> [Int] -> MkParser String [Int]
format [] [Int]
bs
            MkParser String [Int]
-> MkParser String [Int] -> MkParser String [Int]
forall a.
MkParser String a -> MkParser String a -> MkParser String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MkParser String [Int] -> MkParser String [Int]
forall inp a. MkParser inp a -> MkParser inp a
try
                ( do
                    [Int]
rs <- MkParser String [Int]
hexcolon
                    [Int] -> Parser ()
forall {f :: * -> *} {t :: * -> *} {a}.
(Foldable t, MonadFail f) =>
t a -> f ()
check [Int]
rs
                    [Int] -> MkParser String [Int]
forall a. a -> MkParser String a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
rs
                )
            MkParser String [Int]
-> MkParser String [Int] -> MkParser String [Int]
forall a.
MkParser String a -> MkParser String a -> MkParser String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
                [Int]
bs1 <- MkParser String [Int]
hexcolon2
                [Int]
bs2 <- [Int] -> MkParser String [Int] -> MkParser String [Int]
forall a inp. a -> MkParser inp a -> MkParser inp a
option [] MkParser String [Int]
hexcolon
                [Int] -> [Int] -> MkParser String [Int]
format [Int]
bs1 [Int]
bs2
      where
        hexcolon :: MkParser String [Int]
hexcolon = Parser Int
hex Parser Int -> MkParser String Char -> MkParser String [Int]
forall inp a b.
MkParser inp a -> MkParser inp b -> MkParser inp [a]
`sepBy1` Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
':'
        hexcolon2 :: MkParser String [Int]
hexcolon2 = Parser Int -> MkParser String Char -> MkParser String [Int]
forall inp a b.
MkParser inp a -> MkParser inp b -> MkParser inp [a]
manyTill (Parser Int
hex Parser Int -> MkParser String Char -> Parser Int
forall a b.
MkParser String a -> MkParser String b -> MkParser String a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
':') (Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
':')
        check :: t a -> f ()
check t a
bs = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8) (String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 address4")

ip4Embedded :: Parser [Int]
ip4Embedded :: MkParser String [Int]
ip4Embedded = Bool -> MkParser String [Int]
ip4Embedded' Bool
True

ip4Embedded' :: Bool -> Parser [Int]
ip4Embedded' :: Bool -> MkParser String [Int]
ip4Embedded' Bool
checkTermination =
    MkParser String [Int] -> MkParser String [Int]
forall inp a. MkParser inp a -> MkParser inp a
try
        ( do
            Parser ()
colon2
            [Int]
bs <- MkParser String [Int]
beforeEmbedded
            [Int]
embedded <- Bool -> MkParser String [Int]
ip4' Bool
checkTermination
            [Int] -> [Int] -> MkParser String [Int]
format [] ([Int]
bs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int]
forall {a}. Bits a => [a] -> [a]
ip4ToIp6 [Int]
embedded)
        )
        -- matches 2001:db8::192.0.2.1
        MkParser String [Int]
-> MkParser String [Int] -> MkParser String [Int]
forall a.
MkParser String a -> MkParser String a -> MkParser String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MkParser String [Int] -> MkParser String [Int]
forall inp a. MkParser inp a -> MkParser inp a
try
            ( do
                [Int]
bs1 <- Parser Int -> MkParser String Char -> MkParser String [Int]
forall inp a b.
MkParser inp a -> MkParser inp b -> MkParser inp [a]
manyTill (Parser Int -> Parser Int
forall inp a. MkParser inp a -> MkParser inp a
try (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Parser Int
hex Parser Int -> MkParser String Char -> Parser Int
forall a b.
MkParser String a -> MkParser String b -> MkParser String a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
':') (Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
':')
                [Int]
bs2 <- [Int] -> MkParser String [Int] -> MkParser String [Int]
forall a inp. a -> MkParser inp a -> MkParser inp a
option [] MkParser String [Int]
beforeEmbedded
                [Int]
embedded <- Bool -> MkParser String [Int]
ip4' Bool
checkTermination
                [Int] -> [Int] -> MkParser String [Int]
format [Int]
bs1 ([Int]
bs2 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int]
forall {a}. Bits a => [a] -> [a]
ip4ToIp6 [Int]
embedded)
            )
        -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1
        MkParser String [Int]
-> MkParser String [Int] -> MkParser String [Int]
forall a.
MkParser String a -> MkParser String a -> MkParser String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MkParser String [Int] -> MkParser String [Int]
forall inp a. MkParser inp a -> MkParser inp a
try
            ( do
                [Int]
bs <- MkParser String [Int]
beforeEmbedded
                [Int]
embedded <- Bool -> MkParser String [Int]
ip4' Bool
checkTermination
                let rs :: [Int]
rs = [Int]
bs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Int]
forall {a}. Bits a => [a] -> [a]
ip4ToIp6 [Int]
embedded
                [Int] -> Parser ()
forall {f :: * -> *} {t :: * -> *} {a}.
(Foldable t, MonadFail f) =>
t a -> f ()
check [Int]
rs
                [Int] -> MkParser String [Int]
forall a. a -> MkParser String a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
rs
            )
  where
    beforeEmbedded :: MkParser String [Int]
beforeEmbedded = Parser Int -> MkParser String [Int]
forall a. MkParser String a -> MkParser String [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Int -> MkParser String [Int])
-> Parser Int -> MkParser String [Int]
forall a b. (a -> b) -> a -> b
$ Parser Int -> Parser Int
forall inp a. MkParser inp a -> MkParser inp a
try (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Parser Int
hex Parser Int -> MkParser String Char -> Parser Int
forall a b.
MkParser String a -> MkParser String b -> MkParser String a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> MkParser String Char
forall inp. Input inp => Char -> MkParser inp Char
char Char
':'
    ip4ToIp6 :: [a] -> [a]
ip4ToIp6 [a
a, a
b, a
c, a
d] =
        [ a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
b
        , a
c a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
d
        ]
    ip4ToIp6 [a]
_ = String -> [a]
forall a. HasCallStack => String -> a
error String
"ip4ToIp6"
    check :: t a -> f ()
check t a
bs = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8) (String -> f ()
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IPv6 address4")

----------------------------------------------------------------
--
-- HostAddress and HostAddress6
--

-- | The 'fromHostAddress' function converts 'HostAddress' to 'IPv4'.
fromHostAddress :: HostAddress -> IPv4
fromHostAddress :: Word32 -> IPv4
fromHostAddress Word32
addr4
    | ByteOrder
byteOrder ByteOrder -> ByteOrder -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOrder
LittleEndian = Word32 -> IPv4
IP4 (Word32 -> IPv4) -> Word32 -> IPv4
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
fixByteOrder Word32
addr4
    | Bool
otherwise = Word32 -> IPv4
IP4 Word32
addr4

-- | The 'toHostAddress' function converts 'IPv4' to 'HostAddress'.
toHostAddress :: IPv4 -> HostAddress
toHostAddress :: IPv4 -> Word32
toHostAddress (IP4 Word32
addr4)
    | ByteOrder
byteOrder ByteOrder -> ByteOrder -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOrder
LittleEndian = Word32 -> Word32
fixByteOrder Word32
addr4
    | Bool
otherwise = Word32
addr4

-- | The 'fromHostAddress6' function converts 'HostAddress6' to 'IPv6'.
fromHostAddress6 :: HostAddress6 -> IPv6
fromHostAddress6 :: IPv6Addr -> IPv6
fromHostAddress6 = IPv6Addr -> IPv6
IP6

-- | The 'toHostAddress6' function converts 'IPv6' to 'HostAddress6'.
toHostAddress6 :: IPv6 -> HostAddress6
toHostAddress6 :: IPv6 -> IPv6Addr
toHostAddress6 (IP6 IPv6Addr
addr6) = IPv6Addr
addr6

fixByteOrder :: Word32 -> Word32
fixByteOrder :: Word32 -> Word32
fixByteOrder Word32
s = Word32
d1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d3 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
d4
  where
    d1 :: Word32
d1 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
s Int
24
    d2 :: Word32
d2 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
s Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00ff0000
    d3 :: Word32
d3 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
s Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x0000ff00
    d4 :: Word32
d4 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
s Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x000000ff

-- | Convert IPv4 address to IPv4-embedded-in-IPv6
ipv4ToIPv6 :: IPv4 -> IPv6
ipv4ToIPv6 :: IPv4 -> IPv6
ipv4ToIPv6 IPv4
ip = [Int] -> IPv6
toIPv6b [Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0xff, Int
0xff, Int
i1, Int
i2, Int
i3, Int
i4]
  where
    [Int
i1, Int
i2, Int
i3, Int
i4] = IPv4 -> [Int]
fromIPv4 IPv4
ip

-- | Convert 'SockAddr' to 'IP'.
--
--   Since: 1.7.4.
fromSockAddr :: SockAddr -> Maybe (IP, PortNumber)
fromSockAddr :: SockAddr -> Maybe (IP, PortNumber)
fromSockAddr (SockAddrInet PortNumber
pn Word32
ha) = (IP, PortNumber) -> Maybe (IP, PortNumber)
forall a. a -> Maybe a
Just (IPv4 -> IP
IPv4 (Word32 -> IPv4
fromHostAddress Word32
ha), PortNumber
pn)
fromSockAddr (SockAddrInet6 PortNumber
pn Word32
_ IPv6Addr
ha6 Word32
_) = (IP, PortNumber) -> Maybe (IP, PortNumber)
forall a. a -> Maybe a
Just (IPv6 -> IP
IPv6 (IPv6Addr -> IPv6
fromHostAddress6 IPv6Addr
ha6), PortNumber
pn)
fromSockAddr SockAddr
_ = Maybe (IP, PortNumber)
forall a. Maybe a
Nothing

-- | Convert 'IP' to 'SockAddr'.
--
--   Since: 1.7.8.
toSockAddr :: (IP, PortNumber) -> SockAddr
toSockAddr :: (IP, PortNumber) -> SockAddr
toSockAddr (IPv4 IPv4
addr4, PortNumber
pn) = PortNumber -> Word32 -> SockAddr
SockAddrInet PortNumber
pn (IPv4 -> Word32
toHostAddress IPv4
addr4)
toSockAddr (IPv6 IPv6
addr6, PortNumber
pn) = PortNumber -> Word32 -> IPv6Addr -> Word32 -> SockAddr
SockAddrInet6 PortNumber
pn Word32
0 (IPv6 -> IPv6Addr
toHostAddress6 IPv6
addr6) Word32
0