{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module Foundation.Network.IPv6
( IPv6
, any, loopback
, fromString, toString
, fromTuple, toTuple
, 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
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)
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)
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)
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
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 )
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
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
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)
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"
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"