{-# 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
(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)
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 = 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
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 )
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
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
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)
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"
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"