-- |
-- 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
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
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
Ord, Typeable)
instance NormalForm IPv6 where
    toNormalForm :: IPv6 -> ()
toNormalForm !IPv6
_ = ()
instance Hashable IPv6 where
    hashMix :: forall st. Hasher st => IPv6 -> st -> st
hashMix (IPv6 Word64
w1 Word64
w2) = forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix Word64
w1 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a st. (Hashable a, Hasher st) => a -> st -> st
hashMix Word64
w2
instance Show IPv6 where
    show :: IPv6 -> [Char]
show = IPv6 -> [Char]
toLString
instance IsString IPv6 where
    fromString :: [Char] -> IPv6
fromString = [Char] -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (   (,,,,,,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
0)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
1)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
2)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
3)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
4)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
5)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StorableFixed a => Ptr a -> Offset a -> IO a
peekOff Ptr (BE Word16)
ptr' Offset (BE Word16)
6)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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' = 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 forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
0 (forall a. ByteSwap a => a -> BE a
toBE Word16
i1)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
1 (forall a. ByteSwap a => a -> BE a
toBE Word16
i2)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
2 (forall a. ByteSwap a => a -> BE a
toBE Word16
i3)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
3 (forall a. ByteSwap a => a -> BE a
toBE Word16
i4)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
4 (forall a. ByteSwap a => a -> BE a
toBE Word16
i5)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
5 (forall a. ByteSwap a => a -> BE a
toBE Word16
i6)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
6 (forall a. ByteSwap a => a -> BE a
toBE Word16
i7)
         forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. StorableFixed a => Ptr a -> Offset a -> a -> IO ()
pokeOff Ptr (BE Word16)
ptr' Offset (BE Word16)
7 (forall a. ByteSwap a => a -> BE a
toBE Word16
i8)
      where
        ptr' :: Ptr (BE Word16)
        ptr' :: Ptr (BE Word16)
ptr' = forall a b. Ptr a -> Ptr b
castPtr Ptr IPv6
ptr
instance StorableFixed IPv6 where
    size :: forall (proxy :: * -> *). proxy IPv6 -> CountOf Word8
size      proxy IPv6
_ = (forall a (proxy :: * -> *).
StorableFixed a =>
proxy a -> CountOf Word8
size      (forall {k} (t :: k). Proxy t
Proxy :: Proxy Word64)) forall a n. (Additive a, IsNatural n) => n -> a -> a
`scale` CountOf Word8
2
    alignment :: forall (proxy :: * -> *). proxy IPv6 -> CountOf Word8
alignment proxy IPv6
_ = forall a (proxy :: * -> *).
StorableFixed a =>
proxy a -> CountOf Word8
alignment (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 = forall l. IsList l => [Item l] -> l
fromList forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv6 -> [Char]
toLString

toLString :: IPv6 -> [Char]
toLString :: IPv6 -> [Char]
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 forall c.
(Sequential c, Monoid (Item c)) =>
Element c -> c -> Element c
intercalate [Char]
":" forall a b. (a -> b) -> a -> b
$ Word16 -> [Char]
showHex4 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 -> [Char]
showHex4 = Word16 -> [Char]
showHex

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

fromLString :: [Char] -> IPv6
fromLString :: [Char] -> IPv6
fromLString = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall input a.
(ParserSource input, Monoid (Chunk input)) =>
Parser input a -> input -> Either (ParseError input) a
parseOnly 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
    hi, low :: Word64
    hi :: Word64
hi =    (Word16 -> Word64
f Word16
i1 forall a. Bits a => a -> Int -> a
.<<. Int
48)
        forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i2 forall a. Bits a => a -> Int -> a
.<<. Int
32)
        forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i3 forall a. Bits a => a -> Int -> a
.<<. Int
16)
        forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i4        )
    low :: Word64
low =   (Word16 -> Word64
f Word16
i5 forall a. Bits a => a -> Int -> a
.<<. Int
48)
        forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i6 forall a. Bits a => a -> Int -> a
.<<. Int
32)
        forall a. Bits a => a -> a -> a
.|. (Word16 -> Word64
f Word16
i7 forall a. Bits a => a -> Int -> a
.<<. Int
16)
        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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
    w1, w2, w3, w4, w5, w6, w7, w8 :: Word64
    w1 :: Word64
w1 = Word64
hi  forall a. Bits a => a -> Int -> a
.>>. Int
48
    w2 :: Word64
w2 = Word64
hi  forall a. Bits a => a -> Int -> a
.>>. Int
32
    w3 :: Word64
w3 = Word64
hi  forall a. Bits a => a -> Int -> a
.>>. Int
16
    w4 :: Word64
w4 = Word64
hi
    w5 :: Word64
w5 = Word64
low forall a. Bits a => a -> Int -> a
.>>. Int
48
    w6 :: Word64
w6 = Word64
low forall a. Bits a => a -> Int -> a
.>>. Int
32
    w7 :: Word64
w7 = Word64
low 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 :: forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6Parser =  forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserPreferred
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserIpv4Embedded
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 :: forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserPreferred = do
    Word16
i1 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i2 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i3 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i4 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i5 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i6 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i7 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Word16
i8 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserIpv4Embedded = do
    [Word16]
bs1 <- forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` Word
6 ) forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    let (CountOf Int
lenBs1) = forall c. Collection c => c -> CountOf (Element c)
length [Word16]
bs1
    [Word16]
bs2 <- forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
6 forall a. Subtractive a => a -> a -> Difference a
- Int
lenBs1)) forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    [Word16]
is <- 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 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipDot
            Word16
m2 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipDot
            Word16
m3 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipDot
            Word16
m4 <- forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord8
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. Word16
m2
                               , Word16
m3 forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. Word16
m4
                               )
        [Word16]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input IPv6
ipv6ParserCompressed = do
    [Word16]
bs1 <- forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` Word
8) forall a b. (a -> b) -> a -> b
$ forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall c. Collection c => c -> Bool
null [Word16]
bs1) forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon
    let (CountOf Int
bs1Len) = forall c. Collection c => c -> CountOf (Element c)
length [Word16]
bs1
    [Word16]
bs2 <- forall input a.
ParserSource input =>
Condition -> Parser input a -> Parser input [a]
repeat (And -> Condition
Between forall a b. (a -> b) -> a -> b
$ Word
0 Word -> Word -> And
`And` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
8 forall a. Subtractive a => a -> a -> Difference a
- Int
bs1Len)) forall a b. (a -> b) -> a -> b
$
              forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input ()
skipColon forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall input.
(ParserSource input, Element input ~ Char,
 Element (Chunk input) ~ Char) =>
Parser input Word16
takeAWord16
    [Word16]
is <- 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] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"internal error: format should return 8"

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

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