{- ORMOLU_DISABLE -}
module Net.IPv4
  ( decodeRange
  , IPv4Range
  , member
  , fromTupleOctets 
  -- * Net.IPvN internal (not used by hasura directly)
  , parser
  , IPv4(..)
  ) where

------ Vendored from the 'ip' package at 7cbe515d6, with the following trivial
------ changes:
------   - a few derived instances removed from data types
------
------ If you need to add functionality, please do so in a different module (e.g. *.Extended)
------ 
------ Possible paths back to upstream again might be:
------   - requesting a 'ip-types' package with lower dependency footprint
------
------ Original license:
{-
Copyright Andrew Martin (c) 2016

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Andrew Martin nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import Prelude
import Data.Word
import qualified Data.Attoparsec.Text as AT
import Data.Text (Text)
import GHC.Generics (Generic)
import Data.Ix (Ix)
import Data.Hashable
import Data.Bits (Bits(..))
import qualified Data.Bits as Bits


-- | 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)

-- | 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,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,ReadPrec [IPv4]
ReadPrec IPv4
Int -> ReadS IPv4
ReadS [IPv4]
(Int -> ReadS IPv4)
-> ReadS [IPv4] -> ReadPrec IPv4 -> ReadPrec [IPv4] -> Read IPv4
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IPv4]
$creadListPrec :: ReadPrec [IPv4]
readPrec :: ReadPrec IPv4
$creadPrec :: ReadPrec IPv4
readList :: ReadS [IPv4]
$creadList :: ReadS [IPv4]
readsPrec :: Int -> ReadS IPv4
$creadsPrec :: Int -> ReadS IPv4
Read,Int -> IPv4 -> ShowS
[IPv4] -> ShowS
IPv4 -> String
(Int -> IPv4 -> ShowS)
-> (IPv4 -> String) -> ([IPv4] -> ShowS) -> Show IPv4
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPv4] -> ShowS
$cshowList :: [IPv4] -> ShowS
show :: IPv4 -> String
$cshow :: IPv4 -> String
showsPrec :: Int -> IPv4 -> ShowS
$cshowsPrec :: Int -> IPv4 -> ShowS
Show)

-- | Decode an 'IPv4Range' from 'Text'.
--
--   >>> IPv4.decodeRange "172.16.0.0/12"
--   Just (IPv4Range {ipv4RangeBase = ipv4 172 16 0 0, ipv4RangeLength = 12})
--   >>> IPv4.decodeRange "192.168.25.254/16"
--   Just (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16})
decodeRange :: Text -> Maybe IPv4Range
decodeRange :: Text -> Maybe IPv4Range
decodeRange = 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)

-- | Parse an 'IPv4Range' using a 'AT.Parser'.
--
--   >>> AT.parseOnly IPv4.parserRange "192.168.25.254/16"
--   Right (IPv4Range {ipv4RangeBase = ipv4 192 168 0 0, ipv4RangeLength = 16})
parserRange :: AT.Parser IPv4Range
parserRange :: Parser IPv4Range
parserRange = do
  IPv4
ip <- Parser IPv4
parser
  Char
_ <- Char -> Parser 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

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

-- | 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 Char -> Parser Text (Word -> Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser 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 Char -> Parser Text (Word -> Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser 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 Char -> Parser Text (Word -> IPv4)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser 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


-- | Checks to see if an 'IPv4' address belongs in the 'IPv4Range'.
--
-- >>> let ip = IPv4.fromOctets 10 10 1 92
-- >>> IPv4.contains (IPv4.IPv4Range (IPv4.fromOctets 10 0 0 0) 8) ip
-- True
-- >>> IPv4.contains (IPv4.IPv4Range (IPv4.fromOctets 10 11 0 0) 16) ip
-- False
--
-- Typically, element-testing functions are written to take the element
-- as the first argument and the set as the second argument. This is intentionally
-- written the other way for better performance when iterating over a collection.
-- For example, you might test elements in a list for membership like this:
--
-- >>> let r = IPv4.IPv4Range (IPv4.fromOctets 10 10 10 6) 31
-- >>> mapM_ (P.print . IPv4.contains r) (take 5 $ iterate succ $ IPv4.fromOctets 10 10 10 5)
-- False
-- True
-- True
-- False
-- False
--
-- The implementation of 'contains' ensures that (with GHC), the bitmask
-- creation and range normalization only occur once in the above example.
-- They are reused as the list is iterated.
contains :: IPv4Range -> IPv4 -> Bool
contains :: IPv4Range -> IPv4 -> Bool
contains (IPv4Range (IPv4 Word32
wsubnet) Word8
len) =
  let theMask :: Word32
theMask = Word8 -> Word32
mask Word8
len
      wsubnetNormalized :: Word32
wsubnetNormalized = Word32
wsubnet 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> IPv4.member ip r == IPv4.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

-- | 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

-- | 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
    )

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

-- | Normalize an 'IPv4Range'. The first result of this is that the
-- 'IPv4' inside the 'IPv4Range' is changed so that the insignificant
-- bits are zeroed out. For example:
--
-- >>> IPv4.printRange $ IPv4.normalize $ IPv4.IPv4Range (IPv4.fromOctets 192 168 1 19) 24
-- 192.168.1.0/24
-- >>> IPv4.printRange $ IPv4.normalize $ IPv4.IPv4Range (IPv4.fromOctets 192 168 1 163) 28
-- 192.168.1.160/28
--
-- The second effect of this is that the mask length is lowered to
-- be 32 or smaller. Working with 'IPv4Range's that have not been
-- normalized does not cause any issues for this library, although
-- other applications may reject such ranges (especially those with
-- a mask length above 32).
--
-- Note that 'normalize' is idempotent, that is:
--
-- prop> IPv4.normalize r == (IPv4.normalize . IPv4.normalize) r
normalize :: IPv4Range -> IPv4Range
normalize :: IPv4Range -> IPv4Range
normalize (IPv4Range (IPv4 Word32
w) Word8
len) =
  let len' :: Word8
len' = 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'


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