{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wall #-}
module Net.IP
(
case_
, isIPv4
, isIPv6
, ipv4
, ipv6
, fromIPv4
, fromIPv6
, encode
, encodeShort
, decode
, decodeShort
, boundedBuilderUtf8
, decodeUtf8Bytes
, parserUtf8Bytes
, print
, IP(..)
) where
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON(..),ToJSON(..))
import Data.Bits
import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Ix (Ix)
import Data.Text (Text)
import Data.WideWord (Word128(..))
import Data.Word (Word8,Word16)
import GHC.Generics (Generic)
import Net.IPv4 (IPv4(..))
import Net.IPv6 (IPv6(..))
import Prelude hiding (print)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.Read (Read(..))
import Data.Text.Short (ShortText)
import qualified Arithmetic.Lte as Lte
import qualified Data.Aeson as Aeson
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Builder.Bounded as BB
import qualified Data.Text.IO as TIO
import qualified Data.Bytes.Parser as Parser
import qualified Net.IPv4 as IPv4
import qualified Net.IPv6 as IPv6
case_ :: (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ :: (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ IPv4 -> a
f IPv6 -> a
g (IP addr :: IPv6
addr@(IPv6 (Word128 Word64
w1 Word64
w2))) = if Word64
w1 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
&& (Word64
0xFFFFFFFF00000000 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
w2 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0x0000FFFF00000000)
then IPv4 -> a
f (Word32 -> IPv4
IPv4 (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w2))
else IPv6 -> a
g IPv6
addr
ipv4 :: Word8 -> Word8 -> Word8 -> Word8 -> IP
ipv4 :: Word8 -> Word8 -> Word8 -> Word8 -> IP
ipv4 Word8
a Word8
b Word8
c Word8
d = IPv4 -> IP
fromIPv4 (Word8 -> Word8 -> Word8 -> Word8 -> IPv4
IPv4.fromOctets Word8
a Word8
b Word8
c Word8
d)
ipv6 :: Word16 -> Word16 -> Word16 -> Word16
-> Word16 -> Word16 -> Word16 -> Word16
-> IP
ipv6 :: Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IP
ipv6 Word16
a Word16
b Word16
c Word16
d Word16
e Word16
f Word16
g Word16
h = IPv6 -> IP
fromIPv6 (Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> IPv6
IPv6.fromWord16s Word16
a Word16
b Word16
c Word16
d Word16
e Word16
f Word16
g Word16
h)
fromIPv4 :: IPv4 -> IP
fromIPv4 :: IPv4 -> IP
fromIPv4 (IPv4 Word32
w) = IPv6 -> IP
IP (Word128 -> IPv6
IPv6 (Word64 -> Word64 -> Word128
Word128 Word64
0 (Word64
0x0000FFFF00000000 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w)))
fromIPv6 :: IPv6 -> IP
fromIPv6 :: IPv6 -> IP
fromIPv6 = IPv6 -> IP
IP
encode :: IP -> Text
encode :: IP -> Text
encode = (IPv4 -> Text) -> (IPv6 -> Text) -> IP -> Text
forall a. (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ IPv4 -> Text
IPv4.encode IPv6 -> Text
IPv6.encode
encodeShort :: IP -> ShortText
encodeShort :: IP -> ShortText
encodeShort = (IPv4 -> ShortText) -> (IPv6 -> ShortText) -> IP -> ShortText
forall a. (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ IPv4 -> ShortText
IPv4.encodeShort IPv6 -> ShortText
IPv6.encodeShort
boundedBuilderUtf8 :: IP -> BB.Builder 39
boundedBuilderUtf8 :: IP -> Builder 39
boundedBuilderUtf8 = (IPv4 -> Builder 39) -> (IPv6 -> Builder 39) -> IP -> Builder 39
forall a. (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_
(\IPv4
y -> (15 <= 39) -> Builder 15 -> Builder 39
forall (m :: Nat) (n :: Nat). (m <= n) -> Builder m -> Builder n
BB.weaken 15 <= 39
forall (a :: Nat) (b :: Nat).
(IsLte (CmpNat a b) ~ 'True) =>
a <= b
Lte.constant (IPv4 -> Builder 15
IPv4.boundedBuilderUtf8 IPv4
y))
IPv6 -> Builder 39
IPv6.boundedBuilderUtf8
decode :: Text -> Maybe IP
decode :: Text -> Maybe IP
decode Text
t = case Text -> Maybe IPv4
IPv4.decode Text
t of
Maybe IPv4
Nothing -> case Text -> Maybe IPv6
IPv6.decode Text
t of
Maybe IPv6
Nothing -> Maybe IP
forall a. Maybe a
Nothing
Just IPv6
v6 -> IP -> Maybe IP
forall a. a -> Maybe a
Just (IPv6 -> IP
fromIPv6 IPv6
v6)
Just IPv4
v4 -> IP -> Maybe IP
forall a. a -> Maybe a
Just (IPv4 -> IP
fromIPv4 IPv4
v4)
decodeShort :: ShortText -> Maybe IP
decodeShort :: ShortText -> Maybe IP
decodeShort ShortText
t
| Just IPv4
x <- ShortText -> Maybe IPv4
IPv4.decodeShort ShortText
t = IP -> Maybe IP
forall a. a -> Maybe a
Just (IPv4 -> IP
fromIPv4 IPv4
x)
| Bool
otherwise = Maybe IPv6 -> Maybe IP
coerce (ShortText -> Maybe IPv6
IPv6.decodeShort ShortText
t)
decodeUtf8Bytes :: Bytes.Bytes -> Maybe IP
decodeUtf8Bytes :: Bytes -> Maybe IP
decodeUtf8Bytes !Bytes
b = case (forall s. Parser () s IP) -> Bytes -> Result () IP
forall e a. (forall s. Parser e s a) -> Bytes -> Result e a
Parser.parseBytes (() -> Parser () s IP
forall e s. e -> Parser e s IP
parserUtf8Bytes ()) Bytes
b of
Parser.Success (Parser.Slice Int
_ Int
len IP
addr) -> case Int
len of
Int
0 -> IP -> Maybe IP
forall a. a -> Maybe a
Just IP
addr
Int
_ -> Maybe IP
forall a. Maybe a
Nothing
Parser.Failure ()
_ -> Maybe IP
forall a. Maybe a
Nothing
parserUtf8Bytes :: e -> Parser.Parser e s IP
parserUtf8Bytes :: e -> Parser e s IP
parserUtf8Bytes e
e =
(IPv4 -> IP) -> Parser () s IPv4 -> Parser () s IP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv4 -> IP
fromIPv4 (() -> Parser () s IPv4
forall e s. e -> Parser e s IPv4
IPv4.parserUtf8Bytes ())
Parser () s IP -> Parser e s IP -> Parser e s IP
forall x s a e. Parser x s a -> Parser e s a -> Parser e s a
`Parser.orElse`
Parser e s IPv6 -> Parser e s IP
coerce (e -> Parser e s IPv6
forall e s. e -> Parser e s IPv6
IPv6.parserUtf8Bytes e
e)
isIPv4 :: IP -> Bool
isIPv4 :: IP -> Bool
isIPv4 = (IPv4 -> Bool) -> (IPv6 -> Bool) -> IP -> Bool
forall a. (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ (Bool -> IPv4 -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> IPv6 -> Bool
forall a b. a -> b -> a
const Bool
False)
{-# inline isIPv4 #-}
isIPv6 :: IP -> Bool
isIPv6 :: IP -> Bool
isIPv6 = (IPv4 -> Bool) -> (IPv6 -> Bool) -> IP -> Bool
forall a. (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ (Bool -> IPv4 -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> IPv6 -> Bool
forall a b. a -> b -> a
const Bool
True)
{-# inline isIPv6 #-}
print :: IP -> IO ()
print :: IP -> IO ()
print = Text -> IO ()
TIO.putStrLn (Text -> IO ()) -> (IP -> Text) -> IP -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> Text
encode
newtype IP = IP { IP -> IPv6
getIP :: IPv6 }
deriving (IP -> IP -> Bool
(IP -> IP -> Bool) -> (IP -> IP -> Bool) -> Eq IP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IP -> IP -> Bool
$c/= :: IP -> IP -> Bool
== :: IP -> IP -> Bool
$c== :: IP -> IP -> Bool
Eq,Eq IP
Eq IP
-> (IP -> IP -> Ordering)
-> (IP -> IP -> Bool)
-> (IP -> IP -> Bool)
-> (IP -> IP -> Bool)
-> (IP -> IP -> Bool)
-> (IP -> IP -> IP)
-> (IP -> IP -> IP)
-> Ord IP
IP -> IP -> Bool
IP -> IP -> Ordering
IP -> IP -> IP
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 :: IP -> IP -> IP
$cmin :: IP -> IP -> IP
max :: IP -> IP -> IP
$cmax :: IP -> IP -> IP
>= :: IP -> IP -> Bool
$c>= :: IP -> IP -> Bool
> :: IP -> IP -> Bool
$c> :: IP -> IP -> Bool
<= :: IP -> IP -> Bool
$c<= :: IP -> IP -> Bool
< :: IP -> IP -> Bool
$c< :: IP -> IP -> Bool
compare :: IP -> IP -> Ordering
$ccompare :: IP -> IP -> Ordering
$cp1Ord :: Eq IP
Ord,(forall x. IP -> Rep IP x)
-> (forall x. Rep IP x -> IP) -> Generic IP
forall x. Rep IP x -> IP
forall x. IP -> Rep IP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IP x -> IP
$cfrom :: forall x. IP -> Rep IP x
Generic,Ord IP
Ord IP
-> ((IP, IP) -> [IP])
-> ((IP, IP) -> IP -> Int)
-> ((IP, IP) -> IP -> Int)
-> ((IP, IP) -> IP -> Bool)
-> ((IP, IP) -> Int)
-> ((IP, IP) -> Int)
-> Ix IP
(IP, IP) -> Int
(IP, IP) -> [IP]
(IP, IP) -> IP -> Bool
(IP, IP) -> IP -> 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 :: (IP, IP) -> Int
$cunsafeRangeSize :: (IP, IP) -> Int
rangeSize :: (IP, IP) -> Int
$crangeSize :: (IP, IP) -> Int
inRange :: (IP, IP) -> IP -> Bool
$cinRange :: (IP, IP) -> IP -> Bool
unsafeIndex :: (IP, IP) -> IP -> Int
$cunsafeIndex :: (IP, IP) -> IP -> Int
index :: (IP, IP) -> IP -> Int
$cindex :: (IP, IP) -> IP -> Int
range :: (IP, IP) -> [IP]
$crange :: (IP, IP) -> [IP]
$cp1Ix :: Ord IP
Ix,Typeable IP
DataType
Constr
Typeable IP
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP)
-> (IP -> Constr)
-> (IP -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IP))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP))
-> ((forall b. Data b => b -> b) -> IP -> IP)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r)
-> (forall u. (forall d. Data d => d -> u) -> IP -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IP -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IP -> m IP)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP)
-> Data IP
IP -> DataType
IP -> Constr
(forall b. Data b => b -> b) -> IP -> IP
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IP -> u
forall u. (forall d. Data d => d -> u) -> IP -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IP -> m IP
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IP)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP)
$cIP :: Constr
$tIP :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IP -> m IP
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
gmapMp :: (forall d. Data d => d -> m d) -> IP -> m IP
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IP -> m IP
gmapM :: (forall d. Data d => d -> m d) -> IP -> m IP
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IP -> m IP
gmapQi :: Int -> (forall d. Data d => d -> u) -> IP -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IP -> u
gmapQ :: (forall d. Data d => d -> u) -> IP -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IP -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> IP -> r
gmapT :: (forall b. Data b => b -> b) -> IP -> IP
$cgmapT :: (forall b. Data b => b -> b) -> IP -> IP
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IP)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IP)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IP)
dataTypeOf :: IP -> DataType
$cdataTypeOf :: IP -> DataType
toConstr :: IP -> Constr
$ctoConstr :: IP -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IP
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IP -> c IP
$cp1Data :: Typeable IP
Data)
instance NFData IP
instance Show IP where
showsPrec :: Int -> IP -> ShowS
showsPrec Int
p = (IPv4 -> ShowS) -> (IPv6 -> ShowS) -> IP -> ShowS
forall a. (IPv4 -> a) -> (IPv6 -> a) -> IP -> a
case_ (Int -> IPv4 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p) (Int -> IPv6 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p)
instance Read IP where
readPrec :: ReadPrec IP
readPrec = (IPv4 -> IP) -> ReadPrec IPv4 -> ReadPrec IP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv4 -> IP
fromIPv4 ReadPrec IPv4
forall a. Read a => ReadPrec a
readPrec ReadPrec IP -> ReadPrec IP -> ReadPrec IP
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ (IPv6 -> IP) -> ReadPrec IPv6 -> ReadPrec IP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IPv6 -> IP
fromIPv6 ReadPrec IPv6
forall a. Read a => ReadPrec a
readPrec
instance ToJSON IP where
toJSON :: IP -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (IP -> Text) -> IP -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP -> Text
encode
instance FromJSON IP where
parseJSON :: Value -> Parser IP
parseJSON = String -> (Text -> Parser IP) -> Value -> Parser IP
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"IP" ((Text -> Parser IP) -> Value -> Parser IP)
-> (Text -> Parser IP) -> Value -> Parser IP
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Maybe IP
decode Text
t of
Maybe IP
Nothing -> String -> Parser IP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse IP address"
Just IP
addr -> IP -> Parser IP
forall (m :: * -> *) a. Monad m => a -> m a
return IP
addr