-- |
-- 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 #-}
{-# LANGUAGE TypeOperators #-}

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
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
IPv4 -> IPv4 -> Bool
IPv4 -> IPv4 -> Ordering
IPv4 -> IPv4 -> IPv4
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IPv4 -> IPv4 -> IPv4
$cmin :: IPv4 -> IPv4 -> IPv4
max :: IPv4 -> IPv4 -> IPv4
$cmax :: IPv4 -> IPv4 -> IPv4
>= :: IPv4 -> IPv4 -> Bool
$c>= :: IPv4 -> IPv4 -> Bool
> :: IPv4 -> IPv4 -> Bool
$c> :: IPv4 -> IPv4 -> Bool
<= :: IPv4 -> IPv4 -> Bool
$c<= :: IPv4 -> IPv4 -> Bool
< :: IPv4 -> IPv4 -> Bool
$c< :: IPv4 -> IPv4 -> Bool
compare :: IPv4 -> IPv4 -> Ordering
$ccompare :: IPv4 -> IPv4 -> Ordering
Ord, Typeable, forall st. Hasher st => IPv4 -> st -> st
forall a. (forall st. Hasher st => a -> st -> st) -> Hashable a
hashMix :: forall st. Hasher st => IPv4 -> st -> st
$chashMix :: forall st. Hasher st => IPv4 -> st -> st
Hashable)
instance Show IPv4 where
    show :: IPv4 -> [Char]
show = IPv4 -> [Char]
toLString
instance NormalForm IPv4 where
    toNormalForm :: IPv4 -> ()
toNormalForm !IPv4
_ = ()
instance IsString IPv4 where
    fromString :: [Char] -> IPv4
fromString = [Char] -> IPv4
fromLString
instance Storable IPv4 where
    peek :: Ptr IPv4 -> IO IPv4
peek Ptr IPv4
ptr = Word32 -> IPv4
IPv4 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ByteSwap a => BE a -> a
fromBE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr IPv4
ptr)
    poke :: Ptr IPv4 -> IPv4 -> IO ()
poke Ptr IPv4
ptr (IPv4 Word32
w) = forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr IPv4
ptr) (forall a. ByteSwap a => a -> BE a
toBE Word32
w)
instance StorableFixed IPv4 where
    size :: forall (proxy :: * -> *). proxy IPv4 -> CountOf Word8
size      proxy IPv4
_ = forall a (proxy :: * -> *).
StorableFixed a =>
proxy a -> CountOf Word8
size      (forall {k} (t :: k). Proxy t
Proxy :: Proxy Word32)
    alignment :: forall (proxy :: * -> *). proxy IPv4 -> CountOf Word8
alignment proxy IPv4
_ = forall a (proxy :: * -> *).
StorableFixed a =>
proxy a -> CountOf Word8
alignment (forall {k} (t :: k). Proxy t
Proxy :: Proxy Word32)

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

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

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

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

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

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

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

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