{-# 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
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)
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 = 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
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']