module Test.Ouroboros.Network.PeerSelection.Json (tests) where

import Data.Aeson (decode, encode, fromJSON, toJSON)
import Data.ByteString.Char8 (snoc, unsnoc)
import Test.Ouroboros.Network.PeerSelection.Instances ()

import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise)
import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.PeerSelection"
  [ TestName -> [TestTree] -> TestTree
testGroup TestName
"JSON"
    [ TestName -> (RelayAccessPoint -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"RelayAccessPoint roundtrip"  RelayAccessPoint -> Property
prop_roundtrip_RelayAccessPoint_JSON
    , TestName -> (PeerAdvertise -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"PeerAdvertise roundtrip"     PeerAdvertise -> Property
prop_roundtrip_PeerAdvertise_JSON
    ]
  ]

-- | Test round trip identify, modulo fully qualified domain names
--
prop_roundtrip_RelayAccessPoint_JSON :: RelayAccessPoint -> Property
prop_roundtrip_RelayAccessPoint_JSON :: RelayAccessPoint -> Property
prop_roundtrip_RelayAccessPoint_JSON RelayAccessPoint
ra =
    (let tripped :: Maybe RelayAccessPoint
tripped = ByteString -> Maybe RelayAccessPoint
forall a. FromJSON a => ByteString -> Maybe a
decode (RelayAccessPoint -> ByteString
forall a. ToJSON a => a -> ByteString
encode RelayAccessPoint
ra)
     in Maybe RelayAccessPoint
tripped Maybe RelayAccessPoint -> Maybe RelayAccessPoint -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== RelayAccessPoint -> Maybe RelayAccessPoint
forall a. a -> Maybe a
Just RelayAccessPoint
ra Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||. Maybe RelayAccessPoint
tripped Maybe RelayAccessPoint -> Maybe RelayAccessPoint -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== RelayAccessPoint -> Maybe RelayAccessPoint
forall a. a -> Maybe a
Just (RelayAccessPoint -> RelayAccessPoint
fullyQualified RelayAccessPoint
ra))
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
    (let tripped :: Result RelayAccessPoint
tripped = Value -> Result RelayAccessPoint
forall a. FromJSON a => Value -> Result a
fromJSON (RelayAccessPoint -> Value
forall a. ToJSON a => a -> Value
toJSON RelayAccessPoint
ra)
     in Result RelayAccessPoint
tripped Result RelayAccessPoint -> Result RelayAccessPoint -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== RelayAccessPoint -> Result RelayAccessPoint
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelayAccessPoint
ra Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||. Result RelayAccessPoint
tripped Result RelayAccessPoint -> Result RelayAccessPoint -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== RelayAccessPoint -> Result RelayAccessPoint
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelayAccessPoint -> RelayAccessPoint
fullyQualified RelayAccessPoint
ra))
  where
    fullyQualified :: RelayAccessPoint -> RelayAccessPoint
    fullyQualified :: RelayAccessPoint -> RelayAccessPoint
fullyQualified it :: RelayAccessPoint
it@(RelayAccessAddress {}) = RelayAccessPoint
it
    fullyQualified (RelayAccessDomain Domain
d PortNumber
p) =
      Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain (Domain -> Domain
fullyQualified' Domain
d) PortNumber
p
    fullyQualified (RelayAccessSRVDomain Domain
d) =
      Domain -> RelayAccessPoint
RelayAccessSRVDomain (Domain -> Domain
fullyQualified' Domain
d)

    fullyQualified' :: Domain -> Domain
fullyQualified' Domain
domain = case Domain
domain of
      Domain
_ | Just (Domain
_, Char
'.') <- Domain -> Maybe (Domain, Char)
unsnoc Domain
domain -> Domain
domain
        | Bool
otherwise -> Domain
domain Domain -> Char -> Domain
`snoc` Char
'.'

prop_roundtrip_PeerAdvertise_JSON :: PeerAdvertise -> Property
prop_roundtrip_PeerAdvertise_JSON :: PeerAdvertise -> Property
prop_roundtrip_PeerAdvertise_JSON PeerAdvertise
pa =
    ByteString -> Maybe PeerAdvertise
forall a. FromJSON a => ByteString -> Maybe a
decode (PeerAdvertise -> ByteString
forall a. ToJSON a => a -> ByteString
encode PeerAdvertise
pa) Maybe PeerAdvertise -> Maybe PeerAdvertise -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PeerAdvertise -> Maybe PeerAdvertise
forall a. a -> Maybe a
Just PeerAdvertise
pa
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
    Value -> Result PeerAdvertise
forall a. FromJSON a => Value -> Result a
fromJSON (PeerAdvertise -> Value
forall a. ToJSON a => a -> Value
toJSON PeerAdvertise
pa) Result PeerAdvertise -> Result PeerAdvertise -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PeerAdvertise -> Result PeerAdvertise
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerAdvertise
pa