    -- |
    -- Module      : Foundation.Network.IPv4
    -- License     : BSD-style
    -- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>
    -- Stability   : experimental
    -- Portability : portable
    --
    -- IPv4 data type
    --
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeApplications #-}

    module Foundation.Network.IPv4
        ( IPv4
        , any, loopback
        , fromString, toString
        , fromTuple, toTuple
        , ipv4Parser
        ) where

    import Prelude (fromIntegral)

    import Foundation.Class.Storable
    import Foundation.Hashing.Hashable
    import Basement.Compat.Base
    import Data.Proxy
    import Foundation.String (String)
    import Foundation.Primitive
    import Basement.Bits
    import Foundation.Parser hiding (peek)
    import Foundation.Collection (Sequential, Element, elem)
    import Text.Read (readMaybe)

    -- | IPv4 data type
    newtype IPv4 = IPv4 Word32
        deriving (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, 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, Typeable, IPv4 -> st -> st
    (forall st. Hasher st => IPv4 -> st -> st) -> Hashable IPv4
    forall st. Hasher st => IPv4 -> st -> st
    forall a. (forall st. Hasher st => a -> st -> st) -> Hashable a
    hashMix :: IPv4 -> st -> st
    $chashMix :: forall st. Hasher st => IPv4 -> st -> st
    Hashable)
    instance Show IPv4 where
        show :: IPv4 -> String
    show = IPv4 -> String
    toLString
    instance NormalForm IPv4 where
        toNormalForm :: IPv4 -> ()
    toNormalForm !IPv4
    _ = ()
    instance IsString IPv4 where
        fromString :: String -> IPv4
    fromString = String -> IPv4
    fromLString
    instance Storable IPv4 where
        peek :: Ptr IPv4 -> IO IPv4
    peek ptr :: Ptr IPv4
    ptr = Word32 -> IPv4
    IPv4 (Word32 -> IPv4) -> (BE Word32 -> Word32) -> BE Word32 -> IPv4
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . BE Word32 -> Word32
    forall a. ByteSwap a => BE a -> a
    fromBE (BE Word32 -> IPv4) -> IO (BE Word32) -> IO IPv4
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr (BE Word32) -> IO (BE Word32)
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr IPv4 -> Ptr (BE Word32)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr IPv4
    ptr)
        poke :: Ptr IPv4 -> IPv4 -> IO ()
    poke ptr :: Ptr IPv4
    ptr (IPv4 w :: Word32
    w) = Ptr (BE Word32) -> BE Word32 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr IPv4 -> Ptr (BE Word32)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr IPv4
    ptr) (Word32 -> BE Word32
    forall a. ByteSwap a => a -> BE a
    toBE Word32
    w)
    instance StorableFixed IPv4 where
        size :: proxy IPv4 -> CountOf Word8
    size      _ = Proxy Word32 -> CountOf Word8
    forall a (proxy :: * -> *).
    StorableFixed a =>
    proxy a -> CountOf Word8
    size      (Proxy Word32
    forall k (t :: k). Proxy t
    Proxy :: Proxy Word32)
        alignment :: proxy IPv4 -> CountOf Word8
    alignment _ = Proxy Word32 -> CountOf Word8
    forall a (proxy :: * -> *).
    StorableFixed a =>
    proxy a -> CountOf Word8
    alignment (Proxy Word32
    forall k (t :: k). Proxy t
    Proxy :: Proxy Word32)

    -- | "0.0.0.0"
    any :: IPv4
    any :: IPv4
    any = (Word8, Word8, Word8, Word8) -> IPv4
    fromTuple (0,0,0,0)

    -- | "127.0.0.1"
    loopback :: IPv4
    loopback :: IPv4
    loopback = (Word8, Word8, Word8, Word8) -> IPv4
    fromTuple (127,0,0,1)

    toString :: IPv4 -> String
    toString :: IPv4 -> String
    toString = String -> String
    forall l. IsList l => [Item l] -> l
    fromList (String -> String) -> (IPv4 -> String) -> IPv4 -> String
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . IPv4 -> String
    toLString

    fromLString :: [Char] -> IPv4
    fromLString :: String -> IPv4
    fromLString = (ParseError String -> IPv4)
    -> (IPv4 -> IPv4) -> Either (ParseError String) IPv4 -> IPv4
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ParseError String -> IPv4
    forall a e. Exception e => e -> a
    throw IPv4 -> IPv4
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id (Either (ParseError String) IPv4 -> IPv4)
    -> (String -> Either (ParseError String) IPv4) -> String -> IPv4
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Parser String IPv4 -> String -> Either (ParseError String) IPv4
    forall input a.
    (ParserSource input, Monoid (Chunk input)) =>
    Parser input a -> input -> Either (ParseError input) a
    parseOnly Parser String IPv4
    forall input.
    (ParserSource input, Element input ~ Char,
     Sequential (Chunk input), Element input ~ Element (Chunk input)) =>
    Parser input IPv4
    ipv4Parser

    toLString :: IPv4 -> [Char]
    toLString :: IPv4 -> String
    toLString ipv4 :: IPv4
    ipv4 =
        let (i1 :: Word8
    i1, i2 :: Word8
    i2, i3 :: Word8
    i3, i4 :: Word8
    i4) = IPv4 -> (Word8, Word8, Word8, Word8)
    toTuple IPv4
    ipv4
         in Word8 -> String
    forall a. Show a => a -> String
    show Word8
    i1 String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> "." String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> String
    forall a. Show a => a -> String
    show Word8
    i2 String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> "." String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> String
    forall a. Show a => a -> String
    show Word8
    i3 String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> "." String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> String
    forall a. Show a => a -> String
    show Word8
    i4

    fromTuple :: (Word8, Word8, Word8, Word8) -> IPv4
    fromTuple :: (Word8, Word8, Word8, Word8) -> IPv4
    fromTuple (i1 :: Word8
    i1, i2 :: Word8
    i2, i3 :: Word8
    i3, i4 :: Word8
    i4) =
         Word32 -> IPv4
    IPv4 (Word32 -> IPv4) -> Word32 -> IPv4
    forall a b. (a -> b) -> a -> b
    $     (Word32
    w1 Word32 -> CountOf Bool -> Word32
    forall bits. BitOps bits => bits -> CountOf Bool -> bits
    .<<. 24) Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0xFF000000
                Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .|. (Word32
    w2 Word32 -> CountOf Bool -> Word32
    forall bits. BitOps bits => bits -> CountOf Bool -> bits
    .<<. 16) Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x00FF0000
                Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .|. (Word32
    w3 Word32 -> CountOf Bool -> Word32
    forall bits. BitOps bits => bits -> CountOf Bool -> bits
    .<<.  8) Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x0000FF00
                Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .|.  Word32
    w4          Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x000000FF
      where
        f :: Word8 -> Word32
    f = Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral
        w1, w2, w3, w4 :: Word32
        w1 :: Word32
    w1 = Word8 -> Word32
    f Word8
    i1
        w2 :: Word32
    w2 = Word8 -> Word32
    f Word8
    i2
        w3 :: Word32
    w3 = Word8 -> Word32
    f Word8
    i3
        w4 :: Word32
    w4 = Word8 -> Word32
    f Word8
    i4

    toTuple :: IPv4 -> (Word8, Word8, Word8, Word8)
    toTuple :: IPv4 -> (Word8, Word8, Word8, Word8)
    toTuple (IPv4 w :: Word32
    w) =
        (Word32 -> Word8
    f Word32
    w1, Word32 -> Word8
    f Word32
    w2, Word32 -> Word8
    f Word32
    w3, Word32 -> Word8
    f Word32
    w4)
      where
        f :: Word32 -> Word8
    f = Word32 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral
        w1, w2, w3, w4 :: Word32
        w1 :: Word32
    w1 = Word32
    w Word32 -> CountOf Bool -> Word32
    forall bits. BitOps bits => bits -> CountOf Bool -> bits
    .>>. 24 Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x000000FF
        w2 :: Word32
    w2 = Word32
    w Word32 -> CountOf Bool -> Word32
    forall bits. BitOps bits => bits -> CountOf Bool -> bits
    .>>. 16 Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x000000FF
        w3 :: Word32
    w3 = Word32
    w Word32 -> CountOf Bool -> Word32
    forall bits. BitOps bits => bits -> CountOf Bool -> bits
    .>>.  8 Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x000000FF
        w4 :: Word32
    w4 = Word32
    w         Word32 -> Word32 -> Word32
    forall bits. BitOps bits => bits -> bits -> bits
    .&. 0x000000FF

    -- | Parse a IPv4 address
    ipv4Parser :: ( ParserSource input, Element input ~ Char
                  , Sequential (Chunk input), Element input ~ Element (Chunk input)
                  )
               => Parser input IPv4
    ipv4Parser :: Parser input IPv4
    ipv4Parser = do
        Word8
    i1 <- Parser input Word8
    takeAWord8 Parser input Word8 -> Parser input () -> Parser input Word8
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Element input -> Parser input ()
    forall input.
    (ParserSource input, Eq (Element input),
     Element input ~ Element (Chunk input)) =>
    Element input -> Parser input ()
    element Element input
    '.'
        Word8
    i2 <- Parser input Word8
    takeAWord8 Parser input Word8 -> Parser input () -> Parser input Word8
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Element input -> Parser input ()
    forall input.
    (ParserSource input, Eq (Element input),
     Element input ~ Element (Chunk input)) =>
    Element input -> Parser input ()
    element Element input
    '.'
        Word8
    i3 <- Parser input Word8
    takeAWord8 Parser input Word8 -> Parser input () -> Parser input Word8
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Element input -> Parser input ()
    forall input.
    (ParserSource input, Eq (Element input),
     Element input ~ Element (Chunk input)) =>
    Element input -> Parser input ()
    element Element input
    '.'
        Word8
    i4 <- Parser input Word8
    takeAWord8
        IPv4 -> Parser input IPv4
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IPv4 -> Parser input IPv4) -> IPv4 -> Parser input IPv4
    forall a b. (a -> b) -> a -> b
    $ (Word8, Word8, Word8, Word8) -> IPv4
    fromTuple (Word8
    i1, Word8
    i2, Word8
    i3, Word8
    i4)
      where
        takeAWord8 :: Parser input Word8
    takeAWord8 = do
          Maybe Integer
    maybeN <- Read Integer => String -> Maybe Integer
    forall a. Read a => String -> Maybe a
    readMaybe @Integer (String -> Maybe Integer)
    -> (Chunk input -> String) -> Chunk input -> Maybe Integer
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Chunk input -> String
    forall l. IsList l => l -> [Item l]
    toList (Chunk input -> Maybe Integer)
    -> Parser input (Chunk input) -> Parser input (Maybe Integer)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Element input -> Bool) -> Parser input (Chunk input)
    forall input.
    (ParserSource input, Sequential (Chunk input)) =>
    (Element input -> Bool) -> Parser input (Chunk input)
    takeWhile Char -> Bool
    Element input -> Bool
    isAsciiDecimal
          case Maybe Integer
    maybeN of
            Nothing -> ParseError input -> Parser input Word8
    forall input a. ParseError input -> Parser input a
    reportError (ParseError input -> Parser input Word8)
    -> ParseError input -> Parser input Word8
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> ParseError input
    forall input. Maybe String -> ParseError input
    Satisfy (Maybe String -> ParseError input)
    -> Maybe String -> ParseError input
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String
    forall a. a -> Maybe a
    Just "expected integer"
            Just n :: Integer
    n | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > 256   -> ParseError input -> Parser input Word8
    forall input a. ParseError input -> Parser input a
    reportError (ParseError input -> Parser input Word8)
    -> ParseError input -> Parser input Word8
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> ParseError input
    forall input. Maybe String -> ParseError input
    Satisfy (Maybe String -> ParseError input)
    -> Maybe String -> ParseError input
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String
    forall a. a -> Maybe a
    Just "expected smaller integer than 256"
                   | Bool
    otherwise -> Word8 -> Parser input Word8
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Integer -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    n)

        isAsciiDecimal :: Char -> Bool
    isAsciiDecimal = (Char -> String -> Bool) -> String -> Char -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Char -> String -> Bool
    forall c a.
    (Collection c, Eq a, a ~ Element c) =>
    Element c -> c -> Bool
    elem ['0'..'9']