{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UnboxedTuples #-}

{-| This module provides the IPv4 data type and functions for working
    with it.
-}

module Net.IPv4
  ( -- * Conversion Functions
    ipv4
  , fromOctets
  , fromTupleOctets
  , toOctets
    -- * Special IP Addresses
  , any
  , loopback
  , localhost
  , broadcast
    -- * Range Predicates
  , private
  , reserved
  , public
    -- * Textual Conversion
    -- ** Text
  , encode
  , decode
  , builder
  , reader
  , parser
  , decodeShort
  , encodeShort
    -- ** UTF-8 ByteString
  , encodeUtf8
  , decodeUtf8
  , builderUtf8
  , parserUtf8
    -- ** UTF-8 Bytes
  , decodeUtf8Bytes
  , parserUtf8Bytes
  , byteArrayBuilderUtf8
  , boundedBuilderUtf8
    -- ** Non-textual Bytes
  , boundedBuilderOctetsBE
  , boundedBuilderOctetsLE
    -- ** String
    -- $string
  , encodeString
  , decodeString
    -- ** Printing
  , print
    -- * IPv4 Ranges
    -- ** Range functions
  , range
  , fromBounds
  , normalize
  , contains
  , member
  , lowerInclusive
  , upperInclusive
    -- ** Conversion to IPv4
  , toList
  , toGenerator
    -- ** Private Ranges
  , private24
  , private20
  , private16
    -- ** Textual Conversion
    -- *** Text
  , encodeRange
  , decodeRange
  , builderRange
  , parserRange
  , printRange
    -- ** UTF-8 Bytes
  , parserRangeUtf8Bytes
  , parserRangeUtf8BytesLenient
    -- * Types
  , IPv4(..)
  , IPv4#
  , IPv4Range(..)
    -- * Unboxing
    -- | These functions are useful for micro-optimizing
    --   when GHC does a poor job with worker-wrapper.
  , box
  , unbox
  , parserUtf8Bytes#
    -- * Interoperability
    -- $interoperability
  ) where

import Control.DeepSeq (NFData)
import Control.Monad
import Control.Monad.ST (ST,runST)
import Data.Aeson (FromJSON(..),ToJSON(..))
import Data.Aeson (ToJSONKey(..),FromJSONKey(..),ToJSONKeyFunction(..),FromJSONKeyFunction(..))
import Data.Bits (Bits(..))
import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Hashable
import Data.Ix (Ix)
import Data.Primitive.Types (Prim)
import Data.Text (Text)
import Data.Text.Builder.Common.Compat (Codepoint)
import Data.Text.Encoding (decodeUtf8')
import Data.Text.Internal (Text(..))
import Data.Text.Short (ShortText)
import Data.Vector.Generic.Mutable (MVector(..))
import Data.Word
import Foreign.Ptr (Ptr,plusPtr)
import Foreign.Storable (Storable, poke)
import GHC.Exts (Word#)
import GHC.Generics (Generic)
import Prelude hiding (any, print, print)
import Text.ParserCombinators.ReadPrec (prec,step)
import Text.Printf (printf)
import Text.Read (Read(..),Lexeme(Ident),lexP,parens)

import qualified Arithmetic.Nat as Nat
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Attoparsec.ByteString.Char8 as AB
import qualified Data.Attoparsec.Text as AT
import qualified Data.Bits as Bits
import qualified Data.Bytes.Builder.Bounded as BB
import qualified Data.Bytes.Builder as UB
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Internal as I
import qualified Data.ByteString.Unsafe as ByteString
import qualified Data.ByteString.Short.Internal as BSS
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Data.Char as Char
import qualified Data.Primitive as PM
import qualified Data.Text as Text
import qualified Data.Text.Array as TArray
import qualified Data.Text.IO as TIO
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as TBuilder
import qualified Data.Text.Lazy.Builder.Int as TBI
import qualified Data.Text.Read as TextRead
import qualified Data.Text.Short as TS
import qualified Data.Text.Short.Unsafe as TS
import qualified Data.Vector.Generic as GVector
import qualified Data.Vector.Generic.Mutable as MGVector
import qualified Data.Vector.Primitive as PVector
import qualified Data.Vector.Unboxed as UVector
import qualified Data.Vector.Unboxed.Mutable as MUVector
import qualified GHC.Word.Compat as Compat

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as AesonKey
#endif

-- $setup
--
-- These are here to get doctest's property checking to work
--
-- >>> :set -XOverloadedStrings
-- >>> import Test.QuickCheck (Arbitrary(..))
-- >>> import Net.IPv4 (getIPv4)
-- >>> import qualified Prelude as P
-- >>> import qualified Data.Text.IO as T
-- >>> import qualified Data.Bytes.Text.Ascii as Ascii
-- >>> import qualified Data.Attoparsec.Text as AT
-- >>> import qualified Data.ByteString.Builder as Builder
-- >>> import qualified Data.Bytes.Builder as UB
-- >>> import qualified Data.Attoparsec.ByteString.Char8 as AB
-- >>> instance Arbitrary IPv4 where { arbitrary = fmap IPv4 arbitrary }
-- >>> instance Arbitrary IPv4.IPv4Range where { arbitrary = IPv4.IPv4Range <$> arbitrary <*> arbitrary }
-- >>> import qualified Data.Bytes.Chunks as Chunks


-- | Create an 'IPv4' address from four octets. The first argument
--   is the most significant octet. The last argument is the least
--   significant. Since IP addresses are commonly written using dot-decimal
--   notation, this is the recommended way to create an IP address.
--   Additionally, it is used for the 'Show' and 'Read' instances
--   of 'IPv4' to help keep things readable in GHCi.
--
--   >>> let addr = IPv4.ipv4 192 168 1 1
--   >>> addr
--   ipv4 192 168 1 1
--   >>> getIPv4 addr
--   3232235777
--
ipv4 :: Word8 -> Word8 -> Word8 -> Word8 -> IPv4
ipv4 :: Word8 -> Word8 -> Word8 -> Word8 -> IPv4
ipv4 = Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets

-- | An alias for the 'ipv4' smart constructor.
fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
a Word8
b Word8
c Word8
d = Word -> Word -> Word -> Word -> IPv4
fromOctets'
  (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)

-- | An uncurried variant of 'fromOctets'.
fromTupleOctets :: (Word8,Word8,Word8,Word8) -> IPv4
fromTupleOctets :: (Word8, Word8, Word8, Word8) -> IPv4
fromTupleOctets (Word8
a,Word8
b,Word8
c,Word8
d) = Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
a Word8
b Word8
c Word8
d

-- | Convert an 'IPv4' address into a quadruple of octets. The first
--   element in the quadruple is the most significant octet. The last
--   element is the least significant octet.
toOctets :: IPv4 -> (Word8,Word8,Word8,Word8)
toOctets :: IPv4 -> (Word8, Word8, Word8, Word8)
toOctets (IPv4 Word32
w) =
  ( forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8)
  , forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
  )

-- | The IP address representing any host.
--
--   >>> IPv4.any
--   ipv4 0 0 0 0
any :: IPv4
any :: IPv4
any = Word32 -> IPv4
IPv4 Word32
0

-- | The local loopback IP address.
--
--   >>> IPv4.loopback
--   ipv4 127 0 0 1
loopback :: IPv4
loopback :: IPv4
loopback = Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
127 Word8
0 Word8
0 Word8
1

-- | A useful and common alias for 'loopback'.
--
--   >>> IPv4.localhost
--   ipv4 127 0 0 1
localhost :: IPv4
localhost :: IPv4
localhost = IPv4
loopback

-- | The broadcast IP address.
--
--   >>> IPv4.broadcast
--   ipv4 255 255 255 255
broadcast :: IPv4
broadcast :: IPv4
broadcast = Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
255 Word8
255 Word8
255 Word8
255

-- | Checks to see if the 'IPv4' address belongs to a private
-- network. The three private networks that are checked are
-- @10.0.0.0/8@, @172.16.0.0/12@, and @192.168.0.0/16@.
private :: IPv4 -> Bool
private :: IPv4 -> Bool
private (IPv4 Word32
w) =
     Word32
mask8  forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
p24
  Bool -> Bool -> Bool
|| Word32
mask12 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
p20
  Bool -> Bool -> Bool
|| Word32
mask16 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
p16

----------------------------------------
-- Note [The implementation of reserved]
----------------------------------------
-- The @reserved@ function has been optimized to perform well in the
-- microbenchmark @CIDR Inclusion/reserved@. We perform an inital case
-- on the upper three bits (8 possible values), which GHC will compile
-- to a jump table. This helps because the reserved ranges of IPv4
-- addresses are somewhat clustered. Notice that everything in
-- 32.0.0.0/3, 64.0.0.0/3, and 128.0.0.0/3 is publicly routable, and
-- everything in 224.0.0.0/3 is reserved. This means that for exactly
-- half of the IPv4 addresses that exist, this single jump is sufficient
-- for determining whether or not they are reserved. For the others,
-- there is a little more work to do, particularly in the 192.0.0.0/3
-- range. On the laptop that ran the microbenchmark, this function
-- decided the reservedness of 100 random IPv4 addresses in 200ns.

-- | Checks to see if the 'IPv4' address belongs to a reserved
-- network. This includes the three private networks that 'private'
-- checks along with several other ranges that are not used
-- on the public Internet. The implementation of this function
-- is optimized.
reserved :: IPv4 -> Bool
reserved :: IPv4 -> Bool
reserved !(IPv4 Word32
w) = case forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
29 of
  Word32
0 ->
    let a :: Word32
a = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
0 Word
0 Word
0 Word
0
        y :: Word32
y = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
10 Word
0 Word
0 Word
0
     in Word32
mask8  forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
a
     Bool -> Bool -> Bool
|| Word32
mask8  forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
y
  Word32
1 -> Bool
False
  Word32
2 -> Bool
False
  Word32
3 ->
    let b :: Word32
b = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
100 Word
64 Word
0 Word
0
        c :: Word32
c = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
127 Word
0 Word
0 Word
0
     in Word32
mask8  forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
c
     Bool -> Bool -> Bool
|| Word32
mask10 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
b
  Word32
4 -> Bool
False
  Word32
5 ->
    let d :: Word32
d = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
169 Word
254 Word
0 Word
0
        x :: Word32
x = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
172 Word
16 Word
0 Word
0
     in Word32
mask12 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
x
     Bool -> Bool -> Bool
|| Word32
mask16 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
d
  Word32
6 ->
    let e :: Word32
e = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
192 Word
0 Word
0 Word
0
        f :: Word32
f = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
192 Word
0 Word
2 Word
0
        g :: Word32
g = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
192 Word
88 Word
99 Word
0
        h :: Word32
h = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
198 Word
18 Word
0 Word
0
        i :: Word32
i = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
198 Word
51 Word
100 Word
0
        j :: Word32
j = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
203 Word
0 Word
113 Word
0
        z :: Word32
z = IPv4 -> Word32
getIPv4 forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
192 Word
168 Word
0 Word
0
     in Word32
mask15 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
h
     Bool -> Bool -> Bool
|| Word32
mask16 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
z
     Bool -> Bool -> Bool
|| Word32
mask24 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
e
     Bool -> Bool -> Bool
|| Word32
mask24 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
f
     Bool -> Bool -> Bool
|| Word32
mask24 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
g
     Bool -> Bool -> Bool
|| Word32
mask24 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
i
     Bool -> Bool -> Bool
|| Word32
mask24 forall a. Bits a => a -> a -> a
.&. Word32
w forall a. Eq a => a -> a -> Bool
== Word32
j
  Word32
_ -> Bool
True

mask8,mask12,mask16,mask10,mask24,mask15 :: Word32
mask8 :: Word32
mask8  = Word32
0xFF000000
mask10 :: Word32
mask10 = Word32
0xFFC00000
mask12 :: Word32
mask12 = Word32
0xFFF00000
mask15 :: Word32
mask15 = Word32
0xFFFE0000
mask16 :: Word32
mask16 = Word32
0xFFFF0000
mask24 :: Word32
mask24 = Word32
0xFFFFFF00

-- | Checks to see if the 'IPv4' address is publicly routable.
--
-- prop> IPv4.public x == not (IPv4.reserved x)
public :: IPv4 -> Bool
public :: IPv4 -> Bool
public = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Bool
reserved

-- | Encode an 'IPv4' address to 'Text' using dot-decimal notation:
--
--   >>> T.putStrLn (IPv4.encode (IPv4.ipv4 192 168 2 47))
--   192.168.2.47
encode :: IPv4 -> Text
encode :: IPv4 -> Text
encode = IPv4 -> Text
toDotDecimalText

-- | Decode an 'IPv4' address.
--
--   >>> IPv4.decode "192.168.2.47"
--   Just (ipv4 192 168 2 47)
--
--   >>> IPv4.decode "10.100.256.256"
--   Nothing
decode :: Text -> Maybe IPv4
decode :: Text -> Maybe IPv4
decode = Text -> Maybe IPv4
decodeIPv4TextMaybe

-- | Encode an 'IPv4' address to a text 'TBuilder.Builder'.
--
--   >>> IPv4.builder (IPv4.ipv4 192 168 2 47)
--   "192.168.2.47"
builder :: IPv4 -> TBuilder.Builder
builder :: IPv4 -> Builder
builder = IPv4 -> Builder
toDotDecimalBuilder

-- | Parse an 'IPv4' address using a 'TextRead.Reader'.
--
--   >>> IPv4.reader "192.168.2.47"
--   Right (ipv4 192 168 2 47,"")
--
--   >>> IPv4.reader "192.168.2.470"
--   Left "All octets in an IPv4 address must be between 0 and 255"
reader :: TextRead.Reader IPv4
reader :: Reader IPv4
reader = Reader IPv4
decodeIPv4TextReader

-- | Parse an 'IPv4' address using a 'AT.Parser'.
--
--   >>> AT.parseOnly IPv4.parser "192.168.2.47"
--   Right (ipv4 192 168 2 47)
--
--   >>> AT.parseOnly IPv4.parser "192.168.2.470"
--   Left "Failed reading: All octets in an IPv4 address must be between 0 and 255"
parser :: AT.Parser IPv4
parser :: Parser IPv4
parser = Parser IPv4
dotDecimalParser

-- | Encode an 'IPv4' address to a UTF-8 encoded 'ByteString'.
--
--   >>> IPv4.encodeUtf8 (IPv4.ipv4 192 168 2 47)
--   "192.168.2.47"
encodeUtf8 :: IPv4 -> ByteString
encodeUtf8 :: IPv4 -> ByteString
encodeUtf8 = IPv4 -> ByteString
toBSPreAllocated

toBSPreAllocated :: IPv4 -> ByteString
toBSPreAllocated :: IPv4 -> ByteString
toBSPreAllocated (IPv4 !Word32
w) = Int -> (Ptr Word8 -> IO Int) -> ByteString
I.unsafeCreateUptoN Int
15 (\Ptr Word8
ptr1 ->
  do Int
len1 <- Ptr Word8 -> Word8 -> IO Int
writeWord Ptr Word8
ptr1 Word8
w1
     let ptr2 :: Ptr Word8
ptr2 = Ptr Word8
ptr1 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len1
     forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr2 Word8
dot
     Int
len2 <- Ptr Word8 -> Word8 -> IO Int
writeWord (Ptr Word8
ptr2 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
w2
     let ptr3 :: Ptr Word8
ptr3 = Ptr Word8
ptr2 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len2 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
     forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr3 Word8
dot
     Int
len3 <- Ptr Word8 -> Word8 -> IO Int
writeWord (Ptr Word8
ptr3 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
w3
     let ptr4 :: Ptr Word8
ptr4 = Ptr Word8
ptr3 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len3 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
     forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr4 Word8
dot
     Int
len4 <- Ptr Word8 -> Word8 -> IO Int
writeWord (Ptr Word8
ptr4 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
w4
     forall (m :: * -> *) a. Monad m => a -> m a
return (Int
3 forall a. Num a => a -> a -> a
+ Int
len1 forall a. Num a => a -> a -> a
+ Int
len2 forall a. Num a => a -> a -> a
+ Int
len3 forall a. Num a => a -> a -> a
+ Int
len4))
  where w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24
        w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16
        w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8
        w4 :: Word8
w4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
        dot :: Word8
dot = Word8
46 :: Word8
        writeWord :: Ptr Word8 -> Word8 -> IO Int
        writeWord :: Ptr Word8 -> Word8 -> IO Int
writeWord !Ptr Word8
ptr !Word8
word
          | Word8
word forall a. Ord a => a -> a -> Bool
>= Word8
100 = do
              let int :: Int
int = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
word
                  indx :: Int
indx = Int
int forall a. Num a => a -> a -> a
+ Int
int forall a. Num a => a -> a -> a
+ Int
int
                  get3 :: Int -> Word8
get3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
ByteString.unsafeIndex ByteString
threeDigits
              forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Int -> Word8
get3 Int
indx)
              forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
get3 (Int
indx forall a. Num a => a -> a -> a
+ Int
1))
              forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Int -> Word8
get3 (Int
indx forall a. Num a => a -> a -> a
+ Int
2))
              forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
          | Word8
word forall a. Ord a => a -> a -> Bool
>= Word8
10 = do
              let int :: Int
int = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
word
                  indx :: Int
indx = Int
int forall a. Num a => a -> a -> a
+ Int
int
                  get2 :: Int -> Word8
get2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
ByteString.unsafeIndex ByteString
twoDigits
              forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Int -> Word8
get2 Int
indx)
              forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
get2 (Int
indx forall a. Num a => a -> a -> a
+ Int
1))
              forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
          | Bool
otherwise = do
              forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Word8
word forall a. Num a => a -> a -> a
+ Word8
48)
              forall (m :: * -> *) a. Monad m => a -> m a
return Int
1

-- | Decode a UTF8-encoded 'ByteString' into an 'IPv4'.
--
--   >>> IPv4.decodeUtf8 "192.168.2.47"
--   Just (ipv4 192 168 2 47)
--
--   Currently not terribly efficient since the implementation
--   re-encodes the argument as UTF-16 text before decoding that
--   IPv4 address from that. PRs to fix this are welcome.
decodeUtf8 :: ByteString -> Maybe IPv4
decodeUtf8 :: ByteString -> Maybe IPv4
decodeUtf8 = Text -> Maybe IPv4
decode forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8'
-- This (decodeUtf8) should be rewritten to not go through text
-- as an intermediary.

-- | Decode 'ShortText' as an 'IPv4' address.
--
--   >>> IPv4.decodeShort "192.168.3.48"
--   Just (ipv4 192 168 3 48)
decodeShort :: ShortText -> Maybe IPv4
decodeShort :: ShortText -> Maybe IPv4
decodeShort ShortText
t = Bytes -> Maybe IPv4
decodeUtf8Bytes (ByteArray -> Bytes
Bytes.fromByteArray ByteArray
b)
  where b :: ByteArray
b = ShortByteString -> ByteArray
shortByteStringToByteArray (ShortText -> ShortByteString
TS.toShortByteString ShortText
t)

-- | Encode an 'IPv4' address as 'ShortText'.
--
--   >>> IPv4.encodeShort (IPv4.ipv4 192 168 5 99)
--   "192.168.5.99"
encodeShort :: IPv4 -> ShortText
encodeShort :: IPv4 -> ShortText
encodeShort !IPv4
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
$ IPv4 -> Builder 15
boundedBuilderUtf8
  forall a b. (a -> b) -> a -> b
$ IPv4
w

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

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

-- | Decode UTF-8-encoded 'Bytes' into an 'IPv4' address.
--
--   >>> IPv4.decodeUtf8Bytes (Ascii.fromString "127.0.0.1")
--   Just (ipv4 127 0 0 1)
decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv4
decodeUtf8Bytes :: Bytes -> Maybe IPv4
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 IPv4
parserUtf8Bytes ()) Bytes
b of
  Parser.Success (Parser.Slice Int
_ Int
len IPv4
addr) -> case Int
len of
    Int
0 -> forall a. a -> Maybe a
Just IPv4
addr
    Int
_ -> forall a. Maybe a
Nothing
  Parser.Failure ()
_ -> forall a. Maybe a
Nothing

-- | Parse UTF-8-encoded 'Bytes' as an 'IPv4' address.
--
--   >>> Parser.parseBytes (IPv4.parserUtf8Bytes ()) (Ascii.fromString "10.0.1.254")
--   Success (Slice {offset = 10, length = 0, value = ipv4 10 0 1 254})
parserUtf8Bytes :: e -> Parser.Parser e s IPv4
{-# inline parserUtf8Bytes #-}
parserUtf8Bytes :: forall e s. e -> Parser e s IPv4
parserUtf8Bytes e
e = coerce :: forall a b. Coercible a b => a -> b
coerce (forall e s. Parser e s Word# -> Parser e s Word32
Parser.boxWord32 (forall e s. e -> Parser e s Word#
parserUtf8Bytes# e
e))

-- | Variant of 'parserUtf8Bytes' with unboxed result type.
parserUtf8Bytes# :: e -> Parser.Parser e s IPv4#
{-# noinline parserUtf8Bytes# #-}
parserUtf8Bytes# :: forall e s. e -> Parser e s Word#
parserUtf8Bytes# e
e = forall e s. Parser e s Word32 -> Parser e s Word#
Parser.unboxWord32 forall a b. (a -> b) -> a -> b
$ do
  !Word8
a <- forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'.'
  !Word8
b <- forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'.'
  !Word8
c <- forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'.'
  !Word8
d <- forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv4 -> Word32
getIPv4 (Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
a Word8
b Word8
c Word8
d))

-- | Parse UTF-8-encoded 'Bytes' into an 'IPv4Range'.
-- This requires the mask to be present.
--
-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8Bytes ()) (Ascii.fromString "192.168.0.0/16")
-- 192.168.0.0/16
-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8Bytes ()) (Ascii.fromString "10.10.10.1")
-- nope
--
-- See 'parserRangeUtf8BytesLenient' for a variant that treats
-- a missing mask as a @/32@ mask.
parserRangeUtf8Bytes :: e -> Parser.Parser e s IPv4Range
parserRangeUtf8Bytes :: forall e s. e -> Parser e s IPv4Range
parserRangeUtf8Bytes e
e = do
  IPv4
base <- forall e s. e -> Parser e s IPv4
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
32
    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
$! IPv4Range -> IPv4Range
normalize (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
base Word8
theMask)

-- | Variant of 'parserRangeUtf8Bytes' that allows the mask
-- to be omitted. An omitted mask is treated as a @/32@ mask.
--
-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8BytesLenient ()) (Ascii.fromString "192.168.0.0/16")
-- 192.168.0.0/16
-- >>> maybe (putStrLn "nope") IPv4.printRange $ Parser.parseBytesMaybe (IPv4.parserRangeUtf8BytesLenient ()) (Ascii.fromString "10.10.10.1")
-- 10.10.10.1/32
parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv4Range
parserRangeUtf8BytesLenient :: forall e s. e -> Parser e s IPv4Range
parserRangeUtf8BytesLenient e
e = do
  IPv4
base <- forall e s. e -> Parser e s IPv4
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
32
        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
$! IPv4Range -> IPv4Range
normalize (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
base Word8
theMask)
    Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
base Word8
32

-- | Encode an 'IPv4' as a bytestring 'Builder.Builder'
--
-- >>> Builder.toLazyByteString (IPv4.builderUtf8 (IPv4.fromOctets 192 168 2 12))
-- "192.168.2.12"
builderUtf8 :: IPv4 -> Builder.Builder
builderUtf8 :: IPv4 -> Builder
builderUtf8 = ByteString -> Builder
Builder.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> ByteString
encodeUtf8

-- | Encode an 'IPv4' address as a unbounded byte array builder.
--
-- >>> Chunks.concat (UB.run 1 (IPv4.byteArrayBuilderUtf8 (IPv4.fromOctets 192 168 2 13)))
-- [0x31,0x39,0x32,0x2e,0x31,0x36,0x38,0x2e,0x32,0x2e,0x31,0x33]
--
-- Note that period is encoded by UTF-8 as @0x2e@.
byteArrayBuilderUtf8 :: IPv4 -> UB.Builder
byteArrayBuilderUtf8 :: IPv4 -> Builder
byteArrayBuilderUtf8 = forall (n :: Nat). Nat n -> Builder n -> Builder
UB.fromBounded forall (n :: Nat). KnownNat n => Nat n
Nat.constant forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Builder 15
boundedBuilderUtf8

-- | Encode an 'IPv4' address as a bounded byte array builder.
--
-- >>> BB.run Nat.constant (IPv4.boundedBuilderUtf8 (IPv4.fromOctets 192 168 2 14))
-- [0x31, 0x39, 0x32, 0x2e, 0x31, 0x36, 0x38, 0x2e, 0x32, 0x2e, 0x31, 0x34]
--
-- Note that period is encoded by UTF-8 as @0x2e@.
boundedBuilderUtf8 :: IPv4 -> BB.Builder 15
boundedBuilderUtf8 :: IPv4 -> Builder 15
boundedBuilderUtf8 (IPv4 !Word32
w) =
  Word8 -> Builder 3
BB.word8Dec Word8
w1
  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`
  Word8 -> Builder 3
BB.word8Dec Word8
w2
  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`
  Word8 -> Builder 3
BB.word8Dec Word8
w3
  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`
  Word8 -> Builder 3
BB.word8Dec Word8
w4
  where
  w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24) :: Word8
  w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8
  w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8) :: Word8
  w4 :: Word8
w4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w :: Word8

-- | Encode 'IPv4' address to a sequence a 4 bytes with the first
-- byte representing corresponding to the most significant byte in
-- the address.
--
-- >>> BB.run Nat.constant (IPv4.boundedBuilderOctetsBE (IPv4.fromOctets 0xc0 0xa8 0x02 0x1f))
-- [0xc0, 0xa8, 0x02, 0x1f]
boundedBuilderOctetsBE :: IPv4 -> BB.Builder 4
{-# inline boundedBuilderOctetsBE #-}
boundedBuilderOctetsBE :: IPv4 -> Builder 4
boundedBuilderOctetsBE (IPv4 !Word32
w) =
  Word8 -> Builder 1
BB.word8 Word8
w1
  forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 1
BB.word8 Word8
w2
  forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 1
BB.word8 Word8
w3
  forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 1
BB.word8 Word8
w4
  where
  w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24) :: Word8
  w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8
  w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8) :: Word8
  w4 :: Word8
w4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w :: Word8

-- | Encode 'IPv4' address to a sequence a 4 bytes with the first
-- byte representing corresponding to the least significant byte in
-- the address.
--
-- >>> BB.run Nat.constant (IPv4.boundedBuilderOctetsLE (IPv4.fromOctets 0xc0 0xa8 0x02 0x1f))
-- [0x1f, 0x02, 0xa8, 0xc0]
boundedBuilderOctetsLE :: IPv4 -> BB.Builder 4
{-# inline boundedBuilderOctetsLE #-}
boundedBuilderOctetsLE :: IPv4 -> Builder 4
boundedBuilderOctetsLE (IPv4 !Word32
w) =
  Word8 -> Builder 1
BB.word8 Word8
w4
  forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 1
BB.word8 Word8
w3
  forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 1
BB.word8 Word8
w2
  forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 1
BB.word8 Word8
w1
  where
  w1 :: Word8
w1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24) :: Word8
  w2 :: Word8
w2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8
  w3 :: Word8
w3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8) :: Word8
  w4 :: Word8
w4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w :: Word8

-- | Parse an 'IPv4' using a 'AB.Parser'.
--
--   >>> AB.parseOnly IPv4.parserUtf8 "192.168.2.47"
--   Right (ipv4 192 168 2 47)
--
--   >>> AB.parseOnly IPv4.parserUtf8 "192.168.2.470"
--   Left "Failed reading: All octets in an ipv4 address must be between 0 and 255"
parserUtf8 :: AB.Parser IPv4
parserUtf8 :: Parser IPv4
parserUtf8 = Word -> Word -> Word -> Word -> IPv4
fromOctets'
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Integral a => Parser a
AB.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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AB.char Char
'.'
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Integral a => Parser a
AB.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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AB.char Char
'.'
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Integral a => Parser a
AB.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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AB.char Char
'.'
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Integral a => Parser a
AB.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)
  where
  limitSize :: a -> m a
limitSize a
i =
    if a
i forall a. Ord a => a -> a -> Bool
> a
255
      then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"All octets in an ipv4 address must be between 0 and 255"
      else forall (m :: * -> *) a. Monad m => a -> m a
return a
i

{- $string

    These functions exist for the convenience of those who need a
    'String' representation of an 'IPv4' address. Using them
    is discouraged unless the end user is working with a library
    that can only use 'String' to deal with textual data (such as
    @pandoc@, @hxr@, or @network@).

-}

-- | Encode an 'IPv4' as a 'String'.
encodeString :: IPv4 -> String
encodeString :: IPv4 -> String
encodeString = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Text
encode

-- | Decode an 'IPv4' from a 'String'.
decodeString :: String -> Maybe IPv4
decodeString :: String -> Maybe IPv4
decodeString = Text -> Maybe IPv4
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack


-- | Unboxed variant of 'IPv4'. Before GHC 8.10, this is
-- implemented as a type synonym. Portable use of this type requires
-- treating it as though it were opaque. Use 'box' and 'unbox' to
-- convert between this and the lifted 'IPv4'.
type IPv4# = Word#

-- | Convert an unboxed IPv4 address to a boxed one.
box :: IPv4# -> IPv4
{-# inline box #-}
box :: Word# -> IPv4
box Word#
w = Word32 -> IPv4
IPv4 (Word# -> Word32
Compat.W32# Word#
w)

-- | Convert a boxed IPv4 address to an unboxed one.
unbox :: IPv4 -> IPv4#
{-# inline unbox #-}
unbox :: IPv4 -> Word#
unbox (IPv4 (Compat.W32# Word#
w)) = Word#
w

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

instance NFData IPv4

instance Show IPv4 where
  showsPrec :: Int -> IPv4 -> ShowS
showsPrec Int
p IPv4
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
"ipv4 "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
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
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
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
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
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
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
d
    where
    (Word8
a,Word8
b,Word8
c,Word8
d) = IPv4 -> (Word8, Word8, Word8, Word8)
toOctets IPv4
addr

instance Read IPv4 where
  readPrec :: ReadPrec IPv4
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
"ipv4" <- ReadPrec Lexeme
lexP
    Word8
a <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word8
b <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word8
c <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    Word8
d <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
    forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
a Word8
b Word8
c Word8
d)

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

newtype instance UVector.MVector s IPv4 = MV_IPv4 (PVector.MVector s IPv4)
newtype instance UVector.Vector IPv4 = V_IPv4 (PVector.Vector IPv4)

instance UVector.Unbox IPv4

instance MGVector.MVector UVector.MVector IPv4 where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicInitialize #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength :: forall s. MVector s IPv4 -> Int
basicLength (MV_IPv4 MVector s IPv4
v) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MGVector.basicLength MVector s IPv4
v
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s IPv4 -> MVector s IPv4
basicUnsafeSlice Int
i Int
n (MV_IPv4 MVector s IPv4
v) = forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 forall a b. (a -> b) -> a -> b
$ forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
MGVector.basicUnsafeSlice Int
i Int
n MVector s IPv4
v
  basicOverlaps :: forall s. MVector s IPv4 -> MVector s IPv4 -> Bool
basicOverlaps (MV_IPv4 MVector s IPv4
v1) (MV_IPv4 MVector s IPv4
v2) = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MGVector.basicOverlaps MVector s IPv4
v1 MVector s IPv4
v2
  basicUnsafeNew :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (MVector (PrimState m) IPv4)
basicUnsafeNew Int
n = forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n
  basicInitialize :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> m ()
basicInitialize (MV_IPv4 MVector (PrimState m) IPv4
v) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) IPv4
v
  basicUnsafeReplicate :: forall (m :: * -> *).
PrimMonad m =>
Int -> IPv4 -> m (MVector (PrimState m) IPv4)
basicUnsafeReplicate Int
n IPv4
x = forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n IPv4
x
  basicUnsafeRead :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> Int -> m IPv4
basicUnsafeRead (MV_IPv4 MVector (PrimState m) IPv4
v) Int
i = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
MGVector.basicUnsafeRead MVector (PrimState m) IPv4
v Int
i
  basicUnsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> Int -> IPv4 -> m ()
basicUnsafeWrite (MV_IPv4 MVector (PrimState m) IPv4
v) Int
i IPv4
x = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
MGVector.basicUnsafeWrite MVector (PrimState m) IPv4
v Int
i IPv4
x
  basicClear :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> m ()
basicClear (MV_IPv4 MVector (PrimState m) IPv4
v) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) IPv4
v
  basicSet :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> IPv4 -> m ()
basicSet (MV_IPv4 MVector (PrimState m) IPv4
v) IPv4
x = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MGVector.basicSet MVector (PrimState m) IPv4
v IPv4
x
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
basicUnsafeCopy (MV_IPv4 MVector (PrimState m) IPv4
v1) (MV_IPv4 MVector (PrimState m) IPv4
v2) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeCopy MVector (PrimState m) IPv4
v1 MVector (PrimState m) IPv4
v2
  basicUnsafeMove :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
basicUnsafeMove (MV_IPv4 MVector (PrimState m) IPv4
v1) (MV_IPv4 MVector (PrimState m) IPv4
v2) = forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeMove MVector (PrimState m) IPv4
v1 MVector (PrimState m) IPv4
v2
  basicUnsafeGrow :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4 -> Int -> m (MVector (PrimState m) IPv4)
basicUnsafeGrow (MV_IPv4 MVector (PrimState m) IPv4
v) Int
n = forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
MGVector.basicUnsafeGrow MVector (PrimState m) IPv4
v Int
n

instance GVector.Vector UVector.Vector IPv4 where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) IPv4 -> m (Vector IPv4)
basicUnsafeFreeze (MV_IPv4 MVector (PrimState m) IPv4
v) = Vector IPv4 -> Vector IPv4
V_IPv4 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) IPv4
v
  basicUnsafeThaw :: forall (m :: * -> *).
PrimMonad m =>
Vector IPv4 -> m (Mutable Vector (PrimState m) IPv4)
basicUnsafeThaw (V_IPv4 Vector IPv4
v) = forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
GVector.basicUnsafeThaw Vector IPv4
v
  basicLength :: Vector IPv4 -> Int
basicLength (V_IPv4 Vector IPv4
v) = forall (v :: * -> *) a. Vector v a => v a -> Int
GVector.basicLength Vector IPv4
v
  basicUnsafeSlice :: Int -> Int -> Vector IPv4 -> Vector IPv4
basicUnsafeSlice Int
i Int
n (V_IPv4 Vector IPv4
v) = Vector IPv4 -> Vector IPv4
V_IPv4 forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i Int
n Vector IPv4
v
  basicUnsafeIndexM :: forall (m :: * -> *). Monad m => Vector IPv4 -> Int -> m IPv4
basicUnsafeIndexM (V_IPv4 Vector IPv4
v) Int
i = forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector IPv4
v Int
i
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) IPv4 -> Vector IPv4 -> m ()
basicUnsafeCopy (MV_IPv4 MVector (PrimState m) IPv4
mv) (V_IPv4 Vector IPv4
v) = forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) IPv4
mv Vector IPv4
v
  elemseq :: forall b. Vector IPv4 -> IPv4 -> b -> b
elemseq Vector IPv4
_ = seq :: forall a b. a -> b -> b
seq

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

instance FromJSON IPv4 where
  parseJSON :: Value -> Parser IPv4
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"IPv4" Text -> Parser IPv4
aesonParser

instance ToJSONKey IPv4 where
  toJSONKey :: ToJSONKeyFunction IPv4
toJSONKey = forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText
    (Text -> Key
keyFromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Text
encode)
    (\IPv4
addr -> forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding forall a b. (a -> b) -> a -> b
$ Char -> Builder
Builder.char7 Char
'"' forall a. Semigroup a => a -> a -> a
<> IPv4 -> Builder
builderUtf8 IPv4
addr forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
'"')
    where
#if MIN_VERSION_aeson(2,0,0)
      keyFromText :: Text -> Key
keyFromText = Text -> Key
AesonKey.fromText
#else
      keyFromText = id
#endif

instance FromJSONKey IPv4 where
  fromJSONKey :: FromJSONKeyFunction IPv4
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser IPv4
aesonParser

aesonParser :: Text -> Aeson.Parser IPv4
aesonParser :: Text -> Parser IPv4
aesonParser Text
t = case Text -> Maybe IPv4
decode Text
t of
  Maybe IPv4
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse IPv4 address"
  Just IPv4
addr -> forall (m :: * -> *) a. Monad m => a -> m a
return IPv4
addr

------------------------------------
-- Internal functions, not exported
------------------------------------

decodeIPv4TextMaybe :: Text -> Maybe IPv4
decodeIPv4TextMaybe :: Text -> Maybe IPv4
decodeIPv4TextMaybe Text
t = case Reader IPv4
decodeIPv4TextReader Text
t of
  Left String
_ -> forall a. Maybe a
Nothing
  Right (IPv4
w,Text
t') -> if Text -> Bool
Text.null Text
t'
    then forall a. a -> Maybe a
Just IPv4
w
    else forall a. Maybe a
Nothing

decodeIPv4TextReader :: TextRead.Reader IPv4
decodeIPv4TextReader :: Reader IPv4
decodeIPv4TextReader Text
t1' = do
  (Word
a,Text
t2) <- Reader Word
readOctet Text
t1'
  Text
t2' <- Text -> Either String Text
stripDecimal Text
t2
  (Word
b,Text
t3) <- Reader Word
readOctet Text
t2'
  Text
t3' <- Text -> Either String Text
stripDecimal Text
t3
  (Word
c,Text
t4) <- Reader Word
readOctet Text
t3'
  Text
t4' <- Text -> Either String Text
stripDecimal Text
t4
  (Word
d,Text
t5) <- Reader Word
readOctet Text
t4'
  forall a b. b -> Either a b
Right (Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
a Word
b Word
c Word
d,Text
t5)

-- | Read an IPv4 octet (@0 <= n <= 255@)
--
-- The input must begin with at least one decimal digit.  Input is consumed
-- until a non-digit is reached, the end of the input is reached, or the
-- accumulated value exceeds the maximum bound (255).  As with
-- 'TextRead.decimal', any number of leading zeros are permitted.
--
-- Optimizations:
--
-- * The 'Char.isDigit' and 'Char.digitToInt' functions are avoided in order
--   to avoiding checking the range more than once.  This implementation calls
--   'Char.ord' (once) and uses the result for both the range check and the
--   calculation.
-- * The type of the accumulated value is 'Int', allowing for a single
--   'fromIntegral' call instead of one for each digit.  This is possible
--   because the maximum bound (255) is sufficiently less than the maximum
--   bound of 'Int'.  Specifically: @255 * 10 + Char.ord '9' <= maxBound@
-- * This implementation does not make use of @UnboxedTuples@ because the
--   @span_@ function is part of the internal API.  Additional performance
--   could be gained by using this internal API function.
readOctet :: TextRead.Reader Word
readOctet :: Reader Word
readOctet Text
t = do
  let (Text
digits, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
Text.span Char -> Bool
Char.isDigit Text
t
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
Text.null Text
digits) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"octet does not start with a digit"
  case forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> (Int -> Maybe Int) -> Int -> Maybe Int
go forall a. a -> Maybe a
Just Text
digits Int
0 of
    Just Int
n  -> forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Text
rest)
    Maybe Int
Nothing -> forall a b. a -> Either a b
Left String
ipOctetSizeErrorMsg
  where
  go :: Char -> (Int -> Maybe Int) -> Int -> Maybe Int
  go :: Char -> (Int -> Maybe Int) -> Int -> Maybe Int
go !Char
d !Int -> Maybe Int
f !Int
n =
    let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
* Int
10 forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
d forall a. Num a => a -> a -> a
- Int
48
    in  if Int
n' forall a. Ord a => a -> a -> Bool
<= Int
255 then Int -> Maybe Int
f Int
n' else forall a. Maybe a
Nothing

stripDecimal :: Text -> Either String Text
stripDecimal :: Text -> Either String Text
stripDecimal Text
t = case Text -> Maybe (Char, Text)
Text.uncons Text
t of
  Maybe (Char, Text)
Nothing -> forall a b. a -> Either a b
Left String
"expected a dot but input ended instead"
  Just (Char
c,Text
tnext) -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'
    then forall a b. b -> Either a b
Right Text
tnext
    else forall a b. a -> Either a b
Left String
"expected a dot but found a different character"

-- | This is sort of a misnomer. It takes Word to make
--   dotDecimalParser perform better. This is mostly
--   for internal use. The arguments must all fit
--   in a Word8.
fromOctets' :: Word -> Word -> Word -> Word -> IPv4
fromOctets' :: Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
a Word
b Word
c Word
d = Word32 -> IPv4
IPv4 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral
    ( forall a. Bits a => a -> Int -> a
shiftL Word
a Int
24
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word
b Int
16
  forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word
c Int
8
  forall a. Bits a => a -> a -> a
.|. Word
d
    )

p24 :: Word32
p24 :: Word32
p24 = IPv4 -> Word32
getIPv4 (Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
10 Word
0 Word
0 Word
0)

p20 :: Word32
p20 :: Word32
p20 = IPv4 -> Word32
getIPv4 (Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
172 Word
16 Word
0 Word
0)

p16 :: Word32
p16 :: Word32
p16 = IPv4 -> Word32
getIPv4 (Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
192 Word
168 Word
0 Word
0)

-- | This does not do an endOfInput check because it is
-- reused in the range parser implementation.
dotDecimalParser :: AT.Parser IPv4
dotDecimalParser :: Parser IPv4
dotDecimalParser = Word -> Word -> Word -> Word -> IPv4
fromOctets'
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AT.char Char
'.'
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AT.char Char
'.'
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AT.char Char
'.'
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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)
  where
  limitSize :: a -> m a
limitSize a
i =
    if a
i forall a. Ord a => a -> a -> Bool
> a
255
      then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
ipOctetSizeErrorMsg
      else forall (m :: * -> *) a. Monad m => a -> m a
return a
i

ipOctetSizeErrorMsg :: String
ipOctetSizeErrorMsg :: String
ipOctetSizeErrorMsg = String
"All octets in an IPv4 address must be between 0 and 255"

toDotDecimalText :: IPv4 -> Text
toDotDecimalText :: IPv4 -> Text
toDotDecimalText = IPv4 -> Text
toTextPreAllocated

toDotDecimalBuilder :: IPv4 -> TBuilder.Builder
toDotDecimalBuilder :: IPv4 -> Builder
toDotDecimalBuilder = Text -> Builder
TBuilder.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Text
toTextPreAllocated

-- | I think that this function can be improved. Right now, it
--   always allocates enough space for a fifteen-character text
--   rendering of an IP address. I think that it should be possible
--   to do more of the math upfront and allocate less space.
toTextPreAllocated :: IPv4 -> Text
toTextPreAllocated :: IPv4 -> Text
toTextPreAllocated (IPv4 Word32
w) =
  let w1 :: Word
w1 = Word
255 forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> Int -> a
unsafeShiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
24
      w2 :: Word
w2 = Word
255 forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> Int -> a
unsafeShiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
16
      w3 :: Word
w3 = Word
255 forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> Int -> a
unsafeShiftR (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
8
      w4 :: Word
w4 = Word
255 forall a. Bits a => a -> a -> a
.&. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
   in Word -> Word -> Word -> Word -> Text
toTextPreallocatedPartTwo Word
w1 Word
w2 Word
w3 Word
w4

toTextPreallocatedPartTwo :: Word -> Word -> Word -> Word -> Text
toTextPreallocatedPartTwo :: Word -> Word -> Word -> Word -> Text
toTextPreallocatedPartTwo !Word
w1 !Word
w2 !Word
w3 !Word
w4 =
#ifdef ghcjs_HOST_OS
  let dotStr = "."
   in Text.pack $ concat
        [ show w1
        , "."
        , show w2
        , "."
        , show w3
        , "."
        , show w4
        ]
#else
  let dot :: Codepoint
dot = Codepoint
46
      (Array
arr,Int
len) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MArray s
marr <- forall s. Int -> ST s (MArray s)
TArray.new Int
15
        Int
i1 <- forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
0 Word
w1 MArray s
marr
        let n1 :: Int
n1 = Int
i1
            n1' :: Int
n1' = Int
i1 forall a. Num a => a -> a -> a
+ Int
1
        forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr Int
n1 Codepoint
dot
        Int
i2 <- forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
n1' Word
w2 MArray s
marr
        let n2 :: Int
n2 = Int
i2 forall a. Num a => a -> a -> a
+ Int
n1'
            n2' :: Int
n2' = Int
n2 forall a. Num a => a -> a -> a
+ Int
1
        forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr Int
n2 Codepoint
dot
        Int
i3 <- forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
n2' Word
w3 MArray s
marr
        let n3 :: Int
n3 = Int
i3 forall a. Num a => a -> a -> a
+ Int
n2'
            n3' :: Int
n3' = Int
n3 forall a. Num a => a -> a -> a
+ Int
1
        forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr Int
n3 Codepoint
dot
        Int
i4 <- forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
n3' Word
w4 MArray s
marr
        Array
theArr <- forall s. MArray s -> ST s Array
TArray.unsafeFreeze MArray s
marr
        forall (m :: * -> *) a. Monad m => a -> m a
return (Array
theArr,Int
i4 forall a. Num a => a -> a -> a
+ Int
n3')
   in Array -> Int -> Int -> Text
Text Array
arr Int
0 Int
len
#endif

twoDigits :: ByteString
twoDigits :: ByteString
twoDigits = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> ByteString
BC8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"%02d") forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
enumFromTo (Int
0 :: Int) Int
99
{-# NOINLINE twoDigits #-}

threeDigits :: ByteString
threeDigits :: ByteString
threeDigits = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> ByteString
BC8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"%03d") forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
enumFromTo (Int
0 :: Int) Int
999
{-# NOINLINE threeDigits #-}

i2w :: Integral a => a -> Codepoint
i2w :: forall a. Integral a => a -> Codepoint
i2w a
v = Codepoint
zero forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v

zero :: Codepoint
zero :: Codepoint
zero = Codepoint
48

putAndCount :: Int -> Word -> TArray.MArray s -> ST s Int
putAndCount :: forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
pos Word
w MArray s
marr
  | Word
w forall a. Ord a => a -> a -> Bool
< Word
10 = forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr Int
pos (forall a. Integral a => a -> Codepoint
i2w Word
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
  | Word
w forall a. Ord a => a -> a -> Bool
< Word
100 = Int -> Word -> ST s ()
write2 Int
pos Word
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
  | Bool
otherwise = Int -> Word -> ST s ()
write3 Int
pos Word
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
  where
  write2 :: Int -> Word -> ST s ()
write2 Int
off Word
i0 = do
    let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i0; j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i
    forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr Int
off forall a b. (a -> b) -> a -> b
$ Int -> Codepoint
get2 Int
j
    forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ Int -> Codepoint
get2 (Int
j forall a. Num a => a -> a -> a
+ Int
1)
  write3 :: Int -> Word -> ST s ()
write3 Int
off Word
i0 = do
    let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i0; j :: Int
j = Int
i forall a. Num a => a -> a -> a
+ Int
i forall a. Num a => a -> a -> a
+ Int
i
    forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr Int
off forall a b. (a -> b) -> a -> b
$ Int -> Codepoint
get3 Int
j
    forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ Int -> Codepoint
get3 (Int
j forall a. Num a => a -> a -> a
+ Int
1)
    forall s. MArray s -> Int -> Codepoint -> ST s ()
TArray.unsafeWrite MArray s
marr (Int
off forall a. Num a => a -> a -> a
+ Int
2) forall a b. (a -> b) -> a -> b
$ Int -> Codepoint
get3 (Int
j forall a. Num a => a -> a -> a
+ Int
2)
  get2 :: Int -> Codepoint
get2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
ByteString.unsafeIndex ByteString
twoDigits
  get3 :: Int -> Codepoint
get3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
ByteString.unsafeIndex ByteString
threeDigits

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

{- $interoperability

The @<http://hackage.haskell.org/package/network network>@ library is commonly
used to open sockets and communicate over them. In the @Network.Socket@ module,
it provides a type synonym @HostAddress@ that, like 'IPv4', is used
to represent an IPv4 address. However, while 'IPv4' uses a big-endian representation
for ip addresses, @HostAddress@ has platform dependent endianness.
Consequently, it is necessary to convert between the two as follows:

> import Network.Socket (HostAddress,htonl,ntohl)
>
> toHostAddr :: IPv4 -> HostAddress
> toHostAddr (IPv4 w) = htonl w
>
> fromHostAddr :: HostAddress -> IPv4
> fromHostAddr w = IPv4 (ntohl w)

These functions are not included with this library since it would require
picking up a dependency on @network@.

-}

-- $setup
--
-- These are here to get doctest's property checking to work.
--
-- >>> import qualified Prelude as P
-- >>> import qualified Data.Text.IO as T
-- >>> import Net.IPv4 (fromOctets,ipv4)
-- >>> import Test.QuickCheck (Arbitrary(..))
-- >>> instance Arbitrary IPv4 where { arbitrary = fmap IPv4 arbitrary }
-- >>> instance Arbitrary IPv4Range where { arbitrary = IPv4Range <$> arbitrary <*> arbitrary }
--

-- | Smart constructor for 'IPv4Range'. Ensures the mask is appropriately
--   sized and sets masked bits in the 'IPv4' to zero.
range :: IPv4 -> Word8 -> IPv4Range
range :: IPv4 -> Word8 -> IPv4Range
range IPv4
addr Word8
len = IPv4Range -> IPv4Range
normalize (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
addr Word8
len)

-- | Given an inclusive lower and upper ip address, create the smallest
-- 'IPv4Range' that contains the two. This is helpful in situations where
-- input given as a range like @192.168.16.0-192.168.19.255@ needs to be
-- handled. This makes the range broader if it cannot be represented in
-- CIDR notation.
--
-- >>> IPv4.printRange $ IPv4.fromBounds (IPv4.fromOctets 192 168 16 0) (IPv4.fromOctets 192 168 19 255)
-- 192.168.16.0/22
-- >>> IPv4.printRange $ IPv4.fromBounds (IPv4.fromOctets 10 0 5 7) (IPv4.fromOctets 10 0 5 14)
-- 10.0.5.0/28
fromBounds :: IPv4 -> IPv4 -> IPv4Range
fromBounds :: IPv4 -> IPv4 -> IPv4Range
fromBounds (IPv4 Word32
a) (IPv4 Word32
b) =
  IPv4Range -> IPv4Range
normalize (IPv4 -> Word8 -> IPv4Range
IPv4Range (Word32 -> IPv4
IPv4 Word32
a) (Word32 -> Word32 -> Word8
maskFromBounds Word32
a Word32
b))

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

-- | Checks to see if an 'IPv4' address belongs in the 'IPv4Range'.
--
-- >>> let ip = IPv4.fromOctets 10 10 1 92
-- >>> IPv4.contains (IPv4.IPv4Range (IPv4.fromOctets 10 0 0 0) 8) ip
-- True
-- >>> IPv4.contains (IPv4.IPv4Range (IPv4.fromOctets 10 11 0 0) 16) 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 = IPv4.IPv4Range (IPv4.fromOctets 10 10 10 6) 31
-- >>> mapM_ (P.print . IPv4.contains r) (take 5 $ iterate succ $ IPv4.fromOctets 10 10 10 5)
-- False
-- True
-- True
-- 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 :: IPv4Range -> IPv4 -> Bool
contains :: IPv4Range -> IPv4 -> Bool
contains (IPv4Range (IPv4 Word32
wsubnet) Word8
len) =
  let theMask :: Word32
theMask = Word8 -> Word32
mask Word8
len
      wsubnetNormalized :: Word32
wsubnetNormalized = Word32
wsubnet forall a. Bits a => a -> a -> a
.&. Word32
theMask
   in \(IPv4 Word32
w) -> (Word32
w forall a. Bits a => a -> a -> a
.&. Word32
theMask) forall a. Eq a => a -> a -> Bool
== Word32
wsubnetNormalized

mask :: Word8 -> Word32
mask :: Word8 -> Word32
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 Word32
0xffffffff forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

-- | The inclusive lower bound of an 'IPv4Range'. This is conventionally
--   understood to be the broadcast address of a subnet. For example:
--
-- >>> T.putStrLn $ IPv4.encode $ IPv4.lowerInclusive $ IPv4.IPv4Range (IPv4.ipv4 10 10 1 160) 25
-- 10.10.1.128
--
-- Note that the lower bound of a normalized 'IPv4Range' is simply the
-- ip address of the range:
--
-- prop> IPv4.lowerInclusive r == IPv4.ipv4RangeBase (IPv4.normalize r)
lowerInclusive :: IPv4Range -> IPv4
lowerInclusive :: IPv4Range -> IPv4
lowerInclusive (IPv4Range (IPv4 Word32
w) Word8
len) =
  Word32 -> IPv4
IPv4 (Word32
w forall a. Bits a => a -> a -> a
.&. Word8 -> Word32
mask Word8
len)

-- | The inclusive upper bound of an 'IPv4Range'.
--
--   >>> T.putStrLn $ IPv4.encode $ IPv4.upperInclusive $ IPv4.IPv4Range (IPv4.ipv4 10 10 1 160) 25
--   10.10.1.255
upperInclusive :: IPv4Range -> IPv4
upperInclusive :: IPv4Range -> IPv4
upperInclusive (IPv4Range (IPv4 Word32
w) Word8
len) =
  let theInvertedMask :: Word32
theInvertedMask = forall a. Bits a => a -> Int -> a
shiftR Word32
0xffffffff (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
      theMask :: Word32
theMask = forall a. Bits a => a -> a
complement Word32
theInvertedMask
   in Word32 -> IPv4
IPv4 ((Word32
w forall a. Bits a => a -> a -> a
.&. Word32
theMask) forall a. Bits a => a -> a -> a
.|. Word32
theInvertedMask)

-- Given the size of the mask, return the total number of ips in the subnet. This
-- only works for IPv4 addresses because an IPv6 subnet can have up to 2^128
-- addresses. Not exported.
countAddrs :: Word8 -> Word64
countAddrs :: Word8 -> Word64
countAddrs Word8
w =
  let amountToShift :: Int
amountToShift = if Word8
w forall a. Ord a => a -> a -> Bool
> Word8
32
        then Int
0
        else Int
32 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
   in forall a. Bits a => a -> Int -> a
shift Word64
1 Int
amountToShift

wordSuccessors :: Word64 -> IPv4 -> [IPv4]
wordSuccessors :: Word64 -> IPv4 -> [IPv4]
wordSuccessors !Word64
w (IPv4 !Word32
a) = if Word64
w forall a. Ord a => a -> a -> Bool
> Word64
0
  then Word32 -> IPv4
IPv4 Word32
a forall a. a -> [a] -> [a]
: Word64 -> IPv4 -> [IPv4]
wordSuccessors (Word64
w forall a. Num a => a -> a -> a
- Word64
1) (Word32 -> IPv4
IPv4 (Word32
a forall a. Num a => a -> a -> a
+ Word32
1))
  else []

wordSuccessorsM :: MonadPlus m => Word64 -> IPv4 -> m IPv4
wordSuccessorsM :: forall (m :: * -> *). MonadPlus m => Word64 -> IPv4 -> m IPv4
wordSuccessorsM = forall {t} {m :: * -> *}.
(Ord t, Num t, MonadPlus m) =>
t -> IPv4 -> m IPv4
go where
  go :: t -> IPv4 -> m IPv4
go !t
w (IPv4 !Word32
a) = if t
w forall a. Ord a => a -> a -> Bool
> t
0
    then forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IPv4
IPv4 Word32
a)) (t -> IPv4 -> m IPv4
go (t
w forall a. Num a => a -> a -> a
- t
1) (Word32 -> IPv4
IPv4 (Word32
a forall a. Num a => a -> a -> a
+ Word32
1)))
    else forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Convert an 'IPv4Range' into a list of the 'IPv4' addresses that
--   are in it.
--
-- >>> let r = IPv4.IPv4Range (IPv4.fromOctets 192 168 1 8) 30
-- >>> mapM_ (T.putStrLn . IPv4.encode) (IPv4.toList r)
-- 192.168.1.8
-- 192.168.1.9
-- 192.168.1.10
-- 192.168.1.11

toList :: IPv4Range -> [IPv4]
toList :: IPv4Range -> [IPv4]
toList (IPv4Range IPv4
ip Word8
len) =
  let totalAddrs :: Word64
totalAddrs = Word8 -> Word64
countAddrs Word8
len
   in Word64 -> IPv4 -> [IPv4]
wordSuccessors Word64
totalAddrs IPv4
ip

-- | A stream-polymorphic generator over an 'IPv4Range'.
--   For more information, see <http://www.haskellforall.com/2014/11/how-to-build-library-agnostic-streaming.html How to build library-agnostic streaming sources>.
toGenerator :: MonadPlus m => IPv4Range -> m IPv4
toGenerator :: forall (m :: * -> *). MonadPlus m => IPv4Range -> m IPv4
toGenerator (IPv4Range IPv4
ip Word8
len) =
  let totalAddrs :: Word64
totalAddrs = Word8 -> Word64
countAddrs Word8
len
   in forall (m :: * -> *). MonadPlus m => Word64 -> IPv4 -> m IPv4
wordSuccessorsM Word64
totalAddrs IPv4
ip

-- | The RFC1918 24-bit block. Subnet mask: @10.0.0.0/8@
private24 :: IPv4Range
private24 :: IPv4Range
private24 = IPv4 -> Word8 -> IPv4Range
IPv4Range (Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
10 Word8
0 Word8
0 Word8
0) Word8
8

-- | The RFC1918 20-bit block. Subnet mask: @172.16.0.0/12@
private20 :: IPv4Range
private20 :: IPv4Range
private20  = IPv4 -> Word8 -> IPv4Range
IPv4Range (Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
172 Word8
16 Word8
0 Word8
0) Word8
12

-- | The RFC1918 16-bit block. Subnet mask: @192.168.0.0/16@
private16 :: IPv4Range
private16 :: IPv4Range
private16 = IPv4 -> Word8 -> IPv4Range
IPv4Range (Word8 -> Word8 -> Word8 -> Word8 -> IPv4
fromOctets Word8
192 Word8
168 Word8
0 Word8
0) Word8
16

-- | Normalize an 'IPv4Range'. The first result of this is that the
-- 'IPv4' inside the 'IPv4Range' is changed so that the insignificant
-- bits are zeroed out. For example:
--
-- >>> IPv4.printRange $ IPv4.normalize $ IPv4.IPv4Range (IPv4.fromOctets 192 168 1 19) 24
-- 192.168.1.0/24
-- >>> IPv4.printRange $ IPv4.normalize $ IPv4.IPv4Range (IPv4.fromOctets 192 168 1 163) 28
-- 192.168.1.160/28
--
-- The second effect of this is that the mask length is lowered to
-- be 32 or smaller. Working with 'IPv4Range'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 32).
--
-- Note that 'normalize' is idempotent, that is:
--
-- prop> IPv4.normalize r == (IPv4.normalize . IPv4.normalize) r
normalize :: IPv4Range -> IPv4Range
normalize :: IPv4Range -> IPv4Range
normalize (IPv4Range (IPv4 Word32
w) Word8
len) =
  let len' :: Word8
len' = forall a. Ord a => a -> a -> a
min Word8
len Word8
32
      w' :: Word32
w' = Word32
w forall a. Bits a => a -> a -> a
.&. Word8 -> Word32
mask Word8
len'
   in IPv4 -> Word8 -> IPv4Range
IPv4Range (Word32 -> IPv4
IPv4 Word32
w') Word8
len'

-- | Encode an 'IPv4Range' as 'Text'.
--
--   >>> IPv4.encodeRange (IPv4.IPv4Range (IPv4.ipv4 172 16 0 0) 12)
--   "172.16.0.0/12"
encodeRange :: IPv4Range -> Text
encodeRange :: IPv4Range -> Text
encodeRange = IPv4Range -> Text
rangeToDotDecimalText

-- | Decode an 'IPv4Range' from 'Text'.
--
--   >>> IPv4.decodeRange "172.16.0.0/12"
--   Just (IPv4Range {ipv4RangeBase = ipv4 172 16 0 0, ipv4RangeLength = 12})
--   >>> IPv4.decodeRange "192.168.25.254/16"
--   Just (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16})
decodeRange :: Text -> Maybe IPv4Range
decodeRange :: Text -> Maybe IPv4Range
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 IPv4Range
parserRange forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AT.endOfInput)

-- | Encode an 'IPv4Range' to a 'TBuilder.Builder'.
--
--   >>> IPv4.builderRange (IPv4.IPv4Range (IPv4.ipv4 172 16 0 0) 12)
--   "172.16.0.0/12"
builderRange :: IPv4Range -> TBuilder.Builder
builderRange :: IPv4Range -> Builder
builderRange = IPv4Range -> Builder
rangeToDotDecimalBuilder

-- | Parse an 'IPv4Range' using a 'AT.Parser'.
--
--   >>> AT.parseOnly IPv4.parserRange "192.168.25.254/16"
--   Right (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16})
parserRange :: AT.Parser IPv4Range
parserRange :: Parser Text IPv4Range
parserRange = do
  IPv4
ip <- Parser IPv4
parser
  Char
_ <- Char -> Parser 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 (IPv4Range -> IPv4Range
normalize (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
ip Word8
theMask))
  where
  limitSize :: a -> m a
limitSize a
i =
    if a
i forall a. Ord a => a -> a -> Bool
> a
32
      then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An IP range length must be between 0 and 32"
      else forall (m :: * -> *) a. Monad m => a -> m a
return a
i

-- | Print an 'IPv4Range'. Helper function that
--   exists mostly for testing purposes.
printRange :: IPv4Range -> IO ()
printRange :: IPv4Range -> IO ()
printRange = Text -> IO ()
TIO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4Range -> Text
encodeRange

-- | The length should be between 0 and 32. These bounds are inclusive.
--   This expectation is not in any way enforced by this library because
--   it does not cause errors. A mask length greater than 32 will be
--   treated as if it were 32.
data IPv4Range = IPv4Range
  { IPv4Range -> IPv4
ipv4RangeBase   :: {-# UNPACK #-} !IPv4
  , IPv4Range -> Word8
ipv4RangeLength :: {-# UNPACK #-} !Word8
  } deriving (IPv4Range -> IPv4Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv4Range -> IPv4Range -> Bool
$c/= :: IPv4Range -> IPv4Range -> Bool
== :: IPv4Range -> IPv4Range -> Bool
$c== :: IPv4Range -> IPv4Range -> Bool
Eq,Eq IPv4Range
IPv4Range -> IPv4Range -> Bool
IPv4Range -> IPv4Range -> Ordering
IPv4Range -> IPv4Range -> IPv4Range
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 :: IPv4Range -> IPv4Range -> IPv4Range
$cmin :: IPv4Range -> IPv4Range -> IPv4Range
max :: IPv4Range -> IPv4Range -> IPv4Range
$cmax :: IPv4Range -> IPv4Range -> IPv4Range
>= :: IPv4Range -> IPv4Range -> Bool
$c>= :: IPv4Range -> IPv4Range -> Bool
> :: IPv4Range -> IPv4Range -> Bool
$c> :: IPv4Range -> IPv4Range -> Bool
<= :: IPv4Range -> IPv4Range -> Bool
$c<= :: IPv4Range -> IPv4Range -> Bool
< :: IPv4Range -> IPv4Range -> Bool
$c< :: IPv4Range -> IPv4Range -> Bool
compare :: IPv4Range -> IPv4Range -> Ordering
$ccompare :: IPv4Range -> IPv4Range -> Ordering
Ord,Int -> IPv4Range -> ShowS
[IPv4Range] -> ShowS
IPv4Range -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPv4Range] -> ShowS
$cshowList :: [IPv4Range] -> ShowS
show :: IPv4Range -> String
$cshow :: IPv4Range -> String
showsPrec :: Int -> IPv4Range -> ShowS
$cshowsPrec :: Int -> IPv4Range -> ShowS
Show,ReadPrec [IPv4Range]
ReadPrec IPv4Range
Int -> ReadS IPv4Range
ReadS [IPv4Range]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IPv4Range]
$creadListPrec :: ReadPrec [IPv4Range]
readPrec :: ReadPrec IPv4Range
$creadPrec :: ReadPrec IPv4Range
readList :: ReadS [IPv4Range]
$creadList :: ReadS [IPv4Range]
readsPrec :: Int -> ReadS IPv4Range
$creadsPrec :: Int -> ReadS IPv4Range
Read,forall x. Rep IPv4Range x -> IPv4Range
forall x. IPv4Range -> Rep IPv4Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IPv4Range x -> IPv4Range
$cfrom :: forall x. IPv4Range -> Rep IPv4Range x
Generic,Typeable IPv4Range
IPv4Range -> DataType
IPv4Range -> Constr
(forall b. Data b => b -> b) -> IPv4Range -> IPv4Range
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) -> IPv4Range -> u
forall u. (forall d. Data d => d -> u) -> IPv4Range -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IPv4Range -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IPv4Range -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv4Range
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4Range -> c IPv4Range
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv4Range)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4Range)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv4Range -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv4Range -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> IPv4Range -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv4Range -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IPv4Range -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IPv4Range -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IPv4Range -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IPv4Range -> r
gmapT :: (forall b. Data b => b -> b) -> IPv4Range -> IPv4Range
$cgmapT :: (forall b. Data b => b -> b) -> IPv4Range -> IPv4Range
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4Range)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IPv4Range)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv4Range)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IPv4Range)
dataTypeOf :: IPv4Range -> DataType
$cdataTypeOf :: IPv4Range -> DataType
toConstr :: IPv4Range -> Constr
$ctoConstr :: IPv4Range -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv4Range
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IPv4Range
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4Range -> c IPv4Range
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4Range -> c IPv4Range
Data)

instance NFData IPv4Range
instance Hashable IPv4Range

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

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

data instance MUVector.MVector s IPv4Range = MV_IPv4Range
  !(MUVector.MVector s IPv4)
  !(MUVector.MVector s Word8)
data instance UVector.Vector IPv4Range = V_IPv4Range
  !(UVector.Vector IPv4)
  !(UVector.Vector Word8)

instance UVector.Unbox IPv4Range
instance MGVector.MVector MUVector.MVector IPv4Range where
  {-# INLINE basicLength  #-}
  basicLength :: forall s. MVector s IPv4Range -> Int
basicLength (MV_IPv4Range MVector s IPv4
as MVector s Word8
_) = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MGVector.basicLength MVector s IPv4
as
  {-# INLINE basicUnsafeSlice  #-}
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s IPv4Range -> MVector s IPv4Range
basicUnsafeSlice Int
i_ Int
m_ (MV_IPv4Range MVector s IPv4
as MVector s Word8
bs)
      = forall s. MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
MV_IPv4Range (forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
MGVector.basicUnsafeSlice Int
i_ Int
m_ MVector s IPv4
as)
                     (forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
MGVector.basicUnsafeSlice Int
i_ Int
m_ MVector s Word8
bs)
  {-# INLINE basicOverlaps  #-}
  basicOverlaps :: forall s. MVector s IPv4Range -> MVector s IPv4Range -> Bool
basicOverlaps (MV_IPv4Range MVector s IPv4
as1 MVector s Word8
bs1) (MV_IPv4Range MVector s IPv4
as2 MVector s Word8
bs2)
      = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MGVector.basicOverlaps MVector s IPv4
as1 MVector s IPv4
as2
        Bool -> Bool -> Bool
|| forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MGVector.basicOverlaps MVector s Word8
bs1 MVector s Word8
bs2
  {-# INLINE basicUnsafeNew  #-}
  basicUnsafeNew :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (MVector (PrimState m) IPv4Range)
basicUnsafeNew Int
n_
      = do
          MVector (PrimState m) IPv4
as <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n_
          MVector (PrimState m) Word8
bs <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n_
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs
  {-# INLINE basicInitialize  #-}
  basicInitialize :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range -> m ()
basicInitialize (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs)
      = do
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) IPv4
as
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) Word8
bs
  {-# INLINE basicUnsafeReplicate  #-}
  basicUnsafeReplicate :: forall (m :: * -> *).
PrimMonad m =>
Int -> IPv4Range -> m (MVector (PrimState m) IPv4Range)
basicUnsafeReplicate Int
n_ (IPv4Range IPv4
a Word8
b)
      = do
          MVector (PrimState m) IPv4
as <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n_ IPv4
a
          MVector (PrimState m) Word8
bs <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n_ Word8
b
          forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs)
  {-# INLINE basicUnsafeRead  #-}
  basicUnsafeRead :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range -> Int -> m IPv4Range
basicUnsafeRead (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs) Int
i_
      = do
          IPv4
a <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
MGVector.basicUnsafeRead MVector (PrimState m) IPv4
as Int
i_
          Word8
b <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
MGVector.basicUnsafeRead MVector (PrimState m) Word8
bs Int
i_
          forall (m :: * -> *) a. Monad m => a -> m a
return (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
a Word8
b)
  {-# INLINE basicUnsafeWrite  #-}
  basicUnsafeWrite :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range -> Int -> IPv4Range -> m ()
basicUnsafeWrite (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs) Int
i_ (IPv4Range IPv4
a Word8
b)
      = do
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
MGVector.basicUnsafeWrite MVector (PrimState m) IPv4
as Int
i_ IPv4
a
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
MGVector.basicUnsafeWrite MVector (PrimState m) Word8
bs Int
i_ Word8
b
  {-# INLINE basicClear  #-}
  basicClear :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range -> m ()
basicClear (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs)
      = do
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) IPv4
as
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) Word8
bs
  {-# INLINE basicSet  #-}
  basicSet :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range -> IPv4Range -> m ()
basicSet (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs) (IPv4Range IPv4
a Word8
b)
      = do
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MGVector.basicSet MVector (PrimState m) IPv4
as IPv4
a
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MGVector.basicSet MVector (PrimState m) Word8
bs Word8
b
  {-# INLINE basicUnsafeCopy  #-}
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range
-> MVector (PrimState m) IPv4Range -> m ()
basicUnsafeCopy (MV_IPv4Range MVector (PrimState m) IPv4
as1 MVector (PrimState m) Word8
bs1) (MV_IPv4Range MVector (PrimState m) IPv4
as2 MVector (PrimState m) Word8
bs2)
      = do
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeCopy MVector (PrimState m) IPv4
as1 MVector (PrimState m) IPv4
as2
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeCopy MVector (PrimState m) Word8
bs1 MVector (PrimState m) Word8
bs2
  {-# INLINE basicUnsafeMove  #-}
  basicUnsafeMove :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range
-> MVector (PrimState m) IPv4Range -> m ()
basicUnsafeMove (MV_IPv4Range MVector (PrimState m) IPv4
as1 MVector (PrimState m) Word8
bs1) (MV_IPv4Range MVector (PrimState m) IPv4
as2 MVector (PrimState m) Word8
bs2)
      = do
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeMove MVector (PrimState m) IPv4
as1 MVector (PrimState m) IPv4
as2
          forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MGVector.basicUnsafeMove MVector (PrimState m) Word8
bs1 MVector (PrimState m) Word8
bs2
  {-# INLINE basicUnsafeGrow  #-}
  basicUnsafeGrow :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) IPv4Range
-> Int -> m (MVector (PrimState m) IPv4Range)
basicUnsafeGrow (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs) Int
m_
      = do
          MVector (PrimState m) IPv4
as' <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
MGVector.basicUnsafeGrow MVector (PrimState m) IPv4
as Int
m_
          MVector (PrimState m) Word8
bs' <- forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
MGVector.basicUnsafeGrow MVector (PrimState m) Word8
bs Int
m_
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
MV_IPv4Range MVector (PrimState m) IPv4
as' MVector (PrimState m) Word8
bs'

instance GVector.Vector UVector.Vector IPv4Range where
  {-# INLINE basicUnsafeFreeze  #-}
  basicUnsafeFreeze :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) IPv4Range -> m (Vector IPv4Range)
basicUnsafeFreeze (MV_IPv4Range MVector (PrimState m) IPv4
as MVector (PrimState m) Word8
bs)
      = do
          Vector IPv4
as' <- forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) IPv4
as
          Vector Word8
bs' <- forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) Word8
bs
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Vector IPv4 -> Vector Word8 -> Vector IPv4Range
V_IPv4Range Vector IPv4
as' Vector Word8
bs'
  {-# INLINE basicUnsafeThaw  #-}
  basicUnsafeThaw :: forall (m :: * -> *).
PrimMonad m =>
Vector IPv4Range -> m (Mutable Vector (PrimState m) IPv4Range)
basicUnsafeThaw (V_IPv4Range Vector IPv4
as Vector Word8
bs)
      = do
          MVector (PrimState m) IPv4
as' <- forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
GVector.basicUnsafeThaw Vector IPv4
as
          MVector (PrimState m) Word8
bs' <- forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
GVector.basicUnsafeThaw Vector Word8
bs
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
MV_IPv4Range MVector (PrimState m) IPv4
as' MVector (PrimState m) Word8
bs'
  {-# INLINE basicLength  #-}
  basicLength :: Vector IPv4Range -> Int
basicLength (V_IPv4Range Vector IPv4
as Vector Word8
_) = forall (v :: * -> *) a. Vector v a => v a -> Int
GVector.basicLength Vector IPv4
as
  {-# INLINE basicUnsafeSlice  #-}
  basicUnsafeSlice :: Int -> Int -> Vector IPv4Range -> Vector IPv4Range
basicUnsafeSlice Int
i_ Int
m_ (V_IPv4Range Vector IPv4
as Vector Word8
bs)
      = Vector IPv4 -> Vector Word8 -> Vector IPv4Range
V_IPv4Range (forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i_ Int
m_ Vector IPv4
as)
                    (forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i_ Int
m_ Vector Word8
bs)
  {-# INLINE basicUnsafeIndexM  #-}
  basicUnsafeIndexM :: forall (m :: * -> *).
Monad m =>
Vector IPv4Range -> Int -> m IPv4Range
basicUnsafeIndexM (V_IPv4Range Vector IPv4
as Vector Word8
bs) Int
i_
      = do
          IPv4
a <- forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector IPv4
as Int
i_
          Word8
b <- forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector Word8
bs Int
i_
          forall (m :: * -> *) a. Monad m => a -> m a
return (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
a Word8
b)
  {-# INLINE basicUnsafeCopy  #-}
  basicUnsafeCopy :: forall (m :: * -> *).
PrimMonad m =>
Mutable Vector (PrimState m) IPv4Range -> Vector IPv4Range -> m ()
basicUnsafeCopy (MV_IPv4Range MVector (PrimState m) IPv4
as1 MVector (PrimState m) Word8
bs1) (V_IPv4Range Vector IPv4
as2 Vector Word8
bs2)
      = do
          forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) IPv4
as1 Vector IPv4
as2
          forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) Word8
bs1 Vector Word8
bs2
  {-# INLINE elemseq  #-}
  elemseq :: forall b. Vector IPv4Range -> IPv4Range -> b -> b
elemseq Vector IPv4Range
_ (IPv4Range IPv4
a Word8
b)
      = forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
GVector.elemseq (forall a. HasCallStack => a
undefined :: UVector.Vector a) IPv4
a
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
GVector.elemseq (forall a. HasCallStack => a
undefined :: UVector.Vector b) Word8
b

-----------------
-- Internal Stuff
-----------------

rangeToDotDecimalText :: IPv4Range -> Text
rangeToDotDecimalText :: IPv4Range -> Text
rangeToDotDecimalText = Text -> Text
LText.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TBuilder.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4Range -> Builder
rangeToDotDecimalBuilder

rangeToDotDecimalBuilder :: IPv4Range -> TBuilder.Builder
rangeToDotDecimalBuilder :: IPv4Range -> Builder
rangeToDotDecimalBuilder (IPv4Range IPv4
addr Word8
len) =
     IPv4 -> Builder
builder IPv4
addr
  forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TBuilder.singleton Char
'/'
  forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
TBI.decimal Word8
len