{-# 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
    -- ** 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.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 GHC.Word (Word32(W32#))
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

#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 qualified Prelude as P
-- >>> import qualified Data.Text.IO as T
-- >>> instance Arbitrary IPv4 where { arbitrary = fmap IPv4 arbitrary }
-- >>> instance Arbitrary IPv4Range where { arbitrary = 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 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'
  (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a) (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) (Word8 -> Word
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) =
  ( Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24)
  , Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16)
  , Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8)
  , Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w
  )

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

-- | The local loopback IP address.
--
--   >>> 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'.
--
--   >>> localhost
--   ipv4 127 0 0 1
localhost :: IPv4
localhost :: IPv4
localhost = IPv4
loopback

-- | The broadcast IP address.
--
--   >>> 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  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
p24
  Bool -> Bool -> Bool
|| Word32
mask12 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
p20
  Bool -> Bool -> Bool
|| Word32
mask16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
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 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftR Word32
w Int
29 of
  Word32
0 ->
    let a :: Word32
a = IPv4 -> Word32
getIPv4 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
10 Word
0 Word
0 Word
0
     in Word32
mask8  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
a
     Bool -> Bool -> Bool
|| Word32
mask8  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
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 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
127 Word
0 Word
0 Word
0
     in Word32
mask8  Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
c
     Bool -> Bool -> Bool
|| Word32
mask10 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
b
  Word32
4 -> Bool
False
  Word32
5 ->
    let d :: Word32
d = IPv4 -> Word32
getIPv4 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
172 Word
16 Word
0 Word
0
     in Word32
mask12 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
x
     Bool -> Bool -> Bool
|| Word32
mask16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
d
  Word32
6 ->
    let e :: Word32
e = IPv4 -> Word32
getIPv4 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
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 (IPv4 -> Word32) -> IPv4 -> Word32
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> Word -> IPv4
fromOctets' Word
192 Word
168 Word
0 Word
0
     in Word32
mask15 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
h
     Bool -> Bool -> Bool
|| Word32
mask16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
z
     Bool -> Bool -> Bool
|| Word32
mask24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
e
     Bool -> Bool -> Bool
|| Word32
mask24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
f
     Bool -> Bool -> Bool
|| Word32
mask24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
g
     Bool -> Bool -> Bool
|| Word32
mask24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
i
     Bool -> Bool -> Bool
|| Word32
mask24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
w Word32 -> Word32 -> Bool
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> public x == not (reserved x)
public :: IPv4 -> Bool
public :: IPv4 -> Bool
public = Bool -> Bool
not (Bool -> Bool) -> (IPv4 -> Bool) -> IPv4 -> Bool
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 (encode (ipv4 192 168 2 47))
--   192.168.2.47
encode :: IPv4 -> Text
encode :: IPv4 -> Text
encode = IPv4 -> Text
toDotDecimalText

-- | Decode an 'IPv4' address.
--
--   >>> decode "192.168.2.47"
--   Just (ipv4 192 168 2 47)
--
--   >>> 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'.
--
--   >>> builder (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'.
--
--   >>> reader "192.168.2.47"
--   Right (ipv4 192 168 2 47,"")
--
--   >>> 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 parser "192.168.2.47"
--   Right (ipv4 192 168 2 47)
--
--   >>> AT.parseOnly 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'.
--
--   >>> encodeUtf8 (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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len1
     Ptr Word8 -> Word8 -> IO ()
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
w2
     let ptr3 :: Ptr Word8
ptr3 = Ptr Word8
ptr2 Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len2 Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
     Ptr Word8 -> Word8 -> IO ()
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
w3
     let ptr4 :: Ptr Word8
ptr4 = Ptr Word8
ptr3 Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len3 Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
     Ptr Word8 -> Word8 -> IO ()
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 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Word8
w4
     Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len4))
  where w1 :: Word8
w1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24
        w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16
        w3 :: Word8
w3 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8
        w4 :: Word8
w4 = Word32 -> Word8
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
100 = do
              let int :: Int
int = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
word
                  indx :: Int
indx = Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
int
                  get3 :: Int -> Word8
get3 = Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> (Int -> Word8) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
ByteString.unsafeIndex ByteString
threeDigits
              Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Int -> Word8
get3 Int
indx)
              Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
get3 (Int
indx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
              Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Int -> Word8
get3 (Int
indx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
              Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
          | Word8
word Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
10 = do
              let int :: Int
int = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
word
                  indx :: Int
indx = Int
int Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
int
                  get2 :: Int -> Word8
get2 = Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> (Int -> Word8) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
ByteString.unsafeIndex ByteString
twoDigits
              Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Int -> Word8
get2 Int
indx)
              Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int -> Word8
get2 (Int
indx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
              Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
          | Bool
otherwise = do
              Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
ptr (Word8
word Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
48)
              Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1

-- | Decode a UTF8-encoded 'ByteString' into an '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 (Text -> Maybe IPv4)
-> (ByteString -> Maybe Text) -> ByteString -> Maybe IPv4
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
rightToMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
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.
--
--   >>> 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'.
--
--   >>> encodeShort (ipv4 192 168 5 99)
--   "192.168.5.99"
encodeShort :: IPv4 -> ShortText
encodeShort :: IPv4 -> ShortText
encodeShort !IPv4
w = ShortText -> ShortText
forall a. a -> a
id
  (ShortText -> ShortText) -> ShortText -> ShortText
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ShortText
TS.fromShortByteStringUnsafe
  (ShortByteString -> ShortText) -> ShortByteString -> ShortText
forall a b. (a -> b) -> a -> b
$ ByteArray -> ShortByteString
byteArrayToShortByteString
  (ByteArray -> ShortByteString) -> ByteArray -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Nat 15 -> Builder 15 -> ByteArray
forall (n :: Nat). Nat n -> Builder n -> ByteArray
BB.run Nat 15
forall (n :: Nat). KnownNat n => Nat n
Nat.constant
  (Builder 15 -> ByteArray) -> Builder 15 -> ByteArray
forall a b. (a -> b) -> a -> b
$ IPv4 -> Builder 15
boundedBuilderUtf8
  (IPv4 -> Builder 15) -> IPv4 -> Builder 15
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.
--
--   >>> decodeUtf8Bytes (Bytes.fromAsciiString "127.0.0.1")
--   Just (ipv4 127 0 0 1)
decodeUtf8Bytes :: Bytes.Bytes -> Maybe IPv4
decodeUtf8Bytes :: Bytes -> Maybe IPv4
decodeUtf8Bytes !Bytes
b = case (forall s. Parser () s IPv4) -> Bytes -> Result () IPv4
forall e a. (forall s. Parser e s a) -> Bytes -> Result e a
Parser.parseBytes (() -> Parser () s IPv4
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 -> IPv4 -> Maybe IPv4
forall a. a -> Maybe a
Just IPv4
addr
    Int
_ -> Maybe IPv4
forall a. Maybe a
Nothing
  Parser.Failure ()
_ -> Maybe IPv4
forall a. Maybe a
Nothing

-- | Parse UTF-8-encoded 'Bytes' as an 'IPv4' address.
--
--   >>> Parser.parseBytes (parserUtf8Bytes ()) (Bytes.fromAsciiString "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 :: e -> Parser e s IPv4
parserUtf8Bytes e
e = Parser e s Word32 -> Parser e s IPv4
coerce (Parser e s Word# -> Parser e s Word32
forall e s. Parser e s Word# -> Parser e s Word32
Parser.boxWord32 (e -> Parser e s Word#
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# :: e -> Parser e s Word#
parserUtf8Bytes# e
e = Parser e s Word32 -> Parser e s Word#
forall e s. Parser e s Word32 -> Parser e s Word#
Parser.unboxWord32 (Parser e s Word32 -> Parser e s Word#)
-> Parser e s Word32 -> Parser e s Word#
forall a b. (a -> b) -> a -> b
$ do
  !Word8
a <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'.'
  !Word8
b <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'.'
  !Word8
c <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'.'
  !Word8
d <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  Word32 -> Parser e s Word32
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") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "192.168.0.0/16")
-- 192.168.0.0/16
-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8Bytes ()) (Bytes.fromAsciiString "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 :: e -> Parser e s IPv4Range
parserRangeUtf8Bytes e
e = do
  IPv4
base <- e -> Parser e s IPv4
forall e s. e -> Parser e s IPv4
parserUtf8Bytes e
e
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'/'
  Word8
theMask <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  if Word8
theMask Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
32
    then e -> Parser e s IPv4Range
forall e s a. e -> Parser e s a
Parser.fail e
e
    else IPv4Range -> Parser e s IPv4Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv4Range -> Parser e s IPv4Range)
-> IPv4Range -> Parser e s IPv4Range
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") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "192.168.0.0/16")
-- 192.168.0.0/16
-- >>> maybe (putStrLn "nope") printRange $ Parser.parseBytesMaybe (parserRangeUtf8BytesLenient ()) (Bytes.fromAsciiString "10.10.10.1")
-- 10.10.10.1/32
parserRangeUtf8BytesLenient :: e -> Parser.Parser e s IPv4Range
parserRangeUtf8BytesLenient :: e -> Parser e s IPv4Range
parserRangeUtf8BytesLenient e
e = do
  IPv4
base <- e -> Parser e s IPv4
forall e s. e -> Parser e s IPv4
parserUtf8Bytes e
e
  (Char -> Bool) -> Parser e s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') Parser e s Bool
-> (Bool -> Parser e s IPv4Range) -> Parser e s IPv4Range
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      Word8
theMask <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      if Word8
theMask Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
32
        then e -> Parser e s IPv4Range
forall e s a. e -> Parser e s a
Parser.fail e
e
        else IPv4Range -> Parser e s IPv4Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv4Range -> Parser e s IPv4Range)
-> IPv4Range -> Parser e s IPv4Range
forall a b. (a -> b) -> a -> b
$! IPv4Range -> IPv4Range
normalize (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
base Word8
theMask)
    Bool
False -> IPv4Range -> Parser e s IPv4Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv4Range -> Parser e s IPv4Range)
-> IPv4Range -> Parser e s IPv4Range
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 (builderUtf8 (fromOctets 192 168 2 12))
-- "192.168.2.12"
builderUtf8 :: IPv4 -> Builder.Builder
builderUtf8 :: IPv4 -> Builder
builderUtf8 = ByteString -> Builder
Builder.byteString (ByteString -> Builder) -> (IPv4 -> ByteString) -> IPv4 -> Builder
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 (byteArrayBuilderUtf8 (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 = Nat 15 -> Builder 15 -> Builder
forall (n :: Nat). Nat n -> Builder n -> Builder
UB.fromBounded Nat 15
forall (n :: Nat). KnownNat n => Nat n
Nat.constant (Builder 15 -> Builder) -> (IPv4 -> Builder 15) -> IPv4 -> Builder
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 (boundedBuilderUtf8 (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
  Builder 3 -> Builder 12 -> Builder (3 + 12)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Char -> Builder 1
BB.ascii Char
'.'
  Builder 1 -> Builder 11 -> Builder (1 + 11)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 3
BB.word8Dec Word8
w2
  Builder 3 -> Builder 8 -> Builder (3 + 8)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Char -> Builder 1
BB.ascii Char
'.'
  Builder 1 -> Builder 7 -> Builder (1 + 7)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Word8 -> Builder 3
BB.word8Dec Word8
w3
  Builder 3 -> Builder 4 -> Builder (3 + 4)
forall (m :: Nat) (n :: Nat).
Builder m -> Builder n -> Builder (m + n)
`BB.append`
  Char -> Builder 1
BB.ascii Char
'.'
  Builder 1 -> Builder 3 -> Builder (1 + 3)
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 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
24) :: Word8
  w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
16) :: Word8
  w3 :: Word8
w3 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
w Int
8) :: Word8
  w4 :: Word8
w4 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w :: Word8

-- | Parse an 'IPv4' using a 'AB.Parser'.
--
--   >>> AB.parseOnly parserUtf8 "192.168.2.47"
--   Right (ipv4 192 168 2 47)
--
--   >>> AB.parseOnly 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'
  (Word -> Word -> Word -> Word -> IPv4)
-> Parser ByteString Word
-> Parser ByteString (Word -> Word -> Word -> IPv4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Word
forall a. Integral a => Parser a
AB.decimal Parser ByteString Word
-> (Word -> Parser ByteString Word) -> Parser ByteString Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser ByteString Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  Parser ByteString (Word -> Word -> Word -> IPv4)
-> Parser ByteString Char
-> Parser ByteString (Word -> Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser ByteString Char
AB.char Char
'.'
  Parser ByteString (Word -> Word -> Word -> IPv4)
-> Parser ByteString Word
-> Parser ByteString (Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Word
forall a. Integral a => Parser a
AB.decimal Parser ByteString Word
-> (Word -> Parser ByteString Word) -> Parser ByteString Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser ByteString Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  Parser ByteString (Word -> Word -> IPv4)
-> Parser ByteString Char
-> Parser ByteString (Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser ByteString Char
AB.char Char
'.'
  Parser ByteString (Word -> Word -> IPv4)
-> Parser ByteString Word -> Parser ByteString (Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Word
forall a. Integral a => Parser a
AB.decimal Parser ByteString Word
-> (Word -> Parser ByteString Word) -> Parser ByteString Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser ByteString Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  Parser ByteString (Word -> IPv4)
-> Parser ByteString Char -> Parser ByteString (Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser ByteString Char
AB.char Char
'.'
  Parser ByteString (Word -> IPv4)
-> Parser ByteString Word -> Parser IPv4
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Word
forall a. Integral a => Parser a
AB.decimal Parser ByteString Word
-> (Word -> Parser ByteString Word) -> Parser ByteString Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser ByteString Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  where
  limitSize :: a -> m a
limitSize a
i =
    if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
255
      then String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"All octets in an ipv4 address must be between 0 and 255"
      else a -> m a
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 (Text -> String) -> (IPv4 -> Text) -> IPv4 -> String
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 (Text -> Maybe IPv4) -> (String -> Text) -> String -> Maybe IPv4
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
box :: Word# -> IPv4
box Word#
w = Word32 -> IPv4
IPv4 (Word# -> Word32
W32# Word#
w)

-- | Convert a boxed IPv4 address to an unboxed one.
unbox :: IPv4 -> IPv4#
unbox :: IPv4 -> Word#
unbox (IPv4 (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
Eq IPv4
-> (IPv4 -> IPv4 -> IPv4)
-> (IPv4 -> IPv4 -> IPv4)
-> (IPv4 -> IPv4 -> IPv4)
-> (IPv4 -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> IPv4
-> (Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> Bool)
-> (IPv4 -> Maybe Int)
-> (IPv4 -> Int)
-> (IPv4 -> Bool)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int -> IPv4)
-> (IPv4 -> Int)
-> Bits 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
$cp1Bits :: Eq IPv4
Bits.Bits,IPv4
IPv4 -> IPv4 -> Bounded IPv4
forall a. a -> a -> Bounded a
maxBound :: IPv4
$cmaxBound :: IPv4
minBound :: IPv4
$cminBound :: IPv4
Bounded,Typeable IPv4
DataType
Constr
Typeable IPv4
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IPv4 -> c IPv4)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IPv4)
-> (IPv4 -> Constr)
-> (IPv4 -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> IPv4 -> IPv4)
-> (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 u. (forall d. Data d => d -> u) -> IPv4 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IPv4 -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IPv4 -> m IPv4)
-> Data IPv4
IPv4 -> DataType
IPv4 -> Constr
(forall b. Data b => b -> b) -> IPv4 -> IPv4
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4 -> c IPv4
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIPv4 :: Constr
$tIPv4 :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> IPv4 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv4 -> u
gmapQ :: (forall d. Data d => d -> u) -> IPv4 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv4 -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable IPv4
Data,Int -> IPv4
IPv4 -> Int
IPv4 -> [IPv4]
IPv4 -> IPv4
IPv4 -> IPv4 -> [IPv4]
IPv4 -> IPv4 -> IPv4 -> [IPv4]
(IPv4 -> IPv4)
-> (IPv4 -> IPv4)
-> (Int -> IPv4)
-> (IPv4 -> Int)
-> (IPv4 -> [IPv4])
-> (IPv4 -> IPv4 -> [IPv4])
-> (IPv4 -> IPv4 -> [IPv4])
-> (IPv4 -> IPv4 -> IPv4 -> [IPv4])
-> Enum 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
(IPv4 -> IPv4 -> Bool) -> (IPv4 -> IPv4 -> Bool) -> Eq IPv4
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
Bits IPv4
-> (IPv4 -> Int)
-> (IPv4 -> Int)
-> (IPv4 -> Int)
-> FiniteBits 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
$cp1FiniteBits :: Bits IPv4
Bits.FiniteBits,(forall x. IPv4 -> Rep IPv4 x)
-> (forall x. Rep IPv4 x -> IPv4) -> Generic IPv4
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,Int -> IPv4 -> Int
IPv4 -> Int
(Int -> IPv4 -> Int) -> (IPv4 -> Int) -> Hashable IPv4
forall 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
Ord IPv4
-> ((IPv4, IPv4) -> [IPv4])
-> ((IPv4, IPv4) -> IPv4 -> Int)
-> ((IPv4, IPv4) -> IPv4 -> Int)
-> ((IPv4, IPv4) -> IPv4 -> Bool)
-> ((IPv4, IPv4) -> Int)
-> ((IPv4, IPv4) -> Int)
-> Ix 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]
$cp1Ix :: Ord IPv4
Ix,Eq IPv4
Eq IPv4
-> (IPv4 -> IPv4 -> Ordering)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> Bool)
-> (IPv4 -> IPv4 -> IPv4)
-> (IPv4 -> IPv4 -> IPv4)
-> Ord 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
$cp1Ord :: Eq IPv4
Ord,Addr# -> Int# -> IPv4
Addr# -> Int# -> Int# -> IPv4 -> State# s -> State# s
Addr# -> Int# -> State# s -> (# State# s, IPv4 #)
Addr# -> Int# -> IPv4 -> State# s -> State# s
ByteArray# -> Int# -> IPv4
MutableByteArray# s -> Int# -> State# s -> (# State# s, IPv4 #)
MutableByteArray# s -> Int# -> IPv4 -> State# s -> State# s
MutableByteArray# s -> Int# -> Int# -> IPv4 -> State# s -> State# s
IPv4 -> Int#
(IPv4 -> Int#)
-> (IPv4 -> Int#)
-> (ByteArray# -> Int# -> IPv4)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, IPv4 #))
-> (forall s.
    MutableByteArray# s -> Int# -> IPv4 -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> IPv4 -> State# s -> State# s)
-> (Addr# -> Int# -> IPv4)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, IPv4 #))
-> (forall s. Addr# -> Int# -> IPv4 -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> IPv4 -> State# s -> State# s)
-> Prim IPv4
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# :: Addr# -> Int# -> Int# -> IPv4 -> State# s -> State# s
$csetOffAddr# :: forall s. Addr# -> Int# -> Int# -> IPv4 -> State# s -> State# s
writeOffAddr# :: Addr# -> Int# -> IPv4 -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> IPv4 -> State# s -> State# s
readOffAddr# :: 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# :: MutableByteArray# s -> Int# -> Int# -> IPv4 -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int# -> IPv4 -> State# s -> State# s
writeByteArray# :: MutableByteArray# s -> Int# -> IPv4 -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s -> Int# -> IPv4 -> State# s -> State# s
readByteArray# :: 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 b -> Int -> IO IPv4
Ptr b -> Int -> IPv4 -> IO ()
Ptr IPv4 -> IO IPv4
Ptr IPv4 -> Int -> IO IPv4
Ptr IPv4 -> Int -> IPv4 -> IO ()
Ptr IPv4 -> IPv4 -> IO ()
IPv4 -> Int
(IPv4 -> Int)
-> (IPv4 -> Int)
-> (Ptr IPv4 -> Int -> IO IPv4)
-> (Ptr IPv4 -> Int -> IPv4 -> IO ())
-> (forall b. Ptr b -> Int -> IO IPv4)
-> (forall b. Ptr b -> Int -> IPv4 -> IO ())
-> (Ptr IPv4 -> IO IPv4)
-> (Ptr IPv4 -> IPv4 -> IO ())
-> Storable IPv4
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 :: Ptr b -> Int -> IPv4 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> IPv4 -> IO ()
peekByteOff :: 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
    (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ipv4 "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
a
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
b
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
c
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
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 = ReadPrec IPv4 -> ReadPrec IPv4
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec IPv4 -> ReadPrec IPv4) -> ReadPrec IPv4 -> ReadPrec IPv4
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec IPv4 -> ReadPrec IPv4
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec IPv4 -> ReadPrec IPv4) -> ReadPrec IPv4 -> ReadPrec IPv4
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"ipv4" <- ReadPrec Lexeme
lexP
    Word8
a <- ReadPrec Word8 -> ReadPrec Word8
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Word8
forall a. Read a => ReadPrec a
readPrec
    Word8
b <- ReadPrec Word8 -> ReadPrec Word8
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Word8
forall a. Read a => ReadPrec a
readPrec
    Word8
c <- ReadPrec Word8 -> ReadPrec Word8
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Word8
forall a. Read a => ReadPrec a
readPrec
    Word8
d <- ReadPrec Word8 -> ReadPrec Word8
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Word8
forall a. Read a => ReadPrec a
readPrec
    IPv4 -> ReadPrec IPv4
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 (Text -> IO ()) -> (IPv4 -> Text) -> IPv4 -> IO ()
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 :: MVector s IPv4 -> Int
basicLength (MV_IPv4 v) = MVector s IPv4 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MGVector.basicLength MVector s IPv4
v
  basicUnsafeSlice :: Int -> Int -> MVector s IPv4 -> MVector s IPv4
basicUnsafeSlice Int
i Int
n (MV_IPv4 v) = MVector s IPv4 -> MVector s IPv4
forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 (MVector s IPv4 -> MVector s IPv4)
-> MVector s IPv4 -> MVector s IPv4
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s IPv4 -> MVector s IPv4
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 :: MVector s IPv4 -> MVector s IPv4 -> Bool
basicOverlaps (MV_IPv4 v1) (MV_IPv4 v2) = MVector s IPv4 -> MVector s IPv4 -> Bool
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 :: Int -> m (MVector (PrimState m) IPv4)
basicUnsafeNew Int
n = MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4
forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 (MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4)
-> m (MVector (PrimState m) IPv4) -> m (MVector (PrimState m) IPv4)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> m (MVector (PrimState m) IPv4)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n
  basicInitialize :: MVector (PrimState m) IPv4 -> m ()
basicInitialize (MV_IPv4 v) = MVector (PrimState m) IPv4 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) IPv4
v
  basicUnsafeReplicate :: Int -> IPv4 -> m (MVector (PrimState m) IPv4)
basicUnsafeReplicate Int
n IPv4
x = MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4
forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 (MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4)
-> m (MVector (PrimState m) IPv4) -> m (MVector (PrimState m) IPv4)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> IPv4 -> m (MVector (PrimState m) IPv4)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n IPv4
x
  basicUnsafeRead :: MVector (PrimState m) IPv4 -> Int -> m IPv4
basicUnsafeRead (MV_IPv4 v) Int
i = MVector (PrimState m) IPv4 -> Int -> m IPv4
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 :: MVector (PrimState m) IPv4 -> Int -> IPv4 -> m ()
basicUnsafeWrite (MV_IPv4 v) Int
i IPv4
x = MVector (PrimState m) IPv4 -> Int -> IPv4 -> m ()
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 :: MVector (PrimState m) IPv4 -> m ()
basicClear (MV_IPv4 v) = MVector (PrimState m) IPv4 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) IPv4
v
  basicSet :: MVector (PrimState m) IPv4 -> IPv4 -> m ()
basicSet (MV_IPv4 v) IPv4
x = MVector (PrimState m) IPv4 -> IPv4 -> m ()
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 :: MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
basicUnsafeCopy (MV_IPv4 v1) (MV_IPv4 v2) = MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
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 :: MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
basicUnsafeMove (MV_IPv4 v1) (MV_IPv4 v2) = MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
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 :: MVector (PrimState m) IPv4 -> Int -> m (MVector (PrimState m) IPv4)
basicUnsafeGrow (MV_IPv4 v) Int
n = MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4
forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 (MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4)
-> m (MVector (PrimState m) IPv4) -> m (MVector (PrimState m) IPv4)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector (PrimState m) IPv4 -> Int -> m (MVector (PrimState m) IPv4)
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 :: Mutable Vector (PrimState m) IPv4 -> m (Vector IPv4)
basicUnsafeFreeze (MV_IPv4 v) = Vector IPv4 -> Vector IPv4
V_IPv4 (Vector IPv4 -> Vector IPv4) -> m (Vector IPv4) -> m (Vector IPv4)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector (PrimState m) IPv4 -> m (Vector IPv4)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) IPv4
Mutable Vector (PrimState m) IPv4
v
  basicUnsafeThaw :: Vector IPv4 -> m (Mutable Vector (PrimState m) IPv4)
basicUnsafeThaw (V_IPv4 v) = MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4
forall s. MVector s IPv4 -> MVector s IPv4
MV_IPv4 (MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4)
-> m (MVector (PrimState m) IPv4) -> m (MVector (PrimState m) IPv4)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector IPv4 -> m (Mutable Vector (PrimState m) IPv4)
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 v) = Vector IPv4 -> Int
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 v) = Vector IPv4 -> Vector IPv4
V_IPv4 (Vector IPv4 -> Vector IPv4) -> Vector IPv4 -> Vector IPv4
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector IPv4 -> Vector IPv4
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i Int
n Vector IPv4
v
  basicUnsafeIndexM :: Vector IPv4 -> Int -> m IPv4
basicUnsafeIndexM (V_IPv4 v) Int
i = Vector IPv4 -> Int -> m IPv4
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector IPv4
v Int
i
  basicUnsafeCopy :: Mutable Vector (PrimState m) IPv4 -> Vector IPv4 -> m ()
basicUnsafeCopy (MV_IPv4 mv) (V_IPv4 v) = Mutable Vector (PrimState m) IPv4 -> Vector IPv4 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) IPv4
Mutable Vector (PrimState m) IPv4
mv Vector IPv4
v
  elemseq :: Vector IPv4 -> IPv4 -> b -> b
elemseq Vector IPv4
_ = IPv4 -> b -> b
seq

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

instance FromJSON IPv4 where
  parseJSON :: Value -> Parser IPv4
parseJSON = String -> (Text -> Parser IPv4) -> Value -> Parser IPv4
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 = (IPv4 -> Key) -> (IPv4 -> Encoding' Key) -> ToJSONKeyFunction IPv4
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText
    (Text -> Key
keyFromText (Text -> Key) -> (IPv4 -> Text) -> IPv4 -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> Text
encode)
    (\IPv4
addr -> Builder -> Encoding' Key
forall a. Builder -> Encoding' a
Aeson.unsafeToEncoding (Builder -> Encoding' Key) -> Builder -> Encoding' Key
forall a b. (a -> b) -> a -> b
$ Char -> Builder
Builder.char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IPv4 -> Builder
builderUtf8 IPv4
addr Builder -> Builder -> Builder
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 = (Text -> Parser IPv4) -> FromJSONKeyFunction IPv4
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 -> String -> Parser IPv4
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse IPv4 address"
  Just IPv4
addr -> IPv4 -> Parser IPv4
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
_ -> Maybe IPv4
forall a. Maybe a
Nothing
  Right (IPv4
w,Text
t') -> if Text -> Bool
Text.null Text
t'
    then IPv4 -> Maybe IPv4
forall a. a -> Maybe a
Just IPv4
w
    else Maybe IPv4
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'
  (IPv4, Text) -> Either String (IPv4, Text)
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
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
Text.null Text
digits) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left String
"octet does not start with a digit"
  case (Char -> (Int -> Maybe Int) -> Int -> Maybe Int)
-> (Int -> Maybe Int) -> Text -> Int -> Maybe Int
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr Char -> (Int -> Maybe Int) -> Int -> Maybe Int
go Int -> Maybe Int
forall a. a -> Maybe a
Just Text
digits Int
0 of
    Just Int
n  -> (Word, Text) -> Either String (Word, Text)
forall a b. b -> Either a b
Right (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Text
rest)
    Maybe Int
Nothing -> String -> Either String (Word, Text)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48
    in  if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255 then Int -> Maybe Int
f Int
n' else Maybe Int
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 -> String -> Either String Text
forall a b. a -> Either a b
Left String
"expected a dot but input ended instead"
  Just (Char
c,Text
tnext) -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    then Text -> Either String Text
forall a b. b -> Either a b
Right Text
tnext
    else String -> Either String Text
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 (Word32 -> IPv4) -> Word32 -> IPv4
forall a b. (a -> b) -> a -> b
$ Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    ( Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
a Int
24
  Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
b Int
16
  Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
c Int
8
  Word -> Word -> Word
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'
  (Word -> Word -> Word -> Word -> IPv4)
-> Parser Text Word -> Parser Text (Word -> Word -> Word -> IPv4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Word
forall a. Integral a => Parser a
AT.decimal Parser Text Word -> (Word -> Parser Text Word) -> Parser Text Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser Text Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  Parser Text (Word -> Word -> Word -> IPv4)
-> Parser Text Char -> Parser Text (Word -> Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Text Char
AT.char Char
'.'
  Parser Text (Word -> Word -> Word -> IPv4)
-> Parser Text Word -> Parser Text (Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Word
forall a. Integral a => Parser a
AT.decimal Parser Text Word -> (Word -> Parser Text Word) -> Parser Text Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser Text Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  Parser Text (Word -> Word -> IPv4)
-> Parser Text Char -> Parser Text (Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Text Char
AT.char Char
'.'
  Parser Text (Word -> Word -> IPv4)
-> Parser Text Word -> Parser Text (Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Word
forall a. Integral a => Parser a
AT.decimal Parser Text Word -> (Word -> Parser Text Word) -> Parser Text Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser Text Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  Parser Text (Word -> IPv4)
-> Parser Text Char -> Parser Text (Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Text Char
AT.char Char
'.'
  Parser Text (Word -> IPv4) -> Parser Text Word -> Parser IPv4
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Word
forall a. Integral a => Parser a
AT.decimal Parser Text Word -> (Word -> Parser Text Word) -> Parser Text Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word -> Parser Text Word
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize)
  where
  limitSize :: a -> m a
limitSize a
i =
    if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
255
      then String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
ipOctetSizeErrorMsg
      else a -> m a
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 (Text -> Builder) -> (IPv4 -> Text) -> IPv4 -> Builder
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 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
24
      w2 :: Word
w2 = Word
255 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
16
      w3 :: Word
w3 = Word
255 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Int -> Word
forall a. Bits a => a -> Int -> a
unsafeShiftR (Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w) Int
8
      w4 :: Word
w4 = Word
255 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word32 -> Word
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 :: Word16
dot = Word16
46
      (Array
arr,Int
len) = (forall s. ST s (Array, Int)) -> (Array, Int)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array, Int)) -> (Array, Int))
-> (forall s. ST s (Array, Int)) -> (Array, Int)
forall a b. (a -> b) -> a -> b
$ do
        MArray s
marr <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
TArray.new Int
15
        Int
i1 <- Int -> Word -> MArray s -> ST s Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TArray.unsafeWrite MArray s
marr Int
n1 Word16
dot
        Int
i2 <- Int -> Word -> MArray s -> ST s Int
forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
n1' Word
w2 MArray s
marr
        let n2 :: Int
n2 = Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1'
            n2' :: Int
n2' = Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TArray.unsafeWrite MArray s
marr Int
n2 Word16
dot
        Int
i3 <- Int -> Word -> MArray s -> ST s Int
forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
n2' Word
w3 MArray s
marr
        let n3 :: Int
n3 = Int
i3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2'
            n3' :: Int
n3' = Int
n3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
TArray.unsafeWrite MArray s
marr Int
n3 Word16
dot
        Int
i4 <- Int -> Word -> MArray s -> ST s Int
forall s. Int -> Word -> MArray s -> ST s Int
putAndCount Int
n3' Word
w4 MArray s
marr
        Array
theArr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
TArray.unsafeFreeze MArray s
marr
        (Array, Int) -> ST s (Array, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array
theArr,Int
i4 Int -> Int -> Int
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 = (Int -> ByteString) -> [Int] -> ByteString
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (String -> ByteString
BC8.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d") ([Int] -> ByteString) -> [Int] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo (Int
0 :: Int) Int
99
{-# NOINLINE twoDigits #-}

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

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

zero :: Word16
zero :: Word16
zero = Word16
48

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

rightToMaybe :: Either a b -> Maybe b
rightToMaybe :: Either a b -> Maybe b
rightToMaybe = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
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.
--
-- >>> printRange $ fromBounds (fromOctets 192 168 16 0) (fromOctets 192 168 19 255)
-- 192.168.16.0/22
-- >>> printRange $ fromBounds (fromOctets 10 0 5 7) (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 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int
forall b. FiniteBits b => b -> Int
Bits.countLeadingZeros (Word32 -> Word32 -> Word32
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 = fromOctets 10 10 1 92
-- >>> contains (IPv4Range (fromOctets 10 0 0 0) 8) ip
-- True
-- >>> contains (IPv4Range (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 = IPv4Range (fromOctets 10 10 10 6) 31
-- >>> mapM_ (P.print . contains r) (take 5 $ iterate succ $ 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 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
theMask
   in \(IPv4 Word32
w) -> (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
theMask) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
wsubnetNormalized

mask :: Word8 -> Word32
mask :: Word8 -> Word32
mask = Word32 -> Word32
forall a. Bits a => a -> a
complement (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
0xffffffff (Int -> Word32) -> (Word8 -> Int) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
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> member ip r == contains r ip
member :: IPv4 -> IPv4Range -> Bool
member :: IPv4 -> IPv4Range -> Bool
member = (IPv4Range -> IPv4 -> Bool) -> IPv4 -> IPv4Range -> Bool
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 $ encode $ lowerInclusive $ IPv4Range (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> lowerInclusive r == ipv4RangeBase (normalize r)
lowerInclusive :: IPv4Range -> IPv4
lowerInclusive :: IPv4Range -> IPv4
lowerInclusive (IPv4Range (IPv4 Word32
w) Word8
len) =
  Word32 -> IPv4
IPv4 (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word8 -> Word32
mask Word8
len)

-- | The inclusive upper bound of an 'IPv4Range'.
--
--   >>> T.putStrLn $ encode $ upperInclusive $ IPv4Range (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 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
0xffffffff (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
      theMask :: Word32
theMask = Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
theInvertedMask
   in Word32 -> IPv4
IPv4 ((Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
theMask) Word32 -> Word32 -> Word32
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
32
        then Int
0
        else Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
   in Word64 -> Int -> Word64
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0
  then Word32 -> IPv4
IPv4 Word32
a IPv4 -> [IPv4] -> [IPv4]
forall a. a -> [a] -> [a]
: Word64 -> IPv4 -> [IPv4]
wordSuccessors (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) (Word32 -> IPv4
IPv4 (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1))
  else []

wordSuccessorsM :: MonadPlus m => Word64 -> IPv4 -> m IPv4
wordSuccessorsM :: Word64 -> IPv4 -> m IPv4
wordSuccessorsM = Word64 -> IPv4 -> m IPv4
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 t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0
    then m IPv4 -> m IPv4 -> m IPv4
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (IPv4 -> m IPv4
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IPv4
IPv4 Word32
a)) (t -> IPv4 -> m IPv4
go (t
w t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Word32 -> IPv4
IPv4 (Word32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)))
    else m IPv4
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Convert an 'IPv4Range' into a list of the 'IPv4' addresses that
--   are in it.
--
-- >>> let r = IPv4Range (fromOctets 192 168 1 8) 30
-- >>> mapM_ (T.putStrLn . encode) (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 :: IPv4Range -> m IPv4
toGenerator (IPv4Range IPv4
ip Word8
len) =
  let totalAddrs :: Word64
totalAddrs = Word8 -> Word64
countAddrs Word8
len
   in Word64 -> IPv4 -> m IPv4
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:
--
-- >>> printRange $ normalize $ IPv4Range (fromOctets 192 168 1 19) 24
-- 192.168.1.0/24
-- >>> printRange $ normalize $ IPv4Range (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> normalize r == (normalize . normalize) r
normalize :: IPv4Range -> IPv4Range
normalize :: IPv4Range -> IPv4Range
normalize (IPv4Range (IPv4 Word32
w) Word8
len) =
  let len' :: Word8
len' = Word8 -> Word8 -> Word8
forall a. Ord a => a -> a -> a
min Word8
len Word8
32
      w' :: Word32
w' = Word32
w Word32 -> Word32 -> Word32
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'.
--
--   >>> encodeRange (IPv4Range (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'.
--
--   >>> decodeRange "172.16.0.0/12"
--   Just (IPv4Range {ipv4RangeBase = ipv4 172 16 0 0, ipv4RangeLength = 12})
--   >>> 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 = Either String IPv4Range -> Maybe IPv4Range
forall a b. Either a b -> Maybe b
rightToMaybe (Either String IPv4Range -> Maybe IPv4Range)
-> (Text -> Either String IPv4Range) -> Text -> Maybe IPv4Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser IPv4Range -> Text -> Either String IPv4Range
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser IPv4Range
parserRange Parser IPv4Range -> Parser Text () -> Parser IPv4Range
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput)

-- | Encode an 'IPv4Range' to a 'TBuilder.Builder'.
--
--   >>> builderRange (IPv4Range (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 parserRange "192.168.25.254/16"
--   Right (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16})
parserRange :: AT.Parser IPv4Range
parserRange :: Parser IPv4Range
parserRange = do
  IPv4
ip <- Parser IPv4
parser
  Char
_ <- Char -> Parser Text Char
AT.char Char
'/'
  Word8
theMask <- Parser Word8
forall a. Integral a => Parser a
AT.decimal Parser Word8 -> (Word8 -> Parser Word8) -> Parser Word8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Parser Word8
forall a (m :: * -> *). (Ord a, Num a, MonadFail m) => a -> m a
limitSize
  IPv4Range -> Parser IPv4Range
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
32
      then String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"An IP range length must be between 0 and 32"
      else a -> m a
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 (Text -> IO ()) -> (IPv4Range -> Text) -> IPv4Range -> IO ()
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
(IPv4Range -> IPv4Range -> Bool)
-> (IPv4Range -> IPv4Range -> Bool) -> Eq IPv4Range
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
Eq IPv4Range
-> (IPv4Range -> IPv4Range -> Ordering)
-> (IPv4Range -> IPv4Range -> Bool)
-> (IPv4Range -> IPv4Range -> Bool)
-> (IPv4Range -> IPv4Range -> Bool)
-> (IPv4Range -> IPv4Range -> Bool)
-> (IPv4Range -> IPv4Range -> IPv4Range)
-> (IPv4Range -> IPv4Range -> IPv4Range)
-> Ord 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
$cp1Ord :: Eq IPv4Range
Ord,Int -> IPv4Range -> ShowS
[IPv4Range] -> ShowS
IPv4Range -> String
(Int -> IPv4Range -> ShowS)
-> (IPv4Range -> String)
-> ([IPv4Range] -> ShowS)
-> Show IPv4Range
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]
(Int -> ReadS IPv4Range)
-> ReadS [IPv4Range]
-> ReadPrec IPv4Range
-> ReadPrec [IPv4Range]
-> Read 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. IPv4Range -> Rep IPv4Range x)
-> (forall x. Rep IPv4Range x -> IPv4Range) -> Generic IPv4Range
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
DataType
Constr
Typeable IPv4Range
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IPv4Range -> c IPv4Range)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IPv4Range)
-> (IPv4Range -> Constr)
-> (IPv4Range -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> IPv4Range -> IPv4Range)
-> (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 u. (forall d. Data d => d -> u) -> IPv4Range -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IPv4Range -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IPv4Range -> m IPv4Range)
-> Data IPv4Range
IPv4Range -> DataType
IPv4Range -> Constr
(forall b. Data b => b -> b) -> IPv4Range -> IPv4Range
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IPv4Range -> c IPv4Range
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIPv4Range :: Constr
$tIPv4Range :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> IPv4Range -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IPv4Range -> u
gmapQ :: (forall d. Data d => d -> u) -> IPv4Range -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IPv4Range -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable IPv4Range
Data)

instance NFData IPv4Range
instance Hashable IPv4Range

instance ToJSON IPv4Range where
  toJSON :: IPv4Range -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (IPv4Range -> Text) -> IPv4Range -> Value
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 -> String -> Parser IPv4Range
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decodeRange IPv4 range"
    Just IPv4Range
res -> IPv4Range -> Parser IPv4Range
forall (m :: * -> *) a. Monad m => a -> m a
return IPv4Range
res
  parseJSON Value
_ = Parser IPv4Range
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 :: MVector s IPv4Range -> Int
basicLength (MV_IPv4Range as _) = MVector s IPv4 -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MGVector.basicLength MVector s IPv4
as
  {-# INLINE basicUnsafeSlice  #-}
  basicUnsafeSlice :: Int -> Int -> MVector s IPv4Range -> MVector s IPv4Range
basicUnsafeSlice Int
i_ Int
m_ (MV_IPv4Range as bs)
      = MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
forall s. MVector s IPv4 -> MVector s Word8 -> MVector s IPv4Range
MV_IPv4Range (Int -> Int -> MVector s IPv4 -> MVector s IPv4
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)
                     (Int -> Int -> MVector s Word8 -> MVector s Word8
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 :: MVector s IPv4Range -> MVector s IPv4Range -> Bool
basicOverlaps (MV_IPv4Range as1 bs1) (MV_IPv4Range as2 bs2)
      = MVector s IPv4 -> MVector s IPv4 -> Bool
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
|| MVector s Word8 -> MVector s Word8 -> 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 :: Int -> m (MVector (PrimState m) IPv4Range)
basicUnsafeNew Int
n_
      = do
          MVector (PrimState m) IPv4
as <- Int -> m (MVector (PrimState m) IPv4)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n_
          MVector (PrimState m) Word8
bs <- Int -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MGVector.basicUnsafeNew Int
n_
          MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) IPv4Range
 -> m (MVector (PrimState m) IPv4Range))
-> MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) IPv4
-> MVector (PrimState m) Word8 -> MVector (PrimState m) IPv4Range
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 :: MVector (PrimState m) IPv4Range -> m ()
basicInitialize (MV_IPv4Range as bs)
      = do
          MVector (PrimState m) IPv4 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) IPv4
as
          MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicInitialize MVector (PrimState m) Word8
bs
  {-# INLINE basicUnsafeReplicate  #-}
  basicUnsafeReplicate :: Int -> IPv4Range -> m (MVector (PrimState m) IPv4Range)
basicUnsafeReplicate Int
n_ (IPv4Range IPv4
a Word8
b)
      = do
          MVector (PrimState m) IPv4
as <- Int -> IPv4 -> m (MVector (PrimState m) IPv4)
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 <- Int -> Word8 -> m (MVector (PrimState m) Word8)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
MGVector.basicUnsafeReplicate Int
n_ Word8
b
          MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) IPv4
-> MVector (PrimState m) Word8 -> MVector (PrimState m) IPv4Range
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 :: MVector (PrimState m) IPv4Range -> Int -> m IPv4Range
basicUnsafeRead (MV_IPv4Range as bs) Int
i_
      = do
          IPv4
a <- MVector (PrimState m) IPv4 -> Int -> m IPv4
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 <- MVector (PrimState m) Word8 -> Int -> m Word8
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_
          IPv4Range -> m IPv4Range
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
a Word8
b)
  {-# INLINE basicUnsafeWrite  #-}
  basicUnsafeWrite :: MVector (PrimState m) IPv4Range -> Int -> IPv4Range -> m ()
basicUnsafeWrite (MV_IPv4Range as bs) Int
i_ (IPv4Range IPv4
a Word8
b)
      = do
          MVector (PrimState m) IPv4 -> Int -> IPv4 -> m ()
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
          MVector (PrimState m) Word8 -> Int -> Word8 -> m ()
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 :: MVector (PrimState m) IPv4Range -> m ()
basicClear (MV_IPv4Range as bs)
      = do
          MVector (PrimState m) IPv4 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) IPv4
as
          MVector (PrimState m) Word8 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
MGVector.basicClear MVector (PrimState m) Word8
bs
  {-# INLINE basicSet  #-}
  basicSet :: MVector (PrimState m) IPv4Range -> IPv4Range -> m ()
basicSet (MV_IPv4Range as bs) (IPv4Range IPv4
a Word8
b)
      = do
          MVector (PrimState m) IPv4 -> IPv4 -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MGVector.basicSet MVector (PrimState m) IPv4
as IPv4
a
          MVector (PrimState m) Word8 -> Word8 -> m ()
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 :: MVector (PrimState m) IPv4Range
-> MVector (PrimState m) IPv4Range -> m ()
basicUnsafeCopy (MV_IPv4Range as1 bs1) (MV_IPv4Range as2 bs2)
      = do
          MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
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
          MVector (PrimState m) Word8 -> MVector (PrimState m) Word8 -> m ()
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 :: MVector (PrimState m) IPv4Range
-> MVector (PrimState m) IPv4Range -> m ()
basicUnsafeMove (MV_IPv4Range as1 bs1) (MV_IPv4Range as2 bs2)
      = do
          MVector (PrimState m) IPv4 -> MVector (PrimState m) IPv4 -> m ()
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
          MVector (PrimState m) Word8 -> MVector (PrimState m) Word8 -> m ()
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 :: MVector (PrimState m) IPv4Range
-> Int -> m (MVector (PrimState m) IPv4Range)
basicUnsafeGrow (MV_IPv4Range as bs) Int
m_
      = do
          MVector (PrimState m) IPv4
as' <- MVector (PrimState m) IPv4 -> Int -> m (MVector (PrimState m) IPv4)
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' <- MVector (PrimState m) Word8
-> Int -> m (MVector (PrimState m) Word8)
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_
          MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) IPv4Range
 -> m (MVector (PrimState m) IPv4Range))
-> MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) IPv4
-> MVector (PrimState m) Word8 -> MVector (PrimState m) IPv4Range
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 :: Mutable Vector (PrimState m) IPv4Range -> m (Vector IPv4Range)
basicUnsafeFreeze (MV_IPv4Range as bs)
      = do
          Vector IPv4
as' <- Mutable Vector (PrimState m) IPv4 -> m (Vector IPv4)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) IPv4
Mutable Vector (PrimState m) IPv4
as
          Vector Word8
bs' <- Mutable Vector (PrimState m) Word8 -> m (Vector Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
GVector.basicUnsafeFreeze MVector (PrimState m) Word8
Mutable Vector (PrimState m) Word8
bs
          Vector IPv4Range -> m (Vector IPv4Range)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector IPv4Range -> m (Vector IPv4Range))
-> Vector IPv4Range -> m (Vector IPv4Range)
forall a b. (a -> b) -> a -> b
$ Vector IPv4 -> Vector Word8 -> Vector IPv4Range
V_IPv4Range Vector IPv4
as' Vector Word8
bs'
  {-# INLINE basicUnsafeThaw  #-}
  basicUnsafeThaw :: Vector IPv4Range -> m (Mutable Vector (PrimState m) IPv4Range)
basicUnsafeThaw (V_IPv4Range as bs)
      = do
          MVector (PrimState m) IPv4
as' <- Vector IPv4 -> m (Mutable Vector (PrimState m) IPv4)
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' <- Vector Word8 -> m (Mutable Vector (PrimState m) Word8)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
GVector.basicUnsafeThaw Vector Word8
bs
          MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) IPv4Range
 -> m (MVector (PrimState m) IPv4Range))
-> MVector (PrimState m) IPv4Range
-> m (MVector (PrimState m) IPv4Range)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) IPv4
-> MVector (PrimState m) Word8 -> MVector (PrimState m) IPv4Range
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 as _) = Vector IPv4 -> Int
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 as bs)
      = Vector IPv4 -> Vector Word8 -> Vector IPv4Range
V_IPv4Range (Int -> Int -> Vector IPv4 -> Vector IPv4
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i_ Int
m_ Vector IPv4
as)
                    (Int -> Int -> Vector Word8 -> Vector Word8
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
GVector.basicUnsafeSlice Int
i_ Int
m_ Vector Word8
bs)
  {-# INLINE basicUnsafeIndexM  #-}
  basicUnsafeIndexM :: Vector IPv4Range -> Int -> m IPv4Range
basicUnsafeIndexM (V_IPv4Range as bs) Int
i_
      = do
          IPv4
a <- Vector IPv4 -> Int -> m IPv4
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector IPv4
as Int
i_
          Word8
b <- Vector Word8 -> Int -> m Word8
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
GVector.basicUnsafeIndexM Vector Word8
bs Int
i_
          IPv4Range -> m IPv4Range
forall (m :: * -> *) a. Monad m => a -> m a
return (IPv4 -> Word8 -> IPv4Range
IPv4Range IPv4
a Word8
b)
  {-# INLINE basicUnsafeCopy  #-}
  basicUnsafeCopy :: Mutable Vector (PrimState m) IPv4Range -> Vector IPv4Range -> m ()
basicUnsafeCopy (MV_IPv4Range as1 bs1) (V_IPv4Range as2 bs2)
      = do
          Mutable Vector (PrimState m) IPv4 -> Vector IPv4 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) IPv4
Mutable Vector (PrimState m) IPv4
as1 Vector IPv4
as2
          Mutable Vector (PrimState m) Word8 -> Vector Word8 -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
GVector.basicUnsafeCopy MVector (PrimState m) Word8
Mutable Vector (PrimState m) Word8
bs1 Vector Word8
bs2
  {-# INLINE elemseq  #-}
  elemseq :: Vector IPv4Range -> IPv4Range -> b -> b
elemseq Vector IPv4Range
_ (IPv4Range IPv4
a Word8
b)
      = Vector IPv4 -> IPv4 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
GVector.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: UVector.Vector a) IPv4
a
        (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> Word8 -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
GVector.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: UVector.Vector b) Word8
b

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

rangeToDotDecimalText :: IPv4Range -> Text
rangeToDotDecimalText :: IPv4Range -> Text
rangeToDotDecimalText = Text -> Text
LText.toStrict (Text -> Text) -> (IPv4Range -> Text) -> IPv4Range -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TBuilder.toLazyText (Builder -> Text) -> (IPv4Range -> Builder) -> IPv4Range -> Text
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
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TBuilder.singleton Char
'/'
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. Integral a => a -> Builder
TBI.decimal Word8
len