module Testlib.VersionedFed where

import Control.Monad.Reader
import Data.Proxy
import qualified Data.Text as T
import GHC.TypeLits
import System.Environment
import Testlib.PTest
import Testlib.Prelude

data FedDomain n = FedDomain

instance MakesValue (FedDomain 0) where
  make :: HasCallStack => FedDomain 0 -> App Value
make FedDomain 0
FedDomain = (Env -> Value) -> App Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> Value
String (Text -> Value) -> (Env -> Text) -> Env -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Env -> String) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.federationV0Domain))

instance MakesValue (FedDomain 1) where
  make :: HasCallStack => FedDomain 1 -> App Value
make FedDomain 1
FedDomain = (Env -> Value) -> App Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> Value
String (Text -> Value) -> (Env -> Text) -> Env -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Env -> String) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.federationV1Domain))

instance (KnownNat n) => TestCases (FedDomain n) where
  mkTestCases :: IO [TestCase (FedDomain n)]
mkTestCases =
    let v :: Integer
v = Proxy n -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Natural). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)
     in (TestCase Integer -> TestCase (FedDomain n))
-> [TestCase Integer] -> [TestCase (FedDomain n)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> FedDomain n)
-> TestCase Integer -> TestCase (FedDomain n)
forall a b. (a -> b) -> TestCase a -> TestCase b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FedDomain n -> Integer -> FedDomain n
forall a b. a -> b -> a
const FedDomain n
forall {k} (n :: k). FedDomain n
FedDomain))
          ([TestCase Integer] -> [TestCase (FedDomain n)])
-> IO [TestCase Integer] -> IO [TestCase (FedDomain n)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Integer -> IO [TestCase Integer]
mkFedTestCase (String
"[domain=fed-v" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]") Integer
v

mkFedTestCase :: String -> Integer -> IO [TestCase Integer]
mkFedTestCase :: String -> Integer -> IO [TestCase Integer]
mkFedTestCase String
name Integer
n = do
  Maybe String
v <- String -> IO (Maybe String)
lookupEnv (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"ENABLE_FEDERATION_V" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
n
  if Maybe String
v Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"1"
    then [TestCase Integer] -> IO [TestCase Integer]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String -> Integer -> TestCase Integer
forall a. String -> a -> TestCase a
MkTestCase String
name Integer
n]
    else [TestCase Integer] -> IO [TestCase Integer]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

data AnyFedDomain = AnyFedDomain Integer

instance MakesValue AnyFedDomain where
  make :: HasCallStack => AnyFedDomain -> App Value
make (AnyFedDomain Integer
0) = (Env -> Value) -> App Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> Value
String (Text -> Value) -> (Env -> Text) -> Env -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Env -> String) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.federationV0Domain))
  make (AnyFedDomain Integer
1) = (Env -> Value) -> App Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> Value
String (Text -> Value) -> (Env -> Text) -> Env -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Env -> String) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.federationV1Domain))
  make (AnyFedDomain Integer
_) = String -> App Value
forall a. HasCallStack => String -> a
error String
"invalid federation version"

instance TestCases AnyFedDomain where
  mkTestCases :: IO [TestCase AnyFedDomain]
mkTestCases =
    (TestCase Integer -> TestCase AnyFedDomain)
-> [TestCase Integer] -> [TestCase AnyFedDomain]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> AnyFedDomain)
-> TestCase Integer -> TestCase AnyFedDomain
forall a b. (a -> b) -> TestCase a -> TestCase b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> AnyFedDomain
AnyFedDomain)
      ([TestCase Integer] -> [TestCase AnyFedDomain])
-> ([[TestCase Integer]] -> [TestCase Integer])
-> [[TestCase Integer]]
-> [TestCase AnyFedDomain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TestCase Integer]] -> [TestCase Integer]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      ([[TestCase Integer]] -> [TestCase AnyFedDomain])
-> IO [[TestCase Integer]] -> IO [TestCase AnyFedDomain]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Integer) -> IO [TestCase Integer])
-> [(String, Integer)] -> IO [[TestCase Integer]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
        ((String -> Integer -> IO [TestCase Integer])
-> (String, Integer) -> IO [TestCase Integer]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Integer -> IO [TestCase Integer]
mkFedTestCase)
        [(String
"[domain=fed-v" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]", Integer
v) | Integer
v <- [Integer
0, Integer
1]]

-- | This can be used as an argument for parametrised tests. It will be bound
-- to at least 'OtherDomain', and optionally to legacy federated domains,
-- according to the values of the corresponding environment variables
-- (@ENABLE_FEDERATION_V0@ and similar).
data StaticDomain = StaticDomain | StaticFedDomain Integer
  deriving (StaticDomain -> StaticDomain -> Bool
(StaticDomain -> StaticDomain -> Bool)
-> (StaticDomain -> StaticDomain -> Bool) -> Eq StaticDomain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticDomain -> StaticDomain -> Bool
== :: StaticDomain -> StaticDomain -> Bool
$c/= :: StaticDomain -> StaticDomain -> Bool
/= :: StaticDomain -> StaticDomain -> Bool
Eq)

instance MakesValue StaticDomain where
  make :: HasCallStack => StaticDomain -> App Value
make StaticDomain
StaticDomain = Domain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make Domain
OtherDomain
  make (StaticFedDomain Integer
n) = AnyFedDomain -> App Value
forall a. (MakesValue a, HasCallStack) => a -> App Value
make (Integer -> AnyFedDomain
AnyFedDomain Integer
n)

instance TestCases StaticDomain where
  mkTestCases :: IO [TestCase StaticDomain]
mkTestCases = do
    [TestCase StaticDomain]
feds <-
      (TestCase Integer -> TestCase StaticDomain)
-> [TestCase Integer] -> [TestCase StaticDomain]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> StaticDomain)
-> TestCase Integer -> TestCase StaticDomain
forall a b. (a -> b) -> TestCase a -> TestCase b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> StaticDomain
StaticFedDomain)
        ([TestCase Integer] -> [TestCase StaticDomain])
-> ([[TestCase Integer]] -> [TestCase Integer])
-> [[TestCase Integer]]
-> [TestCase StaticDomain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[TestCase Integer]] -> [TestCase Integer]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        ([[TestCase Integer]] -> [TestCase StaticDomain])
-> IO [[TestCase Integer]] -> IO [TestCase StaticDomain]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Integer) -> IO [TestCase Integer])
-> [(String, Integer)] -> IO [[TestCase Integer]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
          ((String -> Integer -> IO [TestCase Integer])
-> (String, Integer) -> IO [TestCase Integer]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Integer -> IO [TestCase Integer]
mkFedTestCase)
          [(String
"[domain=fed-v" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]", Integer
v) | Integer
v <- [Integer
0, Integer
1]]
    [TestCase StaticDomain] -> IO [TestCase StaticDomain]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TestCase StaticDomain] -> IO [TestCase StaticDomain])
-> [TestCase StaticDomain] -> IO [TestCase StaticDomain]
forall a b. (a -> b) -> a -> b
$ [String -> StaticDomain -> TestCase StaticDomain
forall a. String -> a -> TestCase a
MkTestCase String
"[domain=other]" StaticDomain
StaticDomain] [TestCase StaticDomain]
-> [TestCase StaticDomain] -> [TestCase StaticDomain]
forall a. Semigroup a => a -> a -> a
<> [TestCase StaticDomain]
feds