{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UnboxedTuples #-}

{-| This module provides the IPv6 data type and functions for working
    with it.
-}
module Net.IPv6
  ( -- * Convert
    ipv6
  , fromOctets
  , fromWord16s
  , fromWord32s
  , fromTupleWord16s
  , fromTupleWord32s
  , toWord16s
  , toWord32s
    -- * Special IP Addresses
  , any
  , loopback
  , localhost
    -- * Textual Conversion
    -- ** Text
  , encode
  , encodeShort
  , decode
  , decodeShort
  , parser
    -- * UTF-8 Bytes
  , parserUtf8Bytes
  , decodeUtf8Bytes
  , boundedBuilderUtf8
    -- ** Printing
  , print
    -- * IPv6 Ranges
    -- ** Range functions
  , range
  , fromBounds
  , normalize
  , contains
  , member
  , lowerInclusive
  , upperInclusive
    -- ** Textual Conversion
    -- *** Text
  , encodeRange
  , decodeRange
  , parserRange
  , printRange
    -- ** UTF-8 Bytes
  , parserRangeUtf8Bytes
  , parserRangeUtf8BytesLenient
    -- * Types
  , IPv6(..)
  , IPv6Range(..)
  ) where

import Prelude hiding (any, print)

import Net.IPv4 (IPv4(..))

import Control.Applicative
import Control.DeepSeq (NFData)
import Control.Monad (mzero)
import Control.Monad.ST (ST)
import Data.Bits
import Data.Char (chr)
import Data.Data (Data)
import Data.Ix (Ix)
import Data.Hashable (Hashable,hashWithSalt)
import Data.List (intercalate, group)
import Data.Primitive (MutablePrimArray)
import Data.Primitive.Types (Prim)
import Data.Text (Text)
import Data.Text.Short (ShortText)
import Data.WideWord.Word128 (Word128(..), zeroWord128)
import Data.Word
import Foreign.Storable (Storable)
import GHC.Exts (Int#,Word#,Int(I#))
import GHC.Generics (Generic)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec (prec,step)
import Text.Read (Read(..),Lexeme(Ident),lexP,parens)

import qualified Arithmetic.Lte as Lte
import qualified Arithmetic.Nat as Nat
import qualified Data.Aeson as Aeson
import qualified Data.Attoparsec.Text as AT
import qualified Data.Attoparsec.Text as Atto
import qualified Data.Bytes.Builder.Bounded as BB
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Data.ByteString.Short.Internal as BSS
import qualified Data.Primitive as PM
import qualified Data.Text as Text
import qualified Data.Text.IO as TIO
import qualified Data.Text.Short.Unsafe as TS
import qualified Data.Text.Short as TS
import qualified GHC.Word.Compat as Compat
import qualified Net.IPv4 as IPv4

-- $setup
--
-- These are here to get doctest work.
--
-- >>> import qualified Prelude as P
-- >>> import qualified Data.Text.IO as T
-- >>> import qualified Data.Text as Text
-- >>> import qualified Data.Attoparsec.Text as Atto
-- >>> import qualified Data.Bytes.Text.Ascii as Ascii
-- >>> import Test.QuickCheck (Arbitrary(..))
-- >>> instance Arbitrary Word128 where { arbitrary = Word128 <$> arbitrary <*> arbitrary }
-- >>> instance Arbitrary IPv6 where { arbitrary = IPv6 <$> arbitrary }
-- >>> instance Arbitrary IPv6.IPv6Range where { arbitrary = IPv6.IPv6Range <$> arbitrary <*> arbitrary }
--

-- | A 128-bit Internet Protocol version 6 address.
newtype IPv6 = IPv6 { IPv6 -> Word128
getIPv6 :: Word128 }
  deriving (IPv6
forall a. a -> a -> Bounded a
maxBound :: IPv6
$cmaxBound :: IPv6
minBound :: IPv6
$cminBound :: IPv6
Bounded,Int -> IPv6
IPv6 -> Int
IPv6 -> [IPv6]
IPv6 -> IPv6
IPv6 -> IPv6 -> [IPv6]
IPv6 -> IPv6 -> IPv6 -> [IPv6]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IPv6 -> IPv6 -> IPv6 -> [IPv6]
$cenumFromThenTo :: IPv6 -> IPv6 -> IPv6 -> [IPv6]
enumFromTo :: IPv6 -> IPv6 -> [IPv6]
$cenumFromTo :: IPv6 -> IPv6 -> [IPv6]
enumFromThen :: IPv6 -> IPv6 -> [IPv6]
$cenumFromThen :: IPv6 -> IPv6 -> [IPv6]
enumFrom :: IPv6 -> [IPv6]
$cenumFrom :: IPv6 -> [IPv6]
fromEnum :: IPv6 -> Int
$cfromEnum :: IPv6 -> Int
toEnum :: Int -> IPv6
$ctoEnum :: Int -> IPv6
pred :: IPv6 -> IPv6
$cpred :: IPv6 -> IPv6
succ :: IPv6 -> IPv6
$csucc :: IPv6 -> IPv6
Enum,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,Ptr IPv6 -> IO IPv6
Ptr IPv6 -> Int -> IO IPv6
Ptr IPv6 -> Int -> IPv6 -> IO ()
Ptr IPv6 -> IPv6 -> IO ()
IPv6 -> Int
forall b. Ptr b -> Int -> IO IPv6
forall b. Ptr b -> Int -> IPv6 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr IPv6 -> IPv6 -> IO ()
$cpoke :: Ptr IPv6 -> IPv6 -> IO ()
peek :: Ptr IPv6 -> IO IPv6
$cpeek :: Ptr IPv6 -> IO IPv6
pokeByteOff :: forall b. Ptr b -> Int -> IPv6 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> IPv6 -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO IPv6
$cpeekByteOff :: forall b. Ptr b -> Int -> IO IPv6
pokeElemOff :: Ptr IPv6 -> Int -> IPv6 -> IO ()
$cpokeElemOff :: Ptr IPv6 -> Int -> IPv6 -> IO ()
peekElemOff :: Ptr IPv6 -> Int -> IO IPv6
$cpeekElemOff :: Ptr IPv6 -> Int -> IO IPv6
alignment :: IPv6 -> Int
$calignment :: IPv6 -> Int
sizeOf :: IPv6 -> Int
$csizeOf :: IPv6 -> Int
Storable,Eq IPv6
IPv6
Int -> IPv6
IPv6 -> Bool
IPv6 -> Int
IPv6 -> Maybe Int
IPv6 -> IPv6
IPv6 -> Int -> Bool
IPv6 -> Int -> IPv6
IPv6 -> IPv6 -> IPv6
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: IPv6 -> Int
$cpopCount :: IPv6 -> Int
rotateR :: IPv6 -> Int -> IPv6
$crotateR :: IPv6 -> Int -> IPv6
rotateL :: IPv6 -> Int -> IPv6
$crotateL :: IPv6 -> Int -> IPv6
unsafeShiftR :: IPv6 -> Int -> IPv6
$cunsafeShiftR :: IPv6 -> Int -> IPv6
shiftR :: IPv6 -> Int -> IPv6
$cshiftR :: IPv6 -> Int -> IPv6
unsafeShiftL :: IPv6 -> Int -> IPv6
$cunsafeShiftL :: IPv6 -> Int -> IPv6
shiftL :: IPv6 -> Int -> IPv6
$cshiftL :: IPv6 -> Int -> IPv6
isSigned :: IPv6 -> Bool
$cisSigned :: IPv6 -> Bool
bitSize :: IPv6 -> Int
$cbitSize :: IPv6 -> Int
bitSizeMaybe :: IPv6 -> Maybe Int
$cbitSizeMaybe :: IPv6 -> Maybe Int
testBit :: IPv6 -> Int -> Bool
$ctestBit :: IPv6 -> Int -> Bool
complementBit :: IPv6 -> Int -> IPv6
$ccomplementBit :: IPv6 -> Int -> IPv6
clearBit :: IPv6 -> Int -> IPv6
$cclearBit :: IPv6 -> Int -> IPv6
setBit :: IPv6 -> Int -> IPv6
$csetBit :: IPv6 -> Int -> IPv6
bit :: Int -> IPv6
$cbit :: Int -> IPv6
zeroBits :: IPv6
$czeroBits :: IPv6
rotate :: IPv6 -> Int -> IPv6
$crotate :: IPv6 -> Int -> IPv6
shift :: IPv6 -> Int -> IPv6
$cshift :: IPv6 -> Int -> IPv6
complement :: IPv6 -> IPv6
$ccomplement :: IPv6 -> IPv6
xor :: IPv6 -> IPv6 -> IPv6
$cxor :: IPv6 -> IPv6 -> IPv6
.|. :: IPv6 -> IPv6 -> IPv6
$c.|. :: IPv6 -> IPv6 -> IPv6
.&. :: IPv6 -> IPv6 -> IPv6
$c.&. :: IPv6 -> IPv6 -> IPv6
Bits,Bits IPv6
IPv6 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: IPv6 -> Int
$ccountTrailingZeros :: IPv6 -> Int
countLeadingZeros :: IPv6 -> Int
$ccountLeadingZeros :: IPv6 -> Int
finiteBitSize :: IPv6 -> Int
$cfiniteBitSize :: IPv6 -> Int
FiniteBits,IPv6 -> ()
forall a. (a -> ()) -> NFData a
rnf :: IPv6 -> ()
$crnf :: IPv6 -> ()
NFData,Addr# -> Int# -> IPv6
ByteArray# -> Int# -> IPv6
IPv6 -> Int#
forall s. Addr# -> Int# -> Int# -> IPv6 -> State# s -> State# s
forall s. Addr# -> Int# -> State# s -> (# State# s, IPv6 #)
forall s. Addr# -> Int# -> IPv6 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> Int# -> IPv6 -> State# s -> State# s
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, IPv6 #)
forall s.
MutableByteArray# s -> Int# -> IPv6 -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: forall s. Addr# -> Int# -> Int# -> IPv6 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> IPv6 -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> IPv6 -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> IPv6 -> State# s -> State# s
readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, IPv6 #)
$creadOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, IPv6 #)
indexOffAddr# :: Addr# -> Int# -> IPv6
$cindexOffAddr# :: Addr# -> Int# -> IPv6
setByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> IPv6 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> IPv6 -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s -> Int# -> IPv6 -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> IPv6 -> State# s -> State# s
readByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, IPv6 #)
$creadByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, IPv6 #)
indexByteArray# :: ByteArray# -> Int# -> IPv6
$cindexByteArray# :: ByteArray# -> Int# -> IPv6
alignment# :: IPv6 -> Int#
$calignment# :: IPv6 -> Int#
sizeOf# :: IPv6 -> Int#
$csizeOf# :: IPv6 -> Int#
Prim,Ord IPv6
(IPv6, IPv6) -> Int
(IPv6, IPv6) -> [IPv6]
(IPv6, IPv6) -> IPv6 -> Bool
(IPv6, IPv6) -> IPv6 -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (IPv6, IPv6) -> Int
$cunsafeRangeSize :: (IPv6, IPv6) -> Int
rangeSize :: (IPv6, IPv6) -> Int
$crangeSize :: (IPv6, IPv6) -> Int
inRange :: (IPv6, IPv6) -> IPv6 -> Bool
$cinRange :: (IPv6, IPv6) -> IPv6 -> Bool
unsafeIndex :: (IPv6, IPv6) -> IPv6 -> Int
$cunsafeIndex :: (IPv6, IPv6) -> IPv6 -> Int
index :: (IPv6, IPv6) -> IPv6 -> Int
$cindex :: (IPv6, IPv6) -> IPv6 -> Int
range :: (IPv6, IPv6) -> [IPv6]
$crange :: (IPv6, IPv6) -> [IPv6]
Ix,Typeable IPv6
IPv6 -> DataType
IPv6 -> Constr
(forall b. Data b => b -> b) -> IPv6 -> IPv6
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u
forall u. (forall d. Data d => d -> u) -> IPv6 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6 -> c IPv6
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6 -> m IPv6
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv6 -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> IPv6 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv6 -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IPv6 -> r
gmapT :: (forall b. Data b => b -> b) -> IPv6 -> IPv6
$cgmapT :: (forall b. Data b => b -> b) -> IPv6 -> IPv6
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6)
dataTypeOf :: IPv6 -> DataType
$cdataTypeOf :: IPv6 -> DataType
toConstr :: IPv6 -> Constr
$ctoConstr :: IPv6 -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6 -> c IPv6
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6 -> c IPv6
Data,forall x. Rep IPv6 x -> IPv6
forall x. IPv6 -> Rep IPv6 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IPv6 x -> IPv6
$cfrom :: forall x. IPv6 -> Rep IPv6 x
Generic)

instance Hashable IPv6 where
  hashWithSalt :: Int -> IPv6 -> Int
hashWithSalt Int
s (IPv6 (Word128 Word64
a Word64
b)) = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Word64
a) Word64
b

instance Show IPv6 where
  showsPrec :: Int -> IPv6 -> ShowS
showsPrec Int
p IPv6
addr = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ipv6 "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
f
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
g
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
showHexWord16 Word16
h
    where
    (Word16
a,Word16
b,Word16
c,Word16
d,Word16
e,Word16
f,Word16
g,Word16
h) = IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toWord16s IPv6
addr

-- | Print an 'IPv6' using the textual encoding.
print :: IPv6 -> IO ()
print :: IPv6 -> IO ()
print = Text -> IO ()
TIO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> Text
encode

-- | Decode 'ShortText' as an 'IPv6' address.
--
--   >>> decodeShort "ffff::2:b"
--   Just (ipv6 0xffff 0x0000 0x0000 0x0000 0x0000 0x0000 0x0002 0x000b)
decodeShort :: ShortText -> Maybe IPv6
decodeShort :: ShortText -> Maybe IPv6
decodeShort ShortText
t = Bytes -> Maybe IPv6
decodeUtf8Bytes (ByteArray -> Bytes
Bytes.fromByteArray ByteArray
b)
  where b :: ByteArray
b = ShortByteString -> ByteArray
shortByteStringToByteArray (ShortText -> ShortByteString
TS.toShortByteString ShortText
t)

shortByteStringToByteArray :: BSS.ShortByteString -> PM.ByteArray
shortByteStringToByteArray :: ShortByteString -> ByteArray
shortByteStringToByteArray (BSS.SBS ByteArray#
x) = ByteArray# -> ByteArray
PM.ByteArray ByteArray#
x

showHexWord16 :: Word16 -> ShowS
showHexWord16 :: Word16 -> ShowS
showHexWord16 Word16
w =
    String -> ShowS
showString String
"0x"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar (Word -> Char
nibbleToHex (forall a. Bits a => a -> Int -> a
unsafeShiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w) Int
12))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar (Word -> Char
nibbleToHex ((forall a. Bits a => a -> Int -> a
unsafeShiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w) Int
8) forall a. Bits a => a -> a -> a
.&. Word
0xF))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar (Word -> Char
nibbleToHex ((forall a. Bits a => a -> Int -> a
unsafeShiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w) Int
4) forall a. Bits a => a -> a -> a
.&. Word
0xF))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar (Word -> Char
nibbleToHex ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w) forall a. Bits a => a -> a -> a
.&. Word
0xF))

-- invariant: argument must be less than 16
nibbleToHex :: Word -> Char
nibbleToHex :: Word -> Char
nibbleToHex Word
w
  | Word
w forall a. Ord a => a -> a -> Bool
< Word
10 = Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
w forall a. Num a => a -> a -> a
+ Word
48))
  | Bool
otherwise = Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
w forall a. Num a => a -> a -> a
+ Word
87))

instance Read IPv6 where
  readPrec :: ReadPrec IPv6
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    Ident String
"ipv6" <- ReadPrec Lexeme
lexP
    Word16
a <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
b <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
c <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
d <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
e <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
f <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
g <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word16
h <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
fromWord16s Word16
a Word16
b Word16
c Word16
d Word16
e Word16
f Word16
g Word16
h)

instance Aeson.ToJSON IPv6 where
  toJSON :: IPv6 -> Value
toJSON = Text -> Value
Aeson.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> Text
encode

instance Aeson.FromJSON IPv6 where
  parseJSON :: Value -> Parser IPv6
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"IPv6" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Maybe IPv6
decode Text
t of
    Maybe IPv6
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid IPv6 address"
    Just IPv6
i  -> forall (m :: * -> *) a. Monad m => a -> m a
return IPv6
i

rightToMaybe :: Either a b -> Maybe b
rightToMaybe :: forall a b. Either a b -> Maybe b
rightToMaybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just

-- | This could be useful for the rare occasion
--   in which one could construct an 'IPv6' from
--   octets.
--
--   Note that while @Net.IPv4.'Net.IPv4.fromOctets' = Net.IPv4.'Net.IPv4.ipv4'@,
--   @Net.IPv6.fromOctets /= Net.IPv6.ipv6@. While this should be obvious
--   from their types, it is worth mentioning since the similarity in naming
--   might be confusing.
fromOctets ::
     Word8 -> Word8 -> Word8 -> Word8
  -> Word8 -> Word8 -> Word8 -> Word8
  -> Word8 -> Word8 -> Word8 -> Word8
  -> Word8 -> Word8 -> Word8 -> Word8
  -> IPv6
fromOctets :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> IPv6
fromOctets Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f Word8
g Word8
h Word8
i Word8
j Word8
k Word8
l Word8
m Word8
n Word8
o Word8
p =
  Word128 -> IPv6
IPv6 forall a b. (a -> b) -> a -> b
$ Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
fromOctetsWord128
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
f) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
j) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
k) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
l)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
o) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
p)

fromOctetsWord128 ::
     Word128 -> Word128 -> Word128 -> Word128
  -> Word128 -> Word128 -> Word128 -> Word128
  -> Word128 -> Word128 -> Word128 -> Word128
  -> Word128 -> Word128 -> Word128 -> Word128
  -> Word128
fromOctetsWord128 :: Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
fromOctetsWord128 Word128
a Word128
b Word128
c Word128
d Word128
e Word128
f Word128
g Word128
h Word128
i Word128
j Word128
k Word128
l Word128
m Word128
n Word128
o Word128
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral
    ( forall a. Bits a => a -> Int -> a
shiftL Word128
a Int
120
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
b Int
112
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
c Int
104
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
d Int
96
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
e Int
88
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
f Int
80
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
g Int
72
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
h Int
64
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
i Int
56
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
j Int
48
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
k Int
40
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
l Int
32
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
m Int
24
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
n Int
16
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
o Int
8
  forall a. Bits a => a -> a -> a
.|. Word128
p
    )

-- | Create an 'IPv6' address from the eight 16-bit fragments that make
--   it up. This closely resembles the standard IPv6 notation, so
--   is used for the 'Show' instance. Note that this lacks the formatting
--   feature for suppress zeroes in an 'IPv6' address, but it should be
--   readable enough for hacking in GHCi.
--
--   >>> let addr = ipv6 0x3124 0x0 0x0 0xDEAD 0xCAFE 0xFF 0xFE00 0x1
--   >>> addr
--   ipv6 0x3124 0x0000 0x0000 0xdead 0xcafe 0x00ff 0xfe00 0x0001
--   >>> T.putStrLn (encode addr)
--   3124::dead:cafe:ff:fe00:1
ipv6 ::
     Word16 -> Word16 -> Word16 -> Word16
  -> Word16 -> Word16 -> Word16 -> Word16
  -> IPv6
ipv6 :: Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
ipv6 = Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
fromWord16s

-- | An alias for the 'ipv6' smart constructor.
fromWord16s ::
     Word16 -> Word16 -> Word16 -> Word16
  -> Word16 -> Word16 -> Word16 -> Word16
  -> IPv6
fromWord16s :: Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
fromWord16s Word16
a Word16
b Word16
c Word16
d Word16
e Word16
f Word16
g Word16
h =
  Word128 -> IPv6
IPv6 forall a b. (a -> b) -> a -> b
$ Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
fromWord16sWord128
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
c) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
d)
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
f) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
g) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
h)

fromWord16sWord128 ::
     Word128 -> Word128 -> Word128 -> Word128
  -> Word128 -> Word128 -> Word128 -> Word128
  -> Word128
fromWord16sWord128 :: Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
-> Word128
fromWord16sWord128 Word128
a Word128
b Word128
c Word128
d Word128
e Word128
f Word128
g Word128
h = forall a b. (Integral a, Num b) => a -> b
fromIntegral
    ( forall a. Bits a => a -> Int -> a
shiftL Word128
a Int
112
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
b Int
96
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
c Int
80
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
d Int
64
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
e Int
48
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
f Int
32
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
g Int
16
  forall a. Bits a => a -> a -> a
.|. Word128
h
    )

-- | Convert an 'IPv6' to eight 16-bit words.
toWord16s :: IPv6 -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)
toWord16s :: IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toWord16s (IPv6 (Word128 Word64
a Word64
b)) =
  -- Note: implementing this as 2 Word64 shifts with 'unsafeShiftR'
  -- is up to 40% faster than using 128-bit shifts on a Word128 value.
  ( forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
a Int
48)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
a Int
32)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
a Int
16)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
b Int
48)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
b Int
32)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
b Int
16)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b
  )

-- | Uncurried variant of 'fromWord16s'.
fromTupleWord16s :: (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16) -> IPv6
fromTupleWord16s :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> IPv6
fromTupleWord16s (Word16
a,Word16
b,Word16
c,Word16
d,Word16
e,Word16
f,Word16
g,Word16
h) = Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
fromWord16s Word16
a Word16
b Word16
c Word16
d Word16
e Word16
f Word16
g Word16
h

-- | Build an 'IPv6' from four 32-bit words. The leftmost argument
--   is the high word and the rightword is the low word.
fromWord32s :: Word32 -> Word32 -> Word32 -> Word32 -> IPv6
fromWord32s :: Word32 -> Word32 -> Word32 -> Word32 -> IPv6
fromWord32s Word32
a Word32
b Word32
c Word32
d =
  Word128 -> IPv6
IPv6 forall a b. (a -> b) -> a -> b
$ Word128 -> Word128 -> Word128 -> Word128 -> Word128
fromWord32sWord128
    (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
b) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
c) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
d)

fromWord32sWord128 ::
     Word128 -> Word128 -> Word128 -> Word128
  -> Word128
fromWord32sWord128 :: Word128 -> Word128 -> Word128 -> Word128 -> Word128
fromWord32sWord128 Word128
a Word128
b Word128
c Word128
d = forall a b. (Integral a, Num b) => a -> b
fromIntegral
    ( forall a. Bits a => a -> Int -> a
shiftL Word128
a Int
96
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
b Int
64
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word128
c Int
32
  forall a. Bits a => a -> a -> a
.|. Word128
d
    )

-- | Uncurried variant of 'fromWord32s'.
fromTupleWord32s :: (Word32,Word32,Word32,Word32) -> IPv6
fromTupleWord32s :: (Word32, Word32, Word32, Word32) -> IPv6
fromTupleWord32s (Word32
a,Word32
b,Word32
c,Word32
d) = Word32 -> Word32 -> Word32 -> Word32 -> IPv6
fromWord32s Word32
a Word32
b Word32
c Word32
d

-- | Convert an 'IPv6' to four 32-bit words.
toWord32s :: IPv6 -> (Word32,Word32,Word32,Word32)
toWord32s :: IPv6 -> (Word32, Word32, Word32, Word32)
toWord32s (IPv6 (Word128 Word64
a Word64
b)) =
  -- Note: implementing this as 2 Word64 shifts with 'unsafeShiftR'
  -- is about 10% faster than using 128-bit shifts on a Word128 value.
  ( forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
a Int
32)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
b Int
32)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b
  )

-- | The local loopback IP address.
--
--   >>> IPv6.loopback
--   ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001
loopback :: IPv6
loopback :: IPv6
loopback = Word128 -> IPv6
IPv6 (Word64 -> Word64 -> Word128
Word128 Word64
0 Word64
1)

-- | A useful alias for 'loopback'.
--
--   >>> IPv6.localhost
--   ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001
localhost :: IPv6
localhost :: IPv6
localhost = IPv6
loopback

-- | The IP address representing any host.
--
--   >>> IPv6.any
--   ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000
any :: IPv6
any :: IPv6
any = Word128 -> IPv6
IPv6 Word128
zeroWord128

-- | Encodes the 'IPv6' address using zero-compression on the leftmost longest
-- string of zeroes in the address.
-- Per <https://tools.ietf.org/html/rfc5952#section-5 RFC 5952 Section 5>,
-- this uses mixed notation when encoding an IPv4-mapped IPv6 address:
--
-- >>> T.putStrLn $ IPv6.encode $ IPv6.fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234
-- dead:beef::1234
-- >>> T.putStrLn $ IPv6.encode $ IPv6.fromWord16s 0x0 0x0 0x0 0x0 0x0 0xFFFF 0x6437 0xA5B4
-- ::ffff:100.55.165.180
-- >>> T.putStrLn $ IPv6.encode $ IPv6.fromWord16s 0x0 0x0 0x0 0x0 0x0 0x0 0x0 0x0
-- ::
--
-- Per <https://tools.ietf.org/html/rfc5952#section-4.2.2 Section 4.2.2> of the
-- same RFC, this does not use @::@ to shorten a single 16-bit 0 field. Only
-- runs of multiple 0 fields are considered.
encode :: IPv6 -> Text
encode :: IPv6 -> Text
encode !IPv6
ip =
  -- TODO: This implementation, while correct, is not particularly efficient.
  -- It uses string all over the place.
  if IPv6 -> Bool
isIPv4Mapped IPv6
ip
    -- This representation is RECOMMENDED by https://tools.ietf.org/html/rfc5952#section-5
    then
      String -> Text
Text.pack String
"::ffff:"
      forall a. Monoid a => a -> a -> a
`mappend`
      IPv4 -> Text
IPv4.encode (Word32 -> IPv4
IPv4.IPv4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w7 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
16 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w8))
    else forall {a}. (Integral a, Show a) => [a] -> Text
toText [Word16
w1, Word16
w2, Word16
w3, Word16
w4, Word16
w5, Word16
w6, Word16
w7, Word16
w8]
  where
  (Word16
w1, Word16
w2, Word16
w3, Word16
w4, Word16
w5, Word16
w6, Word16
w7, Word16
w8) = IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toWord16s IPv6
ip
  toText :: [a] -> Text
toText [a]
ws = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
":"
      forall a b. (a -> b) -> a -> b
$ forall {a}.
(Integral a, Show a) =>
Int -> Int -> [(a, Int)] -> [String]
expand Int
0 (if Int
longestZ forall a. Ord a => a -> a -> Bool
> Int
1 then Int
longestZ else Int
0) [(a, Int)]
grouped
    where
    expand :: Int -> Int -> [(a, Int)] -> [String]
expand !Int
_ Int
8 ![(a, Int)]
_ = [String
"::"]
    expand !Int
_ !Int
_ [] = []
    expand !Int
i !Int
longest ((a
x, Int
len):[(a, Int)]
wsNext)
        -- zero-compressed group:
        | a
x forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& Int
len forall a. Eq a => a -> a -> Bool
== Int
longest =
            -- first and last need an extra colon since there's nothing
            -- to concat against
            (if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| (Int
iforall a. Num a => a -> a -> a
+Int
len) forall a. Eq a => a -> a -> Bool
== Int
8 then String
":" else String
"")
            forall a. a -> [a] -> [a]
: Int -> Int -> [(a, Int)] -> [String]
expand (Int
iforall a. Num a => a -> a -> a
+Int
len) Int
0 [(a, Int)]
wsNext
        -- normal group:
        | Bool
otherwise = forall a. Int -> a -> [a]
replicate Int
len (forall a. (Integral a, Show a) => a -> ShowS
showHex a
x String
"") forall a. [a] -> [a] -> [a]
++ Int -> Int -> [(a, Int)] -> [String]
expand (Int
iforall a. Num a => a -> a -> a
+Int
len) Int
longest [(a, Int)]
wsNext
    longestZ :: Int
longestZ = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==a
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(a, Int)]
grouped
    grouped :: [(a, Int)]
grouped = forall a b. (a -> b) -> [a] -> [b]
map (\[a]
x -> (forall a. [a] -> a
head [a]
x, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x)) (forall a. Eq a => [a] -> [[a]]
group [a]
ws)

isIPv4Mapped :: IPv6 -> Bool
isIPv4Mapped :: IPv6 -> Bool
isIPv4Mapped (IPv6 (Word128 Word64
w1 Word64
w2)) =
  Word64
w1 forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& (Word64
0xFFFFFFFF00000000 forall a. Bits a => a -> a -> a
.&. Word64
w2 forall a. Eq a => a -> a -> Bool
== Word64
0x0000FFFF00000000)

-- | Decode UTF-8-encoded 'Bytes' into an 'IPv6' address.
--
--   >>> decodeUtf8Bytes (Ascii.fromString "::cab:1")
--   Just (ipv6 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000 0x0cab 0x0001)
decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv6
decodeUtf8Bytes :: Bytes -> Maybe IPv6
decodeUtf8Bytes !Bytes
b = case forall e a. (forall s. Parser e s a) -> Bytes -> Result e a
Parser.parseBytes (forall e s. e -> Parser e s IPv6
parserUtf8Bytes ()) Bytes
b of
  Parser.Success (Parser.Slice Int
_ Int
len IPv6
addr) -> case Int
len of
    Int
0 -> forall a. a -> Maybe a
Just IPv6
addr
    Int
_ -> forall a. Maybe a
Nothing
  Parser.Failure ()
_ -> forall a. Maybe a
Nothing

-- | Encodes the 'IPv6' address using zero-compression on the
-- leftmost longest string of zeroes in the address.
--
-- >>> BB.run Nat.constant $ IPv6.boundedBuilderUtf8 $ IPv6.fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0 0x0 0x1234
-- [0x64, 0x65, 0x61, 0x64, 0x3a, 0x62, 0x65, 0x65, 0x66, 0x3a, 0x3a, 0x31, 0x32, 0x33, 0x34]
boundedBuilderUtf8 :: IPv6 -> BB.Builder 39
boundedBuilderUtf8 :: IPv6 -> Builder 39
boundedBuilderUtf8 !ip :: IPv6
ip@(IPv6 (Word128 Word64
hi Word64
lo))
  | Word64
hi forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& Word64
lo forall a. Eq a => a -> a -> Bool
== Word64
0 = forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant
      (Char -> Builder 1
BB.ascii Char
':' forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append` Char -> Builder 1
BB.ascii Char
':')
  | IPv6 -> Bool
isIPv4Mapped IPv6
ip = forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant forall a b. (a -> b) -> a -> b
$
      Char -> Builder 1
BB.ascii Char
':'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      Char -> Builder 1
BB.ascii Char
':'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      Char -> Builder 1
BB.ascii Char
'f'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      Char -> Builder 1
BB.ascii Char
'f'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      Char -> Builder 1
BB.ascii Char
'f'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      Char -> Builder 1
BB.ascii Char
'f'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      Char -> Builder 1
BB.ascii Char
':'
      forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
      IPv4 -> Builder 15
IPv4.boundedBuilderUtf8 (Word32 -> IPv4
IPv4.IPv4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
lo))
  | Bool
otherwise =
      let (Word16
w0,Word16
w1,Word16
w2,Word16
w3,Word16
w4,Word16
w5,Word16
w6,Word16
w7) = IPv6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
toWord16s IPv6
ip
          IntTriple Int
startLongest Int
longest Int
_ = Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IntTriple
longestRun Word16
w0 Word16
w1 Word16
w2 Word16
w3 Word16
w4 Word16
w5 Word16
w6 Word16
w7
          start :: Int
start = Int
startLongest
          end :: Int
end = Int
start forall a. Num a => a -> a -> a
+ Int
longest
          -- start is inclusive. end is exclusive
       in Word16 -> Int -> Builder 4
firstPiece Word16
w0 Int
start
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Int -> Word16 -> Int -> Int -> Builder 5
piece Int
1 Word16
w1 Int
start Int
end
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Int -> Word16 -> Int -> Int -> Builder 5
piece Int
2 Word16
w2 Int
start Int
end
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Int -> Word16 -> Int -> Int -> Builder 5
piece Int
3 Word16
w3 Int
start Int
end
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Int -> Word16 -> Int -> Int -> Builder 5
piece Int
4 Word16
w4 Int
start Int
end
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Int -> Word16 -> Int -> Int -> Builder 5
piece Int
5 Word16
w5 Int
start Int
end
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Int -> Word16 -> Int -> Int -> Builder 5
piece Int
6 Word16
w6 Int
start Int
end
          forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
          Word16 -> Int -> Builder 5
lastPiece Word16
w7 Int
end

firstPiece :: Word16 -> Int -> BB.Builder 4
firstPiece :: Word16 -> Int -> Builder 4
firstPiece !Word16
w !Int
start = case Int
start of
  Int
0 -> forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant (Char -> Builder 1
BB.ascii Char
':')
  Int
_ -> Word16 -> Builder 4
BB.word16LowerHex Word16
w

-- Note about the implementation of piece:
-- It is important to manually perform worker-wrapper so that
-- we can stop piece from inlining. If we do not do this, GHC
-- inlines piece, leading to enormous blowup in the generated
-- Core. The implementation of boundedBuilderUtf8 becomes
-- thousands of lines of Core. Even in the microbenchmark that
-- comes with this library, it can be observed that preventing
-- this inlining improves performance of encodeShort by 50%.
piece :: Int -> Word16 -> Int -> Int -> BB.Builder 5
{-# inline piece #-}
piece :: Int -> Word16 -> Int -> Int -> Builder 5
piece (I# Int#
ix) (Compat.W16# Word#
w) (I# Int#
start) (I# Int#
end) =
  Int# -> Word# -> Int# -> Int# -> Builder 5
piece# Int#
ix Word#
w Int#
start Int#
end

piece# :: Int# -> Word# -> Int# -> Int# -> BB.Builder 5
{-# noinline piece# #-}
piece# :: Int# -> Word# -> Int# -> Int# -> Builder 5
piece# !Int#
ix# !Word#
w# !Int#
start# !Int#
end# = case forall a. Ord a => a -> a -> Ordering
compare Int
ix Int
start of
  Ordering
LT -> Char -> Builder 1
BB.ascii Char
':' forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append` Word16 -> Builder 4
BB.word16LowerHex Word16
w
  Ordering
EQ -> forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant (Char -> Builder 1
BB.ascii Char
':')
  Ordering
GT -> if Int
ix forall a. Ord a => a -> a -> Bool
< Int
end
    then forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant Builder 0
BB.empty
    else Char -> Builder 1
BB.ascii Char
':' forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append` Word16 -> Builder 4
BB.word16LowerHex Word16
w
  where
  ix :: Int
ix = Int# -> Int
I# Int#
ix#
  start :: Int
start = Int# -> Int
I# Int#
start#
  end :: Int
end = Int# -> Int
I# Int#
end#
  w :: Word16
w = Word# -> Word16
Compat.W16# Word#
w#

lastPiece :: Word16 -> Int -> BB.Builder 5
lastPiece :: Word16 -> Int -> Builder 5
lastPiece !Word16
w !Int
end = case Int
end of
  Int
8 -> forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant (Char -> Builder 1
BB.ascii Char
':')
  Int
_ -> Char -> Builder 1
BB.ascii Char
':' forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append` Word16 -> Builder 4
BB.word16LowerHex Word16
w

data IntTriple = IntTriple !Int !Int !Int

-- Choose the longest run. Prefer the leftmost run in the
-- event of a tie.
stepZeroRunLength :: Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength :: Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength !Int
ix !Word16
w (IntTriple Int
startLongest Int
longest Int
current) = case Word16
w of
  Word16
0 -> let !x :: Int
x = Int
current forall a. Num a => a -> a -> a
+ Int
1 in
    if Int
x forall a. Ord a => a -> a -> Bool
> Int
longest
      then Int -> Int -> Int -> IntTriple
IntTriple (Int
ix forall a. Num a => a -> a -> a
- Int
current) Int
x Int
x
      else Int -> Int -> Int -> IntTriple
IntTriple Int
startLongest Int
longest Int
x
  Word16
_ -> Int -> Int -> Int -> IntTriple
IntTriple Int
startLongest Int
longest Int
0

-- We start out by setting the longest run to size 1. This
-- means that we will only detect runs of length two or greater.
longestRun ::
     Word16
  -> Word16
  -> Word16
  -> Word16
  -> Word16
  -> Word16
  -> Word16
  -> Word16
  -> IntTriple
longestRun :: Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IntTriple
longestRun !Word16
w0 !Word16
w1 !Word16
w2 !Word16
w3 !Word16
w4 !Word16
w5 !Word16
w6 !Word16
w7 = forall a. a -> a
id
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
7 Word16
w7
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
6 Word16
w6
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
5 Word16
w5
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
4 Word16
w4
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
3 Word16
w3
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
2 Word16
w2
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
1 Word16
w1
  forall a b. (a -> b) -> a -> b
$ Int -> Word16 -> IntTriple -> IntTriple
stepZeroRunLength Int
0 Word16
w0
  forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> IntTriple
IntTriple (-Int
1) Int
1 Int
0

-- | Encodes the 'IPv6' address as 'ShortText' using zero-compression on
-- the leftmost longest string of zeroes in the address.
-- Per <https://tools.ietf.org/html/rfc5952#section-5 RFC 5952 Section 5>,
-- this uses mixed notation when encoding an IPv4-mapped IPv6 address.
-- 
-- >>> IPv6.encodeShort $ IPv6.fromWord16s 0xDEAD 0xBEEF 0x0 0x0 0x0 0x0ABC 0x0 0x1234
-- "dead:beef::abc:0:1234"
encodeShort :: IPv6 -> ShortText
encodeShort :: IPv6 -> ShortText
encodeShort IPv6
w = forall a. a -> a
id
  forall a b. (a -> b) -> a -> b
$ ShortByteString -> ShortText
TS.fromShortByteStringUnsafe
  forall a b. (a -> b) -> a -> b
$ ByteArray -> ShortByteString
byteArrayToShortByteString
  forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). Nat n -> Builder n -> ByteArray
BB.run forall (n :: Nat). KnownNat n => Nat n
Nat.constant
  forall a b. (a -> b) -> a -> b
$ IPv6 -> Builder 39
boundedBuilderUtf8
  forall a b. (a -> b) -> a -> b
$ IPv6
w

byteArrayToShortByteString :: PM.ByteArray -> BSS.ShortByteString
byteArrayToShortByteString :: ByteArray -> ShortByteString
byteArrayToShortByteString (PM.ByteArray ByteArray#
x) = ByteArray# -> ShortByteString
BSS.SBS ByteArray#
x

-- | Decode an 'IPv6' address. This accepts both standard IPv6
-- notation (with zero compression) and mixed notation for
-- IPv4-mapped IPv6 addresses. For a decoding function that
-- additionally accepts dot-decimal-encoded IPv4 addresses,
-- see @Net.IP.decode@.
decode :: Text -> Maybe IPv6
decode :: Text -> Maybe IPv6
decode Text
t = forall a b. Either a b -> Maybe b
rightToMaybe (forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Text IPv6
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AT.endOfInput) Text
t)

-- | Parse UTF-8-encoded 'Bytes' as an 'IPv6' address. This accepts
-- both uppercase and lowercase characters in the hexadecimal components.
--
-- >>> let str = "dead:beef:3240:a426:ba68:1cd0:4263:109b -> alive"
-- >>> Parser.parseBytes (parserUtf8Bytes ()) (Ascii.fromString str)
-- Success (Slice {offset = 39, length = 9, value = ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b})
--
-- This does not currently support parsing embedded IPv4 address
-- (e.g. @ff00:8000:abc::224.1.2.3@).
parserUtf8Bytes :: e -> Parser.Parser e s IPv6
parserUtf8Bytes :: forall e s. e -> Parser e s IPv6
parserUtf8Bytes e
e = do
  MutablePrimArray s Word16
marr <- forall s a e. ST s a -> Parser e s a
Parser.effect (forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
PM.newPrimArray Int
8)
  -- We cannot immidiately call preZeroes since it wants a
  -- leading colon present.
  forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (forall a. Eq a => a -> a -> Bool
== Char
':') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
':'
      forall e s.
e -> MutablePrimArray s Word16 -> Int -> Int -> Parser e s IPv6
postZeroesBegin e
e MutablePrimArray s Word16
marr Int
0 Int
0
    Bool
False -> do
      Word16
w <- forall e s. e -> Parser e s Word16
pieceParser e
e
      forall s a e. ST s a -> Parser e s a
Parser.effect (forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Word16
marr Int
0 Word16
w)
      forall e s.
e -> MutablePrimArray s Word16 -> Int -> Parser e s IPv6
preZeroes e
e MutablePrimArray s Word16
marr Int
1

-- This is called when we are positioned before a colon.
-- We may encounter another colon immidiately after
-- the one that we consume here. This indicates zero
-- compression. Or we may encounter another hex-encoded
-- number.
preZeroes ::
     e
  -> MutablePrimArray s Word16 -- length must be 8
  -> Int
  -> Parser.Parser e s IPv6
preZeroes :: forall e s.
e -> MutablePrimArray s Word16 -> Int -> Parser e s IPv6
preZeroes e
e !MutablePrimArray s Word16
marr !Int
ix = case Int
ix of
  Int
8 -> forall s a e. ST s a -> Parser e s a
Parser.effect (forall s. MutablePrimArray s Word16 -> ST s IPv6
combinePieces MutablePrimArray s Word16
marr)
  Int
_ -> do
    forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
':'
    forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (forall a. Eq a => a -> a -> Bool
== Char
':') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> forall e s.
e -> MutablePrimArray s Word16 -> Int -> Int -> Parser e s IPv6
postZeroesBegin e
e MutablePrimArray s Word16
marr Int
ix Int
ix
      Bool
False -> do
        Word16
w <- forall e s. e -> Parser e s Word16
pieceParser e
e
        forall s a e. ST s a -> Parser e s a
Parser.effect (forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Word16
marr Int
ix Word16
w)
        forall e s.
e -> MutablePrimArray s Word16 -> Int -> Parser e s IPv6
preZeroes e
e MutablePrimArray s Word16
marr (Int
ix forall a. Num a => a -> a -> a
+ Int
1)

-- The same as postZeroes except that there is no
-- leading that gets consumed. This is called right
-- after a double colon is consumed.
-- Precondition: the index is less than 8. This parser
-- is only called by preZeroes, which ensures that
-- this holds.
postZeroesBegin ::
     e
  -> MutablePrimArray s Word16 -- length must be 8
  -> Int -- current index in array
  -> Int -- index where compression happened
  -> Parser.Parser e s IPv6
postZeroesBegin :: forall e s.
e -> MutablePrimArray s Word16 -> Int -> Int -> Parser e s IPv6
postZeroesBegin e
e !MutablePrimArray s Word16
marr !Int
ix !Int
compress = do
  forall e s. e -> Parser e s (Maybe Word16)
optionalPieceParser e
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Word16
Nothing -> do -- the end has come
      forall s a e. ST s a -> Parser e s a
Parser.effect (forall s. MutablePrimArray s Word16 -> Int -> Int -> ST s IPv6
conclude MutablePrimArray s Word16
marr Int
ix Int
compress)
    Just Word16
w -> do
      forall s a e. ST s a -> Parser e s a
Parser.effect (forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Word16
marr Int
ix Word16
w)
      forall e s.
e -> MutablePrimArray s Word16 -> Int -> Int -> Parser e s IPv6
postZeroes e
e MutablePrimArray s Word16
marr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
compress

-- Should be run right before a colon.
postZeroes :: 
     e
  -> MutablePrimArray s Word16 -- length must be 8
  -> Int -- current index in array
  -> Int -- index where compression happened
  -> Parser.Parser e s IPv6
postZeroes :: forall e s.
e -> MutablePrimArray s Word16 -> Int -> Int -> Parser e s IPv6
postZeroes e
e !MutablePrimArray s Word16
marr !Int
ix !Int
compress = case Int
ix of
  Int
8 -> forall e s a. e -> Parser e s a
Parser.fail e
e
  Int
_ -> do
    forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (forall a. Eq a => a -> a -> Bool
== Char
':') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
False -> -- The end has come
        forall s a e. ST s a -> Parser e s a
Parser.effect (forall s. MutablePrimArray s Word16 -> Int -> Int -> ST s IPv6
conclude MutablePrimArray s Word16
marr Int
ix Int
compress)
      Bool
True -> do
        Word16
w <- forall e s. e -> Parser e s Word16
pieceParser e
e
        forall s a e. ST s a -> Parser e s a
Parser.effect (forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PM.writePrimArray MutablePrimArray s Word16
marr Int
ix Word16
w)
        forall e s.
e -> MutablePrimArray s Word16 -> Int -> Int -> Parser e s IPv6
postZeroes e
e MutablePrimArray s Word16
marr (Int
ix forall a. Num a => a -> a -> a
+ Int
1) Int
compress

conclude :: MutablePrimArray s Word16 -> Int -> Int -> ST s IPv6
conclude :: forall s. MutablePrimArray s Word16 -> Int -> Int -> ST s IPv6
conclude !MutablePrimArray s Word16
marr !Int
ix !Int
compress = do
  -- This will overlap, but GHC's copy primop is fine with that.
  let postCompressionLen :: Int
postCompressionLen = Int
ix forall a. Num a => a -> a -> a
- Int
compress
  forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
PM.copyMutablePrimArray MutablePrimArray s Word16
marr (Int
8 forall a. Num a => a -> a -> a
- Int
postCompressionLen) MutablePrimArray s Word16
marr Int
compress Int
postCompressionLen
  let compressedArea :: Int
compressedArea = Int
8 forall a. Num a => a -> a -> a
- Int
ix
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
PM.setPrimArray MutablePrimArray s Word16
marr Int
compress Int
compressedArea (Word16
0 :: Word16)
  forall s. MutablePrimArray s Word16 -> ST s IPv6
combinePieces MutablePrimArray s Word16
marr

-- Example memmove that may need to happen:
-- A B C H  ==> A B C 0 0 0 0 H
--       *
-- ix = 4, compress = 3, postCompressionLen = 1, compressedArea = 4
-- copyPrimArray marr 7 marr 3 1
-- setPrimArray marr 3 4 (0 :: Word16)

combinePieces ::
     MutablePrimArray s Word16
  -> ST s IPv6
combinePieces :: forall s. MutablePrimArray s Word16 -> ST s IPv6
combinePieces !MutablePrimArray s Word16
marr = Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
fromWord16s
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
0
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
1
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
2
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
3
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
4
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
5
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
6
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PM.readPrimArray MutablePrimArray s Word16
marr Int
7

optionalPieceParser :: e -> Parser.Parser e s (Maybe Word16)
optionalPieceParser :: forall e s. e -> Parser e s (Maybe Word16)
optionalPieceParser e
e = forall e s. Parser e s (Maybe Word)
Latin.tryHexNibble forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe Word
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  Just Word
w0 -> do
    Word16
r <- forall e s. e -> Word -> Parser e s Word16
pieceParserStep e
e Word
w0
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Word16
r)

-- This should probably be moved into bytesmith and renamed.
pieceParser :: e -> Parser.Parser e s Word16
pieceParser :: forall e s. e -> Parser e s Word16
pieceParser e
e = forall e s. e -> Parser e s Word
Latin.hexNibble e
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e s. e -> Word -> Parser e s Word16
pieceParserStep e
e

-- Parses the remainder of a lowercase hexadecimal number.
-- Leaves trailing colons alone. This fails if there are
-- more than four hex digits unless there are leading zeroes.
-- I cannot find a spec that is clear about what to do
-- if someone puts 00000 in a piece of an encoded IPv6
-- address, so I veer on the side of leniency.
pieceParserStep ::
     e
  -> Word
  -> Parser.Parser e s Word16
pieceParserStep :: forall e s. e -> Word -> Parser e s Word16
pieceParserStep e
e !Word
acc = if Word
acc forall a. Ord a => a -> a -> Bool
> Word
0xFFFF
  then forall e s a. e -> Parser e s a
Parser.fail e
e
  else forall e s. Parser e s (Maybe Word)
Latin.tryHexNibble forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Word
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
acc)
    Just Word
w -> forall e s. e -> Word -> Parser e s Word16
pieceParserStep e
e (Word
16 forall a. Num a => a -> a -> a
* Word
acc forall a. Num a => a -> a -> a
+ Word
w)

-- | Parse UTF-8-encoded 'Bytes' into an 'IPv4Range'.
-- This requires the mask to be present.
--
-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8Bytes ()) (Ascii.fromString "1b02:f001:5:200b::/80")
-- 1b02:f001:5:200b::/80
-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8Bytes ()) (Ascii.fromString "abcd::")
-- nope
--
-- See 'parserRangeUtf8BytesLenient' for a variant that treats
-- a missing mask as a @/32@ mask.
parserRangeUtf8Bytes :: e -> Parser.Parser e s IPv6Range
parserRangeUtf8Bytes :: forall e s. e -> Parser e s IPv6Range
parserRangeUtf8Bytes e
e = do
  IPv6
base <- forall e s. e -> Parser e s IPv6
parserUtf8Bytes e
e
  forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'/'
  Word8
theMask <- forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  if Word8
theMask forall a. Ord a => a -> a -> Bool
> Word8
128
    then forall e s a. e -> Parser e s a
Parser.fail e
e
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! IPv6Range -> IPv6Range
normalize (IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
base Word8
theMask)

-- | Variant of 'parserRangeUtf8Bytes' that allows the mask
-- to be omitted. An omitted mask is treated as a @/128@ mask.
--
-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8BytesLenient ()) (Ascii.fromString "1b02:f001:5:200b::/80")
-- 1b02:f001:5:200b::/80
-- >>> maybe (putStrLn "nope") IPv6.printRange $ Parser.parseBytesMaybe (IPv6.parserRangeUtf8BytesLenient ()) (Ascii.fromString "abcd::")
-- abcd::/128
parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv6Range
parserRangeUtf8BytesLenient :: forall e s. e -> Parser e s IPv6Range
parserRangeUtf8BytesLenient e
e = do
  IPv6
base <- forall e s. e -> Parser e s IPv6
parserUtf8Bytes e
e
  forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (forall a. Eq a => a -> a -> Bool
==Char
'/') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      Word8
theMask <- forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      if Word8
theMask forall a. Ord a => a -> a -> Bool
> Word8
128
        then forall e s a. e -> Parser e s a
Parser.fail e
e
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! IPv6Range -> IPv6Range
normalize (IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
base Word8
theMask)
    Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
base Word8
128

-- | Parse an 'IPv6' using 'Atto.Parser'.
--
--   >>> Atto.parseOnly IPv6.parser (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b")
--   Right (ipv6 0xdead 0xbeef 0x3240 0xa426 0xba68 0x1cd0 0x4263 0x109b)
parser :: Atto.Parser IPv6
parser :: Parser Text IPv6
parser = [Word16] -> IPv6
makeIP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Word16]
ip
  where
  makeIP :: [Word16] -> IPv6
makeIP [Word16
w1, Word16
w2, Word16
w3, Word16
w4, Word16
w5, Word16
w6, Word16
w7, Word16
w8] = Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
fromWord16s Word16
w1 Word16
w2 Word16
w3 Word16
w4 Word16
w5 Word16
w6 Word16
w7 Word16
w8
  makeIP [Word16]
_ = forall a. HasCallStack => String -> a
error String
"Net.IPv6.parser: Implementation error. Please open a bug report."

  ip :: Parser Text [Word16]
ip = (Char -> Parser Text Char
Atto.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
Atto.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Text [Word16]
doubleColon Int
0) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Text [Word16]
part Int
0

  part :: Int -> Atto.Parser [Word16]
  part :: Int -> Parser Text [Word16]
part Int
n =
    case Int
n of
      -- max 8 parts in an IPv6 address
      Int
7 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Parser a
Atto.hexadecimal
      -- after 6 parts it could end in IPv4 dotted notation
      Int
6 -> Parser Text [Word16]
ipv4 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text [Word16]
hexPart
      Int
_ -> Parser Text [Word16]
hexPart
    where
    hexPart :: Parser Text [Word16]
hexPart = (:)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Parser a
Atto.hexadecimal
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Text Char
Atto.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            (
             (Char -> Parser Text Char
Atto.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Text [Word16]
doubleColon (Int
nforall a. Num a => a -> a -> a
+Int
1))
             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             Int -> Parser Text [Word16]
part (Int
nforall a. Num a => a -> a -> a
+Int
1)
            )
          )

  doubleColon :: Int -> Atto.Parser [Word16]
  doubleColon :: Int -> Parser Text [Word16]
doubleColon Int
count = do
    [Word16]
rest <- Parser Text [Word16]
afterDoubleColon forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    let fillerLength :: Int
fillerLength = (Int
8 forall a. Num a => a -> a -> a
- Int
count forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word16]
rest)
    if Int
fillerLength forall a. Ord a => a -> a -> Bool
<= Int
0
      then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"too many parts in IPv6 address"
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Int -> a -> [a]
replicate Int
fillerLength Word16
0 forall a. [a] -> [a] -> [a]
++ [Word16]
rest)

  -- after double colon, IPv4 dotted notation could appear anywhere
  afterDoubleColon :: Atto.Parser [Word16]
  afterDoubleColon :: Parser Text [Word16]
afterDoubleColon =
    Parser Text [Word16]
ipv4 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, Bits a) => Parser a
Atto.hexadecimal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Char -> Parser Text Char
Atto.char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text [Word16]
afterDoubleColon) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

  ipv4 :: Atto.Parser [Word16]
  ipv4 :: Parser Text [Word16]
ipv4 = IPv4 -> [Word16]
ipv4ToWord16s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser IPv4
IPv4.parser

  ipv4ToWord16s :: IPv4 -> [Word16]
  ipv4ToWord16s :: IPv4 -> [Word16]
ipv4ToWord16s (IPv4 Word32
word) = [forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
word forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
16), forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
word forall a. Bits a => a -> a -> a
.&. Word32
0xFFFF)]

-- | An 'IPv6Range'. It is made up of the first 'IPv6' in the range
--   and its length.
data IPv6Range = IPv6Range
  { IPv6Range -> IPv6
ipv6RangeBase   :: {-# UNPACK #-} !IPv6
  , IPv6Range -> Word8
ipv6RangeLength :: {-# UNPACK #-} !Word8
  } deriving (IPv6Range -> IPv6Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6Range -> IPv6Range -> Bool
$c/= :: IPv6Range -> IPv6Range -> Bool
== :: IPv6Range -> IPv6Range -> Bool
$c== :: IPv6Range -> IPv6Range -> Bool
Eq,Eq IPv6Range
IPv6Range -> IPv6Range -> Bool
IPv6Range -> IPv6Range -> Ordering
IPv6Range -> IPv6Range -> IPv6Range
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 :: IPv6Range -> IPv6Range -> IPv6Range
$cmin :: IPv6Range -> IPv6Range -> IPv6Range
max :: IPv6Range -> IPv6Range -> IPv6Range
$cmax :: IPv6Range -> IPv6Range -> IPv6Range
>= :: IPv6Range -> IPv6Range -> Bool
$c>= :: IPv6Range -> IPv6Range -> Bool
> :: IPv6Range -> IPv6Range -> Bool
$c> :: IPv6Range -> IPv6Range -> Bool
<= :: IPv6Range -> IPv6Range -> Bool
$c<= :: IPv6Range -> IPv6Range -> Bool
< :: IPv6Range -> IPv6Range -> Bool
$c< :: IPv6Range -> IPv6Range -> Bool
compare :: IPv6Range -> IPv6Range -> Ordering
$ccompare :: IPv6Range -> IPv6Range -> Ordering
Ord,Int -> IPv6Range -> ShowS
[IPv6Range] -> ShowS
IPv6Range -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPv6Range] -> ShowS
$cshowList :: [IPv6Range] -> ShowS
show :: IPv6Range -> String
$cshow :: IPv6Range -> String
showsPrec :: Int -> IPv6Range -> ShowS
$cshowsPrec :: Int -> IPv6Range -> ShowS
Show,ReadPrec [IPv6Range]
ReadPrec IPv6Range
Int -> ReadS IPv6Range
ReadS [IPv6Range]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IPv6Range]
$creadListPrec :: ReadPrec [IPv6Range]
readPrec :: ReadPrec IPv6Range
$creadPrec :: ReadPrec IPv6Range
readList :: ReadS [IPv6Range]
$creadList :: ReadS [IPv6Range]
readsPrec :: Int -> ReadS IPv6Range
$creadsPrec :: Int -> ReadS IPv6Range
Read,forall x. Rep IPv6Range x -> IPv6Range
forall x. IPv6Range -> Rep IPv6Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IPv6Range x -> IPv6Range
$cfrom :: forall x. IPv6Range -> Rep IPv6Range x
Generic,Typeable IPv6Range
IPv6Range -> DataType
IPv6Range -> Constr
(forall b. Data b => b -> b) -> IPv6Range -> IPv6Range
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IPv6Range -> u
forall u. (forall d. Data d => d -> u) -> IPv6Range -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IPv6Range -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IPv6Range -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6Range
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6Range -> c IPv6Range
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6Range)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6Range)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv6Range -> m IPv6Range
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv6Range -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv6Range -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> IPv6Range -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv6Range -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IPv6Range -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IPv6Range -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IPv6Range -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IPv6Range -> r
gmapT :: (forall b. Data b => b -> b) -> IPv6Range -> IPv6Range
$cgmapT :: (forall b. Data b => b -> b) -> IPv6Range -> IPv6Range
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6Range)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv6Range)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6Range)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv6Range)
dataTypeOf :: IPv6Range -> DataType
$cdataTypeOf :: IPv6Range -> DataType
toConstr :: IPv6Range -> Constr
$ctoConstr :: IPv6Range -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6Range
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv6Range
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6Range -> c IPv6Range
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv6Range -> c IPv6Range
Data)

instance NFData IPv6Range

instance Aeson.ToJSON IPv6Range where
  toJSON :: IPv6Range -> Value
toJSON = Text -> Value
Aeson.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6Range -> Text
encodeRange

instance Aeson.FromJSON IPv6Range where
  parseJSON :: Value -> Parser IPv6Range
parseJSON (Aeson.String Text
t) = case Text -> Maybe IPv6Range
decodeRange Text
t of
    Maybe IPv6Range
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decodeRange IPv6 range"
    Just IPv6Range
res -> forall (m :: * -> *) a. Monad m => a -> m a
return IPv6Range
res
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

mask128 :: IPv6
mask128 :: IPv6
mask128 = forall a. Bounded a => a
maxBound

mask :: Word8 -> IPv6
mask :: Word8 -> IPv6
mask = forall a. Bits a => a -> a
complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => a -> Int -> a
shiftR IPv6
mask128 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Normalize an 'IPv6Range'. The first result of this is that the
--   'IPv6' inside the 'IPv6Range' is changed so that the insignificant
--   bits are zeroed out. For example:
--
--   >>> addr1 = IPv6.ipv6 0x0192 0x0168 0x0001 0x0019 0x0000 0x0000 0x0000 0x0000
--   >>> addr2 = IPv6.ipv6 0x0192 0x0168 0x0001 0x0163 0x0000 0x0000 0x0000 0x0000
--   >>> IPv6.printRange $ IPv6.normalize $ IPv6.IPv6Range addr1 24
--   192:100::/24
--   >>> IPv6.printRange $ IPv6.normalize $ IPv6.IPv6Range addr2 28
--   192:160::/28
--
--   The second effect of this is that the mask length is lowered to be 128
--   or smaller. Working with 'IPv6Range's that have not been normalized does
--   not cause any issues for this library, although other applications may
--   reject such ranges (especially those with a mask length above 128).
--
--   Note that 'normalize is idempotent, that is:
--
--   prop> IPv6.normalize r == (IPv6.normalize . IPv6.normalize) r
normalize :: IPv6Range -> IPv6Range
normalize :: IPv6Range -> IPv6Range
normalize (IPv6Range IPv6
ip Word8
len) =
  let len' :: Word8
len' = forall a. Ord a => a -> a -> a
min Word8
len Word8
128
      ip' :: IPv6
ip' = IPv6
ip forall a. Bits a => a -> a -> a
.&. Word8 -> IPv6
mask Word8
len'
  in IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
ip' Word8
len'

-- | Encode an 'IPv6Range' as 'Text'.
--
--   >>> addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B
--   >>> T.putStrLn $ IPv6.encodeRange $ IPv6.IPv6Range addr 28
--   dead:beef:3240:a426:ba68:1cd0:4263:109b/28
encodeRange :: IPv6Range -> Text
encodeRange :: IPv6Range -> Text
encodeRange IPv6Range
x = IPv6 -> Text
encode (IPv6Range -> IPv6
ipv6RangeBase IPv6Range
x) forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"/" forall a. Semigroup a => a -> a -> a
<> (String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) forall a b. (a -> b) -> a -> b
$ IPv6Range -> Word8
ipv6RangeLength IPv6Range
x)

-- | Decode an 'IPv6Range' from 'Text'.
--
--   >>> addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B
--   >>> fmap IPv6.encodeRange $ IPv6.decodeRange (Text.pack "dead:beef:3240:a426:ba68:1cd0:4263:109b/28")
--   Just "dead:bee0::/28"
decodeRange :: Text -> Maybe IPv6Range
decodeRange :: Text -> Maybe IPv6Range
decodeRange = forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Text IPv6Range
parserRange forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AT.endOfInput)

-- | Parse an 'IPv6Range' using a 'AT.Parser'.
parserRange :: AT.Parser IPv6Range
parserRange :: Parser Text IPv6Range
parserRange = do
  IPv6
ip <- Parser Text IPv6
parser
  Char
_ <- Char -> Parser Text Char
AT.char Char
'/'
  Word8
theMask <- forall a. Integral a => Parser a
AT.decimal forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *}. (Ord a, Num a, MonadFail m) => a -> m a
limitSize
  forall (m :: * -> *) a. Monad m => a -> m a
return (IPv6Range -> IPv6Range
normalize (IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
ip Word8
theMask))
  where
  limitSize :: a -> m a
limitSize a
i =
    if a
i forall a. Ord a => a -> a -> Bool
> a
128
      then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An IP range length must be between 0 and 128"
      else forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | Checks to see if an 'IPv6' address belongs in the 'IPv6Range'.
--
-- >>> let ip = IPv6.ipv6 0x2001 0x0db8 0x0db8 0x1094 0x2051 0x0000 0x0000 0x0001
-- >>> let iprange mask = IPv6.IPv6Range (IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) mask
-- >>> IPv6.contains (iprange 8) ip
-- True
-- >>> IPv6.contains (iprange 48) ip
-- False
--
-- Typically, element-testing functions are written to take the element
-- as the first argument and the set as the second argument. This is intentionally
-- written the other way for better performance when iterating over a collection.
-- For example, you might test elements in a list for membership like this:
--
-- >>> let r = IPv6.IPv6Range (IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 64
-- >>> fmap (IPv6.contains r) (take 5 $ iterate succ $ IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0xffff 0xffff 0xffff 0xfffe)
-- [True,True,False,False,False]
--
-- The implementation of 'contains' ensures that (with GHC), the bitmask
-- creation and range normalization only occur once in the above example.
-- They are reused as the list is iterated.
contains :: IPv6Range -> IPv6 -> Bool
contains :: IPv6Range -> IPv6 -> Bool
contains (IPv6Range IPv6
subnet Word8
len) =
  let theMask :: IPv6
theMask = Word8 -> IPv6
mask Word8
len
      subnetNormalized :: IPv6
subnetNormalized = IPv6
subnet forall a. Bits a => a -> a -> a
.&. IPv6
theMask
   in \IPv6
ip -> (IPv6
ip forall a. Bits a => a -> a -> a
.&. IPv6
theMask) forall a. Eq a => a -> a -> Bool
== IPv6
subnetNormalized

-- | This is provided to mirror the interface provided by @Data.Set@. It
-- behaves just like 'contains' but with flipped arguments.
--
-- prop> IPv6.member ip r == IPv6.contains r ip
member :: IPv6 -> IPv6Range -> Bool
member :: IPv6 -> IPv6Range -> Bool
member = forall a b c. (a -> b -> c) -> b -> a -> c
flip IPv6Range -> IPv6 -> Bool
contains

-- | The inclusive lower bound of an 'IPv6Range'. This is conventionally
--   understood to be the broadcast address of a subnet. For example:
--
-- >>> T.putStrLn $ IPv6.encode $ IPv6.lowerInclusive $ IPv6.IPv6Range (IPv6.ipv6 0x2001 0x0db8 0x0000 0x0000 0x0000 0x0000 0x0000 0x0001) 25
-- 2001:d80::
--
-- Note that the lower bound of a normalized 'IPv6Range' is simply the
-- ip address of the range:
--
-- prop> IPv6.lowerInclusive r == IPv6.ipv6RangeBase (IPv6.normalize r)
lowerInclusive :: IPv6Range -> IPv6
lowerInclusive :: IPv6Range -> IPv6
lowerInclusive = IPv6Range -> IPv6
ipv6RangeBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6Range -> IPv6Range
normalize

-- | The inclusive upper bound of an 'IPv6Range'.
--
--   >>> let addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B
--   >>> T.putStrLn $ IPv6.encode $ IPv6.upperInclusive $ IPv6.IPv6Range addr 25
--   dead:beff:ffff:ffff:ffff:ffff:ffff:ffff
--
upperInclusive :: IPv6Range -> IPv6
upperInclusive :: IPv6Range -> IPv6
upperInclusive (IPv6Range IPv6
ip Word8
len) =
  let len' :: Word8
len' = forall a. Ord a => a -> a -> a
min Word8
128 Word8
len
      theInvertedMask :: IPv6
      theInvertedMask :: IPv6
theInvertedMask = forall a. Bits a => a -> Int -> a
shiftR IPv6
mask128 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len')
  in IPv6
ip forall a. Bits a => a -> a -> a
.|. IPv6
theInvertedMask

-- | Print an 'IPv6Range' using the textual encoding.
printRange :: IPv6Range -> IO ()
printRange :: IPv6Range -> IO ()
printRange = Text -> IO ()
TIO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6Range -> Text
encodeRange

-- | Smart constructor for 'IPv6Range'. Ensures the mask is appropriately
--   sized and sets masked bits in the 'IPv6' to zero.
--
--   >>> let addr = IPv6.ipv6 0xDEAD 0xBEEF 0x3240 0xA426 0xBA68 0x1CD0 0x4263 0x109B
--   >>> IPv6.printRange $ IPv6.range addr 25
--   dead:be80::/25
range :: IPv6 -> Word8 -> IPv6Range
range :: IPv6 -> Word8 -> IPv6Range
range IPv6
addr Word8
len = IPv6Range -> IPv6Range
normalize (IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
addr Word8
len)

-- | Given an inclusive lower and upper ip address, create the smallest 'IPv6Range'
--   that contains the two. This is helpful in situations where input is given as a
--   range, like @ @.
--
--   This makes the range broader if it cannot be represented in <https://en.wikipedia.org/wiki/Classless_Inter-Domain_Routing CIDR> notation.
--
--   >>> addrLower = IPv6.ipv6 0xDEAD 0xBE80 0x0000 0x0000 0x0000 0x0000 0x0000 0x0000
--   >>> addrUpper = IPv6.ipv6 0xDEAD 0xBEFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF 0xFFFF
--   >>> IPv6.printRange $ IPv6.fromBounds addrLower addrUpper
--   dead:be80::/25
fromBounds :: IPv6 -> IPv6 -> IPv6Range
fromBounds :: IPv6 -> IPv6 -> IPv6Range
fromBounds IPv6
lo IPv6
hi =
  IPv6Range -> IPv6Range
normalize (IPv6 -> Word8 -> IPv6Range
IPv6Range IPv6
lo (IPv6 -> IPv6 -> Word8
maskFromBounds IPv6
lo IPv6
hi))

maskFromBounds :: IPv6 -> IPv6 -> Word8
maskFromBounds :: IPv6 -> IPv6 -> Word8
maskFromBounds IPv6
lo IPv6
hi = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall b. FiniteBits b => b -> Int
countLeadingZeros forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> a -> a
xor IPv6
lo IPv6
hi)