-- |
-- Module      : Foundation.Network.IPv6
-- License     : BSD-style
-- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>
-- Stability   : experimental
-- Portability : portable
--
-- IPv6 data type
--
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

module Foundation.Network.IPv6
    ( IPv6
    , any, loopback
    , fromString, toString
    , fromTuple, toTuple
      -- * parsers
    , ipv6Parser
    , ipv6ParserPreferred
    , ipv6ParserCompressed
    , ipv6ParserIpv4Embedded
    ) where

import Prelude (fromIntegral, read)
import qualified Text.Printf as Base
import Data.Char (isHexDigit, isDigit)
import Numeric (readHex)

import Foundation.Class.Storable
import Foundation.Hashing.Hashable
import Basement.Compat.Base
import Data.Proxy
import Foundation.Primitive
import Basement.Types.OffsetSize
import Foundation.Numerical
import Foundation.Collection (Element, length, intercalate, replicate, null)
import Foundation.Parser
import Foundation.String (String)
import Foundation.Bits

-- | IPv6 data type
data IPv6 = IPv6 {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
    deriving (IPv6 -> IPv6 -> Bool
(IPv6 -> IPv6 -> Bool) -> (IPv6 -> IPv6 -> Bool) -> Eq IPv6
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6 -> IPv6 -> Bool
$c/= :: IPv6 -> IPv6 -> Bool
== :: IPv6 -> IPv6 -> Bool
$c== :: 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
min :: IPv6 -> IPv6 -> IPv6
$cmin :: IPv6 -> IPv6 -> IPv6
max :: IPv6 -> IPv6 -> IPv6
$cmax :: IPv6 -> IPv6 -> IPv6
>= :: IPv6 -> IPv6 -> Bool
$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
compare :: IPv6 -> IPv6 -> Ordering
$ccompare :: IPv6 -> IPv6 -> Ordering
$cp1Ord :: Eq IPv6
Ord, Typeable)
instance NormalForm IPv6 where
    toNormalForm :: IPv6 -> ()
toNormalForm !IPv6
_ = ()
instance Hashable IPv6 where
    hashMix :: IPv6 -> st -> st
hashMix (IPv6 Word64
w1 Word64
w2) = Word64 -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix Word64
w1 (st -> st) -> (st -> st) -> st -> st
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> st -> st
forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix Word64
w2
instance Show IPv6 where
    show :: IPv6 -> String
show = IPv6 -> String
toLString
instance IsString IPv6 where
    fromString :: String -> IPv6
fromString = String -> IPv6
fromLString
instance Storable IPv6 where
    peek :: Ptr IPv6 -> IO IPv6
peek Ptr IPv6
ptr = (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple ((Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
 -> IPv6)
-> IO
     (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IO IPv6
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (   (,,,,,,,)
        (Word16
 -> Word16
 -> Word16
 -> Word16
 -> Word16
 -> Word16
 -> Word16
 -> Word16
 -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
     Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
0)
        IO
  (Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
1)
        IO
  (Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> Word16
      -> Word16
      -> Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
2)
        IO
  (Word16
   -> Word16
   -> Word16
   -> Word16
   -> Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> Word16
      -> Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
3)
        IO
  (Word16
   -> Word16
   -> Word16
   -> Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
4)
        IO
  (Word16
   -> Word16
   -> Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16
      -> Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
5)
        IO
  (Word16
   -> Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16
      -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
          Word16))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
6)
        IO
  (Word16
   -> (Word16, Word16, Word16, Word16, Word16, Word16, Word16,
       Word16))
-> IO Word16
-> IO
     (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BE Word16 -> Word16
forall a. ByteSwap a => BE a -> a
fromBE (BE Word16 -> Word16) -> IO (BE Word16) -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (BE Word16) -> Offset (BE Word16) -> IO (BE Word16)
forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
7)
        )
      where
        ptr' :: Ptr (BE Word16)
        ptr' :: Ptr (BE Word16)
ptr' = Ptr IPv6 -> Ptr (BE Word16)
forall a b. Ptr a -> Ptr b
castPtr Ptr IPv6
ptr
    poke :: Ptr IPv6 -> IPv6 -> IO ()
poke Ptr IPv6
ptr IPv6
ipv6 = do
        let (Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6,Word16
i7,Word16
i8) = IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toTuple IPv6
ipv6
         in Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
0 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i1)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
1 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i2)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
2 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i3)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
3 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i4)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
4 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i5)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
5 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i6)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
6 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i7)
         IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (BE Word16) -> Offset (BE Word16) -> BE Word16 -> IO ()
forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
7 (Word16 -> BE Word16
forall a. ByteSwap a => a -> BE a
toBE Word16
i8)
      where
        ptr' :: Ptr (BE Word16)
        ptr' :: Ptr (BE Word16)
ptr' = Ptr IPv6 -> Ptr (BE Word16)
forall a b. Ptr a -> Ptr b
castPtr Ptr IPv6
ptr
instance StorableFixed IPv6 where
    size :: proxy IPv6 -> CountOf Word8
size      proxy IPv6
_ = (Proxy Word64 -> CountOf Word8
forall a (proxy :: * -> *).
StorableFixed a =>
proxy a -> CountOf Word8
size      (Proxy Word64
forall k (t :: k). Proxy t
Proxy :: Proxy Word64)) CountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a n. (Additive a, IsNatural n) => n -> a -> a
`scale` CountOf Word8
2
    alignment :: proxy IPv6 -> CountOf Word8
alignment proxy IPv6
_ = Proxy Word64 -> CountOf Word8
forall a (proxy :: * -> *).
StorableFixed a =>
proxy a -> CountOf Word8
alignment (Proxy Word64
forall k (t :: k). Proxy t
Proxy :: Proxy Word64)

-- | equivalent to `::`
any :: IPv6
any :: IPv6
any = (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple (Word16
0,Word16
0,Word16
0,Word16
0,Word16
0,Word16
0,Word16
0,Word16
0)

-- | equivalent to `::1`
loopback :: IPv6
loopback :: IPv6
loopback = (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple (Word16
0,Word16
0,Word16
0,Word16
0,Word16
0,Word16
0,Word16
0,Word16
1)

-- | serialise to human readable IPv6
--
-- >>> toString (fromString "0:0:0:0:0:0:0:1" :: IPv6)
toString :: IPv6 -> String
toString :: IPv6 -> String
toString = String -> String
forall l. IsList l => [Item l] -> l
fromList (String -> String) -> (IPv6 -> String) -> IPv6 -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv6 -> String
toLString

toLString :: IPv6 -> [Char]
toLString :: IPv6 -> String
toLString IPv6
ipv4 =
    let (Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6,Word16
i7,Word16
i8) = IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toTuple IPv6
ipv4
     in Element [String] -> [String] -> Element [String]
forall c.
(Sequential c, Monoid (Item c)) =>
Element c -> c -> Element c
intercalate String
Element [String]
":" ([String] -> Element [String]) -> [String] -> Element [String]
forall a b. (a -> b) -> a -> b
$ Word16 -> String
showHex4 (Word16 -> String) -> [Word16] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6,Word16
i7,Word16
i8]

showHex4 :: Word16 -> [Char]
showHex4 :: Word16 -> String
showHex4 = Word16 -> String
showHex

showHex :: Word16 -> [Char]
showHex :: Word16 -> String
showHex = String -> Word16 -> String
forall r. PrintfType r => String -> r
Base.printf String
"%04x"

fromLString :: [Char] -> IPv6
fromLString :: String -> IPv6
fromLString = (ParseError String -> IPv6)
-> (IPv6 -> IPv6) -> Either (ParseError String) IPv6 -> IPv6
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError String -> IPv6
forall a e. Exception e => e -> a
throw IPv6 -> IPv6
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Either (ParseError String) IPv6 -> IPv6)
-> (String -> Either (ParseError String) IPv6) -> String -> IPv6
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser String IPv6 -> String -> Either (ParseError String) IPv6
forall input a.
(ParserSource input, Monoid (Chunk input)) =>
Parser input a -> input -> Either (ParseError input) a
parseOnly Parser String IPv6
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6Parser


-- | create an IPv6 from the given tuple
fromTuple :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
          -> IPv6
fromTuple :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple (Word16
i1, Word16
i2, Word16
i3, Word16
i4, Word16
i5, Word16
i6, Word16
i7, Word16
i8) = Word64 -> Word64 -> IPv6
IPv6 Word64
hi Word64
low
  where
    f :: Word16 -> Word64
    f :: Word16 -> Word64
f = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    hi, low :: Word64
    hi :: Word64
hi =    (Word16 -> Word64
f Word16
i1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
48)
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
32)
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
16)
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i4        )
    low :: Word64
low =   (Word16 -> Word64
f Word16
i5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
48)
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
32)
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i7 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.<<. Int
16)
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i8        )

-- | decompose an IPv6 into a tuple
toTuple :: IPv6 -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)
toTuple :: IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toTuple (IPv6 Word64
hi Word64
low) =
    (Word64 -> Word16
f Word64
w1, Word64 -> Word16
f Word64
w2, Word64 -> Word16
f Word64
w3, Word64 -> Word16
f Word64
w4, Word64 -> Word16
f Word64
w5, Word64 -> Word16
f Word64
w6, Word64 -> Word16
f Word64
w7, Word64 -> Word16
f Word64
w8)
  where
    f :: Word64 -> Word16
    f :: Word64 -> Word16
f = Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    w1, w2, w3, w4, w5, w6, w7, w8 :: Word64
    w1 :: Word64
w1 = Word64
hi  Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
48
    w2 :: Word64
w2 = Word64
hi  Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
32
    w3 :: Word64
w3 = Word64
hi  Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
16
    w4 :: Word64
w4 = Word64
hi
    w5 :: Word64
w5 = Word64
low Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
48
    w6 :: Word64
w6 = Word64
low Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
32
    w7 :: Word64
w7 = Word64
low Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
.>>. Int
16
    w8 :: Word64
w8 = Word64
low

-- | IPv6 Parser as described in RFC4291
--
-- for more details: https://tools.ietf.org/html/rfc4291.html#section-2.2
--
-- which is exactly:
--
-- ```
--     ipv6ParserPreferred
-- <|> ipv6ParserIPv4Embedded
-- <|> ipv6ParserCompressed
-- ```
--
ipv6Parser :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
           => Parser input IPv6
ipv6Parser :: Parser input IPv6
ipv6Parser =  Parser input IPv6
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserPreferred
          Parser input IPv6 -> Parser input IPv6 -> Parser input IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser input IPv6
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserIpv4Embedded
          Parser input IPv6 -> Parser input IPv6 -> Parser input IPv6
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser input IPv6
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserCompressed

-- | IPv6 parser as described in RFC4291 section 2.2.1
--
-- The preferred form is x:x:x:x:x:x:x:x, where the 'x's are one to
-- four hexadecimal digits of the eight 16-bit pieces of the address.
--
-- * `ABCD:EF01:2345:6789:ABCD:EF01:2345:6789`
-- * `2001:DB8:0:0:8:800:200C:417A`
--
ipv6ParserPreferred :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
                    => Parser input IPv6
ipv6ParserPreferred :: Parser input IPv6
ipv6ParserPreferred = do
    Word16
i1 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i2 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i3 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i4 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i5 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i6 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i7 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i8 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16
    IPv6 -> Parser input IPv6
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6 -> Parser input IPv6) -> IPv6 -> Parser input IPv6
forall a b. (a -> b) -> a -> b
$ (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple (Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6,Word16
i7,Word16
i8)


-- | IPv6 address with embedded IPv4 address
--
-- when dealing with a mixed environment of IPv4 and IPv6 nodes is
-- x:x:x:x:x:x:d.d.d.d, where the 'x's are the hexadecimal values of
-- the six high-order 16-bit pieces of the address, and the 'd's are
-- the decimal values of the four low-order 8-bit pieces of the
-- address (standard IPv4 representation).
--
-- * `0:0:0:0:0:0:13.1.68.3`
-- * `0:0:0:0:0:FFFF:129.144.52.38`
-- * `::13.1.68.3`
-- * `::FFFF:129.144.52.38`
--
ipv6ParserIpv4Embedded :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
                       => Parser input IPv6
ipv6ParserIpv4Embedded :: Parser input IPv6
ipv6ParserIpv4Embedded = do
    [Word16]
bs1 <- Condition -> Parser input Word16 -> Parser input [Word16]
forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between (And -> Condition) -> And -> Condition
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` Word
6 ) (Parser input Word16 -> Parser input [Word16])
-> Parser input Word16 -> Parser input [Word16]
forall a b. (a -> b) -> a -> b
$ Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Maybe ()
_ <- Parser input () -> Parser input (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Maybe ()
_ <- Parser input () -> Parser input (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    let (CountOf Int
lenBs1) = [Word16] -> CountOf (Element [Word16])
forall c. Collection c => c -> CountOf (Element c)
length [Word16]
bs1
    [Word16]
bs2 <- Condition -> Parser input Word16 -> Parser input [Word16]
forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between (And -> Condition) -> And -> Condition
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Int
6 Int -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
- Int
lenBs1)) (Parser input Word16 -> Parser input [Word16])
-> Parser input Word16 -> Parser input [Word16]
forall a b. (a -> b) -> a -> b
$ Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Maybe ()
_ <- Parser input () -> Parser input (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    [Word16]
is <- CountOf Word16 -> [Word16] -> [Word16] -> Parser input [Word16]
forall a (m :: * -> *).
(Integral a, Monad m) =>
CountOf a -> [a] -> [a] -> m [a]
format CountOf Word16
6 [Word16]
bs1 [Word16]
bs2
    case [Word16]
is of
        [Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6] -> do
            Word16
m1 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipDot
            Word16
m2 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipDot
            Word16
m3 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipDot
            Word16
m4 <- Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8
            IPv6 -> Parser input IPv6
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6 -> Parser input IPv6) -> IPv6 -> Parser input IPv6
forall a b. (a -> b) -> a -> b
$ (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple ( Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6
                               , Word16
m1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
m2
                               , Word16
m3 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
m4
                               )
        [Word16]
_ -> String -> Parser input IPv6
forall a. HasCallStack => String -> a
error String
"internal error: format should return 6"

-- | IPv6 parser as described in RFC4291 section 2.2.2
--
-- The use of "::" indicates one or more groups of 16 bits of zeros.
-- The "::" can only appear once in an address.  The "::" can also be
-- used to compress leading or trailing zeros in an address.
--
-- * `2001:DB8::8:800:200C:417A`
-- * `FF01::101`
-- * `::1`
-- * `::`
--
ipv6ParserCompressed :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
                     => Parser input IPv6
ipv6ParserCompressed :: Parser input IPv6
ipv6ParserCompressed = do
    [Word16]
bs1 <- Condition -> Parser input Word16 -> Parser input [Word16]
forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between (And -> Condition) -> And -> Condition
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` Word
8) (Parser input Word16 -> Parser input [Word16])
-> Parser input Word16 -> Parser input [Word16]
forall a b. (a -> b) -> a -> b
$ Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 Parser input Word16 -> Parser input () -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Bool -> Parser input () -> Parser input ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Word16] -> Bool
forall c. Collection c => c -> Bool
null [Word16]
bs1) Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    let (CountOf Int
bs1Len) = [Word16] -> CountOf (Element [Word16])
forall c. Collection c => c -> CountOf (Element c)
length [Word16]
bs1
    [Word16]
bs2 <- Condition -> Parser input Word16 -> Parser input [Word16]
forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between (And -> Condition) -> And -> Condition
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
8 Int -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
- Int
bs1Len)) (Parser input Word16 -> Parser input [Word16])
-> Parser input Word16 -> Parser input [Word16]
forall a b. (a -> b) -> a -> b
$
              Parser input ()
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon Parser input () -> Parser input Word16 -> Parser input Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser input Word16
forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16
    [Word16]
is <- CountOf Word16 -> [Word16] -> [Word16] -> Parser input [Word16]
forall a (m :: * -> *).
(Integral a, Monad m) =>
CountOf a -> [a] -> [a] -> m [a]
format CountOf Word16
8 [Word16]
bs1 [Word16]
bs2
    case [Word16]
is of
        [Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6,Word16
i7,Word16
i8] -> IPv6 -> Parser input IPv6
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv6 -> Parser input IPv6) -> IPv6 -> Parser input IPv6
forall a b. (a -> b) -> a -> b
$ (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTuple (Word16
i1,Word16
i2,Word16
i3,Word16
i4,Word16
i5,Word16
i6,Word16
i7,Word16
i8)
        [Word16]
_ -> String -> Parser input IPv6
forall a. HasCallStack => String -> a
error String
"internal error: format should return 8"

format :: (Integral a, Monad m) => CountOf a -> [a] -> [a] -> m [a]
format :: CountOf a -> [a] -> [a] -> m [a]
format CountOf a
sz [a]
bs1 [a]
bs2
    | CountOf a
sz CountOf a -> CountOf a -> Bool
forall a. Ord a => a -> a -> Bool
<= ([a] -> CountOf (Element [a])
forall c. Collection c => c -> CountOf (Element c)
length [a]
bs1 CountOf a -> CountOf a -> CountOf a
forall a. Additive a => a -> a -> a
+ [a] -> CountOf (Element [a])
forall c. Collection c => c -> CountOf (Element c)
length [a]
bs2) = String -> m [a]
forall a. HasCallStack => String -> a
error String
"invalid compressed IPv6 addressed"
    | Bool
otherwise = do
        let len :: CountOf a
len = CountOf a
sz CountOf a -> CountOf a -> CountOf a
forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` ([a] -> CountOf (Element [a])
forall c. Collection c => c -> CountOf (Element c)
length [a]
bs1 CountOf a -> CountOf a -> CountOf a
forall a. Additive a => a -> a -> a
+ [a] -> CountOf (Element [a])
forall c. Collection c => c -> CountOf (Element c)
length [a]
bs2)
        [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a]
bs1 [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> CountOf (Element [a]) -> Element [a] -> [a]
forall c. Sequential c => CountOf (Element c) -> Element c -> c
replicate CountOf a
CountOf (Element [a])
len Element [a]
0 [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
bs2

skipColon :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
          => Parser input ()
skipColon :: Parser input ()
skipColon = Element input -> Parser input ()
forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
Element input
':'
skipDot :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
        => Parser input ()
skipDot :: Parser input ()
skipDot = Element input -> Parser input ()
forall input.
(ParserSource input, Eq (Element input),
 Element input ~ Element (Chunk input)) =>
Element input -> Parser input ()
element Char
Element input
'.'
takeAWord8 :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
           => Parser input Word16
takeAWord8 :: Parser input Word16
takeAWord8 = String -> Word16
forall a. Read a => String -> a
read (String -> Word16) -> Parser input String -> Parser input Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Condition -> Parser input Char -> Parser input String
forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between (And -> Condition) -> And -> Condition
forall a b. (a -> b) -> a -> b
$ Word
1 Word -> Word -> And
`And` Word
4) ((Element input -> Bool) -> Parser input (Element input)
forall input.
ParserSource input =>
(Element input -> Bool) -> Parser input (Element input)
satisfy_ Char -> Bool
Element input -> Bool
isDigit)
takeAWord16 :: (ParserSource input, Element input ~ Char, Element (Chunk input) ~ Char)
            => Parser input Word16
takeAWord16 :: Parser input Word16
takeAWord16 = do
    String
l <- Condition -> Parser input Char -> Parser input String
forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between (And -> Condition) -> And -> Condition
forall a b. (a -> b) -> a -> b
$ Word
1 Word -> Word -> And
`And` Word
4) ((Element input -> Bool) -> Parser input (Element input)
forall input.
ParserSource input =>
(Element input -> Bool) -> Parser input (Element input)
satisfy_ Char -> Bool
Element input -> Bool
isHexDigit)
    let lhs :: [(Word16, String)]
lhs = ReadS Word16
forall a. (Eq a, Num a) => ReadS a
readHex String
l
     in case [(Word16, String)]
lhs of
          [(Word16
w, [])] -> Word16 -> Parser input Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
w
          [(Word16, String)]
_ -> String -> Parser input Word16
forall a. HasCallStack => String -> a
error String
"internal error: can't fall here"