{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE ViewPatterns      #-}

module Ouroboros.Network.PeerSelection.RelayAccessPoint
  ( DomainAccessPoint (..)
  , RelayAccessPoint (.., RelayDomainAccessPoint)
  , IP.IP (..)
    -- * Socket type re-exports
  , Socket.PortNumber
  ) where

import           Control.DeepSeq (NFData (..))

import           Data.Aeson
import qualified Data.IP as IP
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Text.Encoding (decodeUtf8, encodeUtf8)
import           Text.Read (readMaybe)

import qualified Network.DNS as DNS
import qualified Network.Socket as Socket

-- | A product of a 'DNS.Domain' and 'Socket.PortNumber'.  After resolving the
-- domain we will use the 'Socket.PortNumber' to form 'Socket.SockAddr'.
--
data DomainAccessPoint = DomainAccessPoint {
    DomainAccessPoint -> Domain
dapDomain     :: !DNS.Domain,
    DomainAccessPoint -> PortNumber
dapPortNumber :: !Socket.PortNumber
  }
  deriving (Int -> DomainAccessPoint -> ShowS
[DomainAccessPoint] -> ShowS
DomainAccessPoint -> String
(Int -> DomainAccessPoint -> ShowS)
-> (DomainAccessPoint -> String)
-> ([DomainAccessPoint] -> ShowS)
-> Show DomainAccessPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainAccessPoint] -> ShowS
$cshowList :: [DomainAccessPoint] -> ShowS
show :: DomainAccessPoint -> String
$cshow :: DomainAccessPoint -> String
showsPrec :: Int -> DomainAccessPoint -> ShowS
$cshowsPrec :: Int -> DomainAccessPoint -> ShowS
Show, DomainAccessPoint -> DomainAccessPoint -> Bool
(DomainAccessPoint -> DomainAccessPoint -> Bool)
-> (DomainAccessPoint -> DomainAccessPoint -> Bool)
-> Eq DomainAccessPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DomainAccessPoint -> DomainAccessPoint -> Bool
$c/= :: DomainAccessPoint -> DomainAccessPoint -> Bool
== :: DomainAccessPoint -> DomainAccessPoint -> Bool
$c== :: DomainAccessPoint -> DomainAccessPoint -> Bool
Eq, Eq DomainAccessPoint
Eq DomainAccessPoint
-> (DomainAccessPoint -> DomainAccessPoint -> Ordering)
-> (DomainAccessPoint -> DomainAccessPoint -> Bool)
-> (DomainAccessPoint -> DomainAccessPoint -> Bool)
-> (DomainAccessPoint -> DomainAccessPoint -> Bool)
-> (DomainAccessPoint -> DomainAccessPoint -> Bool)
-> (DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint)
-> (DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint)
-> Ord DomainAccessPoint
DomainAccessPoint -> DomainAccessPoint -> Bool
DomainAccessPoint -> DomainAccessPoint -> Ordering
DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint
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 :: DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint
$cmin :: DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint
max :: DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint
$cmax :: DomainAccessPoint -> DomainAccessPoint -> DomainAccessPoint
>= :: DomainAccessPoint -> DomainAccessPoint -> Bool
$c>= :: DomainAccessPoint -> DomainAccessPoint -> Bool
> :: DomainAccessPoint -> DomainAccessPoint -> Bool
$c> :: DomainAccessPoint -> DomainAccessPoint -> Bool
<= :: DomainAccessPoint -> DomainAccessPoint -> Bool
$c<= :: DomainAccessPoint -> DomainAccessPoint -> Bool
< :: DomainAccessPoint -> DomainAccessPoint -> Bool
$c< :: DomainAccessPoint -> DomainAccessPoint -> Bool
compare :: DomainAccessPoint -> DomainAccessPoint -> Ordering
$ccompare :: DomainAccessPoint -> DomainAccessPoint -> Ordering
$cp1Ord :: Eq DomainAccessPoint
Ord)

instance FromJSON DomainAccessPoint where
  parseJSON :: Value -> Parser DomainAccessPoint
parseJSON = String
-> (Object -> Parser DomainAccessPoint)
-> Value
-> Parser DomainAccessPoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DomainAccessPoint" ((Object -> Parser DomainAccessPoint)
 -> Value -> Parser DomainAccessPoint)
-> (Object -> Parser DomainAccessPoint)
-> Value
-> Parser DomainAccessPoint
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Domain -> PortNumber -> DomainAccessPoint
DomainAccessPoint
      (Domain -> PortNumber -> DomainAccessPoint)
-> Parser Domain -> Parser (PortNumber -> DomainAccessPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Domain
encodeUtf8 (Text -> Domain) -> Parser Text -> Parser Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address")
      Parser (PortNumber -> DomainAccessPoint)
-> Parser PortNumber -> Parser DomainAccessPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Socket.PortNumber) (Int -> PortNumber) -> Parser Int -> Parser PortNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port")

instance ToJSON DomainAccessPoint where
  toJSON :: DomainAccessPoint -> Value
toJSON DomainAccessPoint
da =
    [Pair] -> Value
object
      [ Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Domain -> Text
decodeUtf8 (DomainAccessPoint -> Domain
dapDomain DomainAccessPoint
da)
      , Key
"port" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DomainAccessPoint -> PortNumber
dapPortNumber DomainAccessPoint
da) :: Int)
      ]

-- | A relay can have either an IP address and a port number or
-- a domain with a port number
--
data RelayAccessPoint = RelayAccessDomain  !DNS.Domain !Socket.PortNumber
                      | RelayAccessAddress !IP.IP      !Socket.PortNumber
  deriving (Int -> RelayAccessPoint -> ShowS
[RelayAccessPoint] -> ShowS
RelayAccessPoint -> String
(Int -> RelayAccessPoint -> ShowS)
-> (RelayAccessPoint -> String)
-> ([RelayAccessPoint] -> ShowS)
-> Show RelayAccessPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelayAccessPoint] -> ShowS
$cshowList :: [RelayAccessPoint] -> ShowS
show :: RelayAccessPoint -> String
$cshow :: RelayAccessPoint -> String
showsPrec :: Int -> RelayAccessPoint -> ShowS
$cshowsPrec :: Int -> RelayAccessPoint -> ShowS
Show, RelayAccessPoint -> RelayAccessPoint -> Bool
(RelayAccessPoint -> RelayAccessPoint -> Bool)
-> (RelayAccessPoint -> RelayAccessPoint -> Bool)
-> Eq RelayAccessPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelayAccessPoint -> RelayAccessPoint -> Bool
$c/= :: RelayAccessPoint -> RelayAccessPoint -> Bool
== :: RelayAccessPoint -> RelayAccessPoint -> Bool
$c== :: RelayAccessPoint -> RelayAccessPoint -> Bool
Eq, Eq RelayAccessPoint
Eq RelayAccessPoint
-> (RelayAccessPoint -> RelayAccessPoint -> Ordering)
-> (RelayAccessPoint -> RelayAccessPoint -> Bool)
-> (RelayAccessPoint -> RelayAccessPoint -> Bool)
-> (RelayAccessPoint -> RelayAccessPoint -> Bool)
-> (RelayAccessPoint -> RelayAccessPoint -> Bool)
-> (RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint)
-> (RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint)
-> Ord RelayAccessPoint
RelayAccessPoint -> RelayAccessPoint -> Bool
RelayAccessPoint -> RelayAccessPoint -> Ordering
RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint
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 :: RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint
$cmin :: RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint
max :: RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint
$cmax :: RelayAccessPoint -> RelayAccessPoint -> RelayAccessPoint
>= :: RelayAccessPoint -> RelayAccessPoint -> Bool
$c>= :: RelayAccessPoint -> RelayAccessPoint -> Bool
> :: RelayAccessPoint -> RelayAccessPoint -> Bool
$c> :: RelayAccessPoint -> RelayAccessPoint -> Bool
<= :: RelayAccessPoint -> RelayAccessPoint -> Bool
$c<= :: RelayAccessPoint -> RelayAccessPoint -> Bool
< :: RelayAccessPoint -> RelayAccessPoint -> Bool
$c< :: RelayAccessPoint -> RelayAccessPoint -> Bool
compare :: RelayAccessPoint -> RelayAccessPoint -> Ordering
$ccompare :: RelayAccessPoint -> RelayAccessPoint -> Ordering
$cp1Ord :: Eq RelayAccessPoint
Ord)


-- | 'RelayDomainAccessPoint' a bidirectional pattern which links
-- 'RelayAccessDomain' and 'DomainAccessPoint'.
--
pattern RelayDomainAccessPoint :: DomainAccessPoint -> RelayAccessPoint
pattern $bRelayDomainAccessPoint :: DomainAccessPoint -> RelayAccessPoint
$mRelayDomainAccessPoint :: forall r.
RelayAccessPoint -> (DomainAccessPoint -> r) -> (Void# -> r) -> r
RelayDomainAccessPoint dap <- (viewRelayAccessPoint -> Just dap)
  where
    RelayDomainAccessPoint DomainAccessPoint {Domain
dapDomain :: Domain
dapDomain :: DomainAccessPoint -> Domain
dapDomain, PortNumber
dapPortNumber :: PortNumber
dapPortNumber :: DomainAccessPoint -> PortNumber
dapPortNumber} =
      Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
dapDomain PortNumber
dapPortNumber

{-# COMPLETE RelayDomainAccessPoint, RelayAccessAddress #-}

viewRelayAccessPoint :: RelayAccessPoint -> Maybe DomainAccessPoint
viewRelayAccessPoint :: RelayAccessPoint -> Maybe DomainAccessPoint
viewRelayAccessPoint (RelayAccessDomain Domain
dapDomain PortNumber
dapPortNumber) =
    DomainAccessPoint -> Maybe DomainAccessPoint
forall a. a -> Maybe a
Just DomainAccessPoint :: Domain -> PortNumber -> DomainAccessPoint
DomainAccessPoint {Domain
dapDomain :: Domain
dapDomain :: Domain
dapDomain, PortNumber
dapPortNumber :: PortNumber
dapPortNumber :: PortNumber
dapPortNumber}
viewRelayAccessPoint  RelayAccessAddress {} =
    Maybe DomainAccessPoint
forall a. Maybe a
Nothing


-- 'IP' nor 'IPv6' is strict, 'IPv4' is strict only because it's a newtype for
-- a primitive type ('Word32').
--
instance NFData RelayAccessPoint where
  rnf :: RelayAccessPoint -> ()
rnf (RelayAccessDomain !Domain
_domain !PortNumber
_port) = ()
  rnf (RelayAccessAddress IP
ip !PortNumber
_port) =
    case IP
ip of
      IP.IPv4 IPv4
ipv4 -> Word32 -> ()
forall a. NFData a => a -> ()
rnf (IPv4 -> Word32
IP.fromIPv4w IPv4
ipv4)
      IP.IPv6 IPv6
ipv6 -> (Word32, Word32, Word32, Word32) -> ()
forall a. NFData a => a -> ()
rnf (IPv6 -> (Word32, Word32, Word32, Word32)
IP.fromIPv6w IPv6
ipv6)

instance FromJSON RelayAccessPoint where
  parseJSON :: Value -> Parser RelayAccessPoint
parseJSON = String
-> (Object -> Parser RelayAccessPoint)
-> Value
-> Parser RelayAccessPoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RelayAccessPoint" ((Object -> Parser RelayAccessPoint)
 -> Value -> Parser RelayAccessPoint)
-> (Object -> Parser RelayAccessPoint)
-> Value
-> Parser RelayAccessPoint
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Text
addr <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
    Int
port <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"port"
    RelayAccessPoint -> Parser RelayAccessPoint
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Int -> RelayAccessPoint
toRelayAccessPoint Text
addr Int
port)

instance ToJSON RelayAccessPoint where
  toJSON :: RelayAccessPoint -> Value
toJSON (RelayAccessDomain Domain
addr PortNumber
port) =
    [Pair] -> Value
object
      [ Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Domain -> Text
decodeUtf8 Domain
addr
      , Key
"port" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port :: Int)
      ]
  toJSON (RelayAccessAddress IP
ip PortNumber
port) =
    [Pair] -> Value
object
      [ Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Text
Text.pack (IP -> String
forall a. Show a => a -> String
show IP
ip)
      , Key
"port" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port :: Int)
      ]

-- | Parse a address field as either an IP address or a DNS address.
-- Returns corresponding RelayAccessPoint.
--
toRelayAccessPoint :: Text -> Int -> RelayAccessPoint
toRelayAccessPoint :: Text -> Int -> RelayAccessPoint
toRelayAccessPoint Text
address Int
port =
    case String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
address) of
      Maybe IP
Nothing   -> Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain (Text -> Domain
encodeUtf8 Text
address) (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port)
      Just IP
addr -> IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
addr (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port)