{-# 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)
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 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 IPv4
ptr (IPv4 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 IPv4
_ = 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 IPv4
_ = 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)
any :: IPv4
any :: IPv4
any = (Word8, Word8, Word8, Word8) -> IPv4
fromTuple (Word8
0,Word8
0,Word8
0,Word8
0)
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 = 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 =
let (Word8
i1, Word8
i2, Word8
i3, 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
"." 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
"." 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
"." 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 (Word8
i1, Word8
i2, Word8
i3, 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
.<<. CountOf Bool
24) Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
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
.<<. CountOf Bool
16) Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
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
.<<. CountOf Bool
8) Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x0000FF00
Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.|. Word32
w4 Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
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 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
.>>. CountOf Bool
24 Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x000000FF
w2 :: Word32
w2 = Word32
w Word32 -> CountOf Bool -> Word32
forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
16 Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x000000FF
w3 :: Word32
w3 = Word32
w Word32 -> CountOf Bool -> Word32
forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
8 Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x000000FF
w4 :: Word32
w4 = Word32
w Word32 -> Word32 -> Word32
forall bits. BitOps bits => bits -> bits -> bits
.&. Word32
0x000000FF
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 Char
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 Char
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 Char
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
Maybe Integer
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 String
"expected integer"
Just Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
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 String
"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 [Char
'0'..Char
'9']