{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | This module provides newtype wrappers for 'IPv4' and 'IPv6' addresses
-- from the @iproute@ package. These wrappers exist to have a correct 'Show'
-- instance and eliminate the need for orphan instances.
module Cardano.Base.IP (
  IPv4,
  IPv6,
  mkIPv4,
  unIPv4,
  mkIPv6,
  unIPv6,
  toIPv4,
  toIPv4w,
  fromIPv4,
  fromIPv4w,
  toIPv6,
  toIPv6w,
  fromIPv6,
  fromIPv6w,
  fromHostAddress6,
)
where

import Control.DeepSeq (NFData (..), rwhnf)
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as Aeson
import qualified Data.IP as IP
import qualified Data.Text as Text
import Data.Word (Word32)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Text.Read (readMaybe, readPrec)

newtype IPv4 = IPv4 {IPv4 -> IPv4
unIPv4 :: IP.IPv4}
  deriving newtype (IPv4 -> IPv4 -> Bool
(IPv4 -> IPv4 -> Bool) -> (IPv4 -> IPv4 -> Bool) -> Eq IPv4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv4 -> IPv4 -> Bool
== :: IPv4 -> IPv4 -> Bool
$c/= :: IPv4 -> IPv4 -> Bool
/= :: 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
$ccompare :: IPv4 -> IPv4 -> Ordering
compare :: IPv4 -> IPv4 -> Ordering
$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
>= :: IPv4 -> IPv4 -> Bool
$cmax :: IPv4 -> IPv4 -> IPv4
max :: IPv4 -> IPv4 -> IPv4
$cmin :: IPv4 -> IPv4 -> IPv4
min :: IPv4 -> IPv4 -> IPv4
Ord)
  deriving stock ((forall x. IPv4 -> Rep IPv4 x)
-> (forall x. Rep IPv4 x -> IPv4) -> Generic IPv4
forall x. Rep IPv4 x -> IPv4
forall x. IPv4 -> Rep IPv4 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IPv4 -> Rep IPv4 x
from :: forall x. IPv4 -> Rep IPv4 x
$cto :: forall x. Rep IPv4 x -> IPv4
to :: forall x. Rep IPv4 x -> IPv4
Generic)

instance NFData IPv4 where
  rnf :: IPv4 -> ()
rnf = IPv4 -> ()
forall a. a -> ()
rwhnf

instance NoThunks IPv4 where
  wNoThunks :: Context -> IPv4 -> IO (Maybe ThunkInfo)
wNoThunks Context
_ (IPv4 IPv4
_) = Maybe ThunkInfo -> IO (Maybe ThunkInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThunkInfo
forall a. Maybe a
Nothing
  showTypeOf :: Proxy IPv4 -> String
showTypeOf Proxy IPv4
_ = String
"IPv4"

-- >>> show (toIPv4 [192, 168, 1, 1])
-- "\"192.168.1.1\""
instance Show IPv4 where
  show :: IPv4 -> String
show (IPv4 IPv4
ip) = ShowS
forall a. Show a => a -> String
show (IPv4 -> String
forall a. Show a => a -> String
show IPv4
ip)

-- >>> read "\"192.168.1.1\"" :: IPv4
-- "192.168.1.1"
instance Read IPv4 where
  readPrec :: ReadPrec IPv4
readPrec = do
    String
s <- ReadPrec String
forall a. Read a => ReadPrec a
readPrec
    case String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe String
s of
      Just IPv4
ip -> IPv4 -> ReadPrec IPv4
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv4 -> IPv4
mkIPv4 IPv4
ip)
      Maybe IPv4
Nothing -> String -> ReadPrec IPv4
forall a. String -> ReadPrec a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid IPv4"

instance FromJSON IPv4 where
  parseJSON :: Value -> Parser IPv4
parseJSON =
    String -> (Text -> Parser IPv4) -> Value -> Parser IPv4
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"IPv4" ((Text -> Parser IPv4) -> Value -> Parser IPv4)
-> (Text -> Parser IPv4) -> Value -> Parser IPv4
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case String -> Maybe IPv4
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
txt) of
      Just IPv4
ip -> IPv4 -> Parser IPv4
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv4 -> IPv4
mkIPv4 IPv4
ip)
      Maybe IPv4
Nothing -> String -> Parser IPv4
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IPv4) -> String -> Parser IPv4
forall a b. (a -> b) -> a -> b
$ String
"failed to read as IPv4 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
txt

instance ToJSON IPv4 where
  toJSON :: IPv4 -> Value
toJSON (IPv4 IPv4
ip) = String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (IPv4 -> String
forall a. Show a => a -> String
show IPv4
ip)

newtype IPv6 = IPv6 {IPv6 -> IPv6
unIPv6 :: IP.IPv6}
  deriving newtype (IPv6 -> IPv6 -> Bool
(IPv6 -> IPv6 -> Bool) -> (IPv6 -> IPv6 -> Bool) -> Eq IPv6
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv6 -> IPv6 -> Bool
== :: IPv6 -> IPv6 -> Bool
$c/= :: IPv6 -> IPv6 -> Bool
/= :: IPv6 -> IPv6 -> Bool
Eq, Eq IPv6
Eq IPv6 =>
(IPv6 -> IPv6 -> Ordering)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> Bool)
-> (IPv6 -> IPv6 -> IPv6)
-> (IPv6 -> IPv6 -> IPv6)
-> Ord IPv6
IPv6 -> IPv6 -> Bool
IPv6 -> IPv6 -> Ordering
IPv6 -> IPv6 -> IPv6
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
$ccompare :: IPv6 -> IPv6 -> Ordering
compare :: IPv6 -> IPv6 -> Ordering
$c< :: IPv6 -> IPv6 -> Bool
< :: IPv6 -> IPv6 -> Bool
$c<= :: IPv6 -> IPv6 -> Bool
<= :: IPv6 -> IPv6 -> Bool
$c> :: IPv6 -> IPv6 -> Bool
> :: IPv6 -> IPv6 -> Bool
$c>= :: IPv6 -> IPv6 -> Bool
>= :: IPv6 -> IPv6 -> Bool
$cmax :: IPv6 -> IPv6 -> IPv6
max :: IPv6 -> IPv6 -> IPv6
$cmin :: IPv6 -> IPv6 -> IPv6
min :: IPv6 -> IPv6 -> IPv6
Ord)

instance NFData IPv6 where
  rnf :: IPv6 -> ()
rnf = IPv6 -> ()
forall a. a -> ()
rwhnf

instance NoThunks IPv6 where
  wNoThunks :: Context -> IPv6 -> IO (Maybe ThunkInfo)
wNoThunks Context
_ (IPv6 IPv6
_) = Maybe ThunkInfo -> IO (Maybe ThunkInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ThunkInfo
forall a. Maybe a
Nothing
  showTypeOf :: Proxy IPv6 -> String
showTypeOf Proxy IPv6
_ = String
"IPv6"

-- >>> show (toIPv6 [0x2001, 0xdb8, 0, 0, 0, 0, 0, 1])
-- "\"2001:db8::1\""
instance Show IPv6 where
  show :: IPv6 -> String
show (IPv6 IPv6
ip) = ShowS
forall a. Show a => a -> String
show (IPv6 -> String
forall a. Show a => a -> String
show IPv6
ip)

-- >>> read "\"2001:db8::1\"" :: IPv6
-- "2001:db8::1"
instance Read IPv6 where
  readPrec :: ReadPrec IPv6
readPrec = do
    String
s <- ReadPrec String
forall a. Read a => ReadPrec a
readPrec
    case String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe String
s of
      Just IPv6
ip -> IPv6 -> ReadPrec IPv6
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv6 -> IPv6
mkIPv6 IPv6
ip)
      Maybe IPv6
Nothing -> String -> ReadPrec IPv6
forall a. String -> ReadPrec a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid IPv6"

instance FromJSON IPv6 where
  parseJSON :: Value -> Parser IPv6
parseJSON =
    String -> (Text -> Parser IPv6) -> Value -> Parser IPv6
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"IPv6" ((Text -> Parser IPv6) -> Value -> Parser IPv6)
-> (Text -> Parser IPv6) -> Value -> Parser IPv6
forall a b. (a -> b) -> a -> b
$ \Text
txt -> case String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
txt) of
      Just IPv6
ip -> IPv6 -> Parser IPv6
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IPv6 -> IPv6
mkIPv6 IPv6
ip)
      Maybe IPv6
Nothing -> String -> Parser IPv6
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IPv6) -> String -> Parser IPv6
forall a b. (a -> b) -> a -> b
$ String
"failed to read as IPv6 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
txt

instance ToJSON IPv6 where
  toJSON :: IPv6 -> Value
toJSON (IPv6 IPv6
ip) = String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (IPv6 -> String
forall a. Show a => a -> String
show IPv6
ip)

-- | Wrap an 'IP.IPv4' address
mkIPv4 :: IP.IPv4 -> IPv4
mkIPv4 :: IPv4 -> IPv4
mkIPv4 = IPv4 -> IPv4
IPv4

-- >>> toIPv4 [192, 168, 1, 1]
-- "192.168.1.1"
toIPv4 :: [Int] -> IPv4
toIPv4 :: [Int] -> IPv4
toIPv4 = IPv4 -> IPv4
mkIPv4 (IPv4 -> IPv4) -> ([Int] -> IPv4) -> [Int] -> IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IPv4
IP.toIPv4

toIPv4w :: Word32 -> IPv4
toIPv4w :: Word32 -> IPv4
toIPv4w = IPv4 -> IPv4
mkIPv4 (IPv4 -> IPv4) -> (Word32 -> IPv4) -> Word32 -> IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> IPv4
IP.toIPv4w

fromIPv4 :: IPv4 -> [Int]
fromIPv4 :: IPv4 -> [Int]
fromIPv4 = IPv4 -> [Int]
IP.fromIPv4 (IPv4 -> [Int]) -> (IPv4 -> IPv4) -> IPv4 -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> IPv4
unIPv4

fromIPv4w :: IPv4 -> Word32
fromIPv4w :: IPv4 -> Word32
fromIPv4w = IPv4 -> Word32
IP.fromIPv4w (IPv4 -> Word32) -> (IPv4 -> IPv4) -> IPv4 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> IPv4
unIPv4

-- | Wrap an 'IP.IPv6' address, forcing evaluation to guarantee no thunks
mkIPv6 :: IP.IPv6 -> IPv6
mkIPv6 :: IPv6 -> IPv6
mkIPv6 IPv6
ipv6 = case IPv6 -> HostAddress6
IP.toHostAddress6 IPv6
ipv6 of
  (!Word32
_, !Word32
_, !Word32
_, !Word32
_) -> IPv6 -> IPv6
IPv6 IPv6
ipv6

-- >>> toIPv6 [0x2001, 0xdb8, 0, 0, 0, 0, 0, 1]
-- "2001:db8::1"
toIPv6 :: [Int] -> IPv6
toIPv6 :: [Int] -> IPv6
toIPv6 = IPv6 -> IPv6
mkIPv6 (IPv6 -> IPv6) -> ([Int] -> IPv6) -> [Int] -> IPv6
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> IPv6
IP.toIPv6

toIPv6w :: (Word32, Word32, Word32, Word32) -> IPv6
toIPv6w :: HostAddress6 -> IPv6
toIPv6w = IPv6 -> IPv6
mkIPv6 (IPv6 -> IPv6) -> (HostAddress6 -> IPv6) -> HostAddress6 -> IPv6
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress6 -> IPv6
IP.toIPv6w

fromHostAddress6 :: (Word32, Word32, Word32, Word32) -> IPv6
fromHostAddress6 :: HostAddress6 -> IPv6
fromHostAddress6 = HostAddress6 -> IPv6
toIPv6w

fromIPv6 :: IPv6 -> [Int]
fromIPv6 :: IPv6 -> [Int]
fromIPv6 (IPv6 IPv6
ip) = IPv6 -> [Int]
IP.fromIPv6 IPv6
ip

fromIPv6w :: IPv6 -> (Word32, Word32, Word32, Word32)
fromIPv6w :: IPv6 -> HostAddress6
fromIPv6w (IPv6 IPv6
ip) = IPv6 -> HostAddress6
IP.toHostAddress6 IPv6
ip