\section{Host Address}

A Host Address is either an IPv4 or an IPv6 address.  The binary representation
of an IPv4 address is a Big Endian 32 bit unsigned integer (4 bytes).  For an
IPv6 address, it is a Big Endian 128 bit unsigned integer (16 bytes).  The
binary representation of a Host Address is a 7 bit unsigned integer specifying
the address family (2 for IPv4, 10 for IPv6), followed by the address itself.

Thus, when packed together with the Transport Protocol, the first bit of the
packed byte is the protocol and the next 7 bits are the address family.

\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE StrictData         #-}
module Network.Tox.NodeInfo.HostAddress where

import           Control.Arrow             ((&&&))
import           Data.Binary               (Binary)
import qualified Data.Binary               as Binary (get, put)
import qualified Data.Binary.Bits.Get      as Bits
import qualified Data.Binary.Bits.Put      as Bits
import qualified Data.Binary.Get           as Bytes
import qualified Data.Binary.Put           as Bytes
import qualified Data.IP                   as IP
import           Data.MessagePack          (MessagePack)
import           Data.Typeable             (Typeable)
import           GHC.Generics              (Generic)
import qualified Network.Socket            as Socket (HostAddress, HostAddress6)
import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Test.QuickCheck.Gen       as Gen
import           Text.Read                 (readMaybe, readPrec)


{-------------------------------------------------------------------------------
 -
 - :: Implementation.
 -
 ------------------------------------------------------------------------------}


data HostAddress
  = IPv4 Socket.HostAddress
  | IPv6 Socket.HostAddress6
  deriving (HostAddress -> HostAddress -> Bool
(HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool) -> Eq HostAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostAddress -> HostAddress -> Bool
$c/= :: HostAddress -> HostAddress -> Bool
== :: HostAddress -> HostAddress -> Bool
$c== :: HostAddress -> HostAddress -> Bool
Eq, Eq HostAddress
Eq HostAddress
-> (HostAddress -> HostAddress -> Ordering)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> Bool)
-> (HostAddress -> HostAddress -> HostAddress)
-> (HostAddress -> HostAddress -> HostAddress)
-> Ord HostAddress
HostAddress -> HostAddress -> Bool
HostAddress -> HostAddress -> Ordering
HostAddress -> HostAddress -> HostAddress
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 :: HostAddress -> HostAddress -> HostAddress
$cmin :: HostAddress -> HostAddress -> HostAddress
max :: HostAddress -> HostAddress -> HostAddress
$cmax :: HostAddress -> HostAddress -> HostAddress
>= :: HostAddress -> HostAddress -> Bool
$c>= :: HostAddress -> HostAddress -> Bool
> :: HostAddress -> HostAddress -> Bool
$c> :: HostAddress -> HostAddress -> Bool
<= :: HostAddress -> HostAddress -> Bool
$c<= :: HostAddress -> HostAddress -> Bool
< :: HostAddress -> HostAddress -> Bool
$c< :: HostAddress -> HostAddress -> Bool
compare :: HostAddress -> HostAddress -> Ordering
$ccompare :: HostAddress -> HostAddress -> Ordering
$cp1Ord :: Eq HostAddress
Ord, (forall x. HostAddress -> Rep HostAddress x)
-> (forall x. Rep HostAddress x -> HostAddress)
-> Generic HostAddress
forall x. Rep HostAddress x -> HostAddress
forall x. HostAddress -> Rep HostAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HostAddress x -> HostAddress
$cfrom :: forall x. HostAddress -> Rep HostAddress x
Generic, Typeable)

instance Binary HostAddress
instance MessagePack HostAddress


instance Show HostAddress where
  show :: HostAddress -> String
show (IPv4 HostAddress
addr) = ShowS
forall a. Show a => a -> String
show ShowS -> (HostAddress -> String) -> HostAddress -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> String
forall a. Show a => a -> String
show (IPv4 -> String) -> (HostAddress -> IPv4) -> HostAddress -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress -> IPv4
IP.fromHostAddress  (HostAddress -> String) -> HostAddress -> String
forall a b. (a -> b) -> a -> b
$ HostAddress
addr
  show (IPv6 HostAddress6
addr) = ShowS
forall a. Show a => a -> String
show ShowS -> (HostAddress6 -> String) -> HostAddress6 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> String
forall a. Show a => a -> String
show (IPv6 -> String)
-> (HostAddress6 -> IPv6) -> HostAddress6 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress6 -> IPv6
IP.fromHostAddress6 (HostAddress6 -> String) -> HostAddress6 -> String
forall a b. (a -> b) -> a -> b
$ HostAddress6
addr


instance Read HostAddress where
  readPrec :: ReadPrec HostAddress
readPrec = do
    String
str <- ReadPrec String
forall a. Read a => ReadPrec a
readPrec
    case String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe String
str of
      Maybe IP
Nothing             -> String -> ReadPrec HostAddress
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"HostAddress"
      Just (IP.IPv4 IPv4
ipv4) -> HostAddress -> ReadPrec HostAddress
forall (m :: * -> *) a. Monad m => a -> m a
return (HostAddress -> ReadPrec HostAddress)
-> (IPv4 -> HostAddress) -> IPv4 -> ReadPrec HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress -> HostAddress
IPv4 (HostAddress -> HostAddress)
-> (IPv4 -> HostAddress) -> IPv4 -> HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv4 -> HostAddress
IP.toHostAddress  (IPv4 -> ReadPrec HostAddress) -> IPv4 -> ReadPrec HostAddress
forall a b. (a -> b) -> a -> b
$ IPv4
ipv4
      Just (IP.IPv6 IPv6
ipv6) -> HostAddress -> ReadPrec HostAddress
forall (m :: * -> *) a. Monad m => a -> m a
return (HostAddress -> ReadPrec HostAddress)
-> (IPv6 -> HostAddress) -> IPv6 -> ReadPrec HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress6 -> HostAddress
IPv6 (HostAddress6 -> HostAddress)
-> (IPv6 -> HostAddress6) -> IPv6 -> HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> HostAddress6
IP.toHostAddress6 (IPv6 -> ReadPrec HostAddress) -> IPv6 -> ReadPrec HostAddress
forall a b. (a -> b) -> a -> b
$ IPv6
ipv6


getHostAddressGetter :: Bits.BitGet (Bytes.Get HostAddress)
getHostAddressGetter :: BitGet (Get HostAddress)
getHostAddressGetter =
  Int -> BitGet Word8
Bits.getWord8 Int
7 BitGet Word8
-> (Word8 -> BitGet (Get HostAddress)) -> BitGet (Get HostAddress)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
2  -> Get HostAddress -> BitGet (Get HostAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return (Get HostAddress -> BitGet (Get HostAddress))
-> Get HostAddress -> BitGet (Get HostAddress)
forall a b. (a -> b) -> a -> b
$ HostAddress -> HostAddress
IPv4 (HostAddress -> HostAddress) -> Get HostAddress -> Get HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HostAddress
forall t. Binary t => Get t
Binary.get
    Word8
10 -> Get HostAddress -> BitGet (Get HostAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return (Get HostAddress -> BitGet (Get HostAddress))
-> Get HostAddress -> BitGet (Get HostAddress)
forall a b. (a -> b) -> a -> b
$ HostAddress6 -> HostAddress
IPv6 (HostAddress6 -> HostAddress)
-> Get HostAddress6 -> Get HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get HostAddress6
forall t. Binary t => Get t
Binary.get
    Word8
n  -> String -> BitGet (Get HostAddress)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> BitGet (Get HostAddress))
-> String -> BitGet (Get HostAddress)
forall a b. (a -> b) -> a -> b
$ String
"Invalid address family: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n


putAddressFamily :: HostAddress -> Bits.BitPut ()
putAddressFamily :: HostAddress -> BitPut ()
putAddressFamily (IPv4 HostAddress
_) = Int -> Word8 -> BitPut ()
Bits.putWord8 Int
7 Word8
2
putAddressFamily (IPv6 HostAddress6
_) = Int -> Word8 -> BitPut ()
Bits.putWord8 Int
7 Word8
10


putHostAddressValue :: HostAddress -> Bytes.Put
putHostAddressValue :: HostAddress -> Put
putHostAddressValue (IPv4 HostAddress
addr) = HostAddress -> Put
forall t. Binary t => t -> Put
Binary.put HostAddress
addr
putHostAddressValue (IPv6 HostAddress6
addr) = HostAddress6 -> Put
forall t. Binary t => t -> Put
Binary.put HostAddress6
addr


putHostAddress :: HostAddress -> (Bits.BitPut (), Bytes.Put)
putHostAddress :: HostAddress -> (BitPut (), Put)
putHostAddress = HostAddress -> BitPut ()
putAddressFamily (HostAddress -> BitPut ())
-> (HostAddress -> Put) -> HostAddress -> (BitPut (), Put)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& HostAddress -> Put
putHostAddressValue


{-------------------------------------------------------------------------------
 -
 - :: Tests.
 -
 ------------------------------------------------------------------------------}


instance Arbitrary HostAddress where
  arbitrary :: Gen HostAddress
arbitrary =
    [Gen HostAddress] -> Gen HostAddress
forall a. HasCallStack => [Gen a] -> Gen a
Gen.oneof
      [ HostAddress -> HostAddress
IPv4 (HostAddress -> HostAddress) -> Gen HostAddress -> Gen HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen HostAddress
forall a. Arbitrary a => Gen a
arbitrary
      , HostAddress6 -> HostAddress
IPv6 (HostAddress6 -> HostAddress)
-> Gen HostAddress6 -> Gen HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen HostAddress6
forall a. Arbitrary a => Gen a
arbitrary
      ]
\end{code}