module Test.Version where

import API.Brig
import qualified Data.Set as Set
import SetupHelpers
import Testlib.Prelude

newtype Versioned' = Versioned' Versioned

-- | This instance is used to generate tests for some of the versions. (Not checking all of them for time efficiency reasons)
instance TestCases Versioned' where
  mkTestCases :: IO [TestCase Versioned']
mkTestCases =
    [TestCase Versioned'] -> IO [TestCase Versioned']
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> Versioned' -> TestCase Versioned'
forall a. String -> a -> TestCase a
MkTestCase String
"[version=unversioned]" (Versioned -> Versioned'
Versioned' Versioned
Unversioned),
        String -> Versioned' -> TestCase Versioned'
forall a. String -> a -> TestCase a
MkTestCase String
"[version=versioned]" (Versioned -> Versioned'
Versioned' Versioned
Versioned),
        String -> Versioned' -> TestCase Versioned'
forall a. String -> a -> TestCase a
MkTestCase String
"[version=v1]" (Versioned -> Versioned'
Versioned' (Int -> Versioned
ExplicitVersion Int
1)),
        String -> Versioned' -> TestCase Versioned'
forall a. String -> a -> TestCase a
MkTestCase String
"[version=v3]" (Versioned -> Versioned'
Versioned' (Int -> Versioned
ExplicitVersion Int
3)),
        String -> Versioned' -> TestCase Versioned'
forall a. String -> a -> TestCase a
MkTestCase String
"[version=v6]" (Versioned -> Versioned'
Versioned' (Int -> Versioned
ExplicitVersion Int
6))
      ]

-- | Used to test endpoints that have changed after version 5
data Version5 = Version5 | NoVersion5

instance TestCases Version5 where
  mkTestCases :: IO [TestCase Version5]
mkTestCases =
    [TestCase Version5] -> IO [TestCase Version5]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> Version5 -> TestCase Version5
forall a. String -> a -> TestCase a
MkTestCase String
"[version=versioned]" Version5
NoVersion5,
        String -> Version5 -> TestCase Version5
forall a. String -> a -> TestCase a
MkTestCase String
"[version=v5]" Version5
Version5
      ]

withVersion5 :: Version5 -> App a -> App a
withVersion5 :: forall a. Version5 -> App a -> App a
withVersion5 Version5
Version5 = Int -> App a -> App a
forall a. Int -> App a -> App a
withAPIVersion Int
5
withVersion5 Version5
NoVersion5 = App a -> App a
forall a. a -> a
id

testVersion :: Versioned' -> App ()
testVersion :: Versioned' -> App ()
testVersion (Versioned' Versioned
v) = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  ServiceOverrides
forall a. Default a => a
def {brigCfg = setField "optSettings.setDisabledAPIVersions" ([] :: [String])}
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
dom ->
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest String
dom Service
Brig Versioned
v String
"/api-version" App Request -> (Request -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Request -> App Response
submit String
"GET") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      Set Value
dev <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"development" App Value -> (App Value -> App (Set Value)) -> App (Set Value)
forall a b. a -> (a -> b) -> b
& App Value -> App (Set Value)
forall a. (HasCallStack, MakesValue a) => a -> App (Set Value)
asSet
      Set Value
supported <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported" App Value -> (App Value -> App (Set Value)) -> App (Set Value)
forall a b. a -> (a -> b) -> b
& App Value -> App (Set Value)
forall a. (HasCallStack, MakesValue a) => a -> App (Set Value)
asSet
      String
domain <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
      Bool
federation <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"federation" App Value -> (App Value -> App Bool) -> App Bool
forall a b. a -> (a -> b) -> b
& App Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
asBool

      -- currently there is only one development version
      -- it is however theoretically possible to have multiple development versions
      Set Value -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set Value
dev Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
      String
domain String -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
dom
      Bool
federation Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

      Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set Value -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set Value -> Set Value -> Set Value
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set Value
supported Set Value
dev))
        (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"development and supported versions should not overlap"

testVersionUnsupported :: App ()
testVersionUnsupported :: App ()
testVersionUnsupported = App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest Domain
OwnDomain Service
Brig (Int -> Versioned
ExplicitVersion Int
500) String
"/api-version" App Request -> (Request -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Request -> App Response
submit String
"GET")
  ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unsupported-version"

testVersionDisabled :: App ()
testVersionDisabled :: App ()
testVersionDisabled = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  ServiceOverrides
forall a. Default a => a
def {brigCfg = setField "optSettings.setDisabledAPIVersions" ["v2"]}
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    do
      Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
2) Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

    do
      Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
2) Value
user) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"unsupported-version"

      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
1) Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
3) Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
4) Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
5) Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion (Int -> Versioned
ExplicitVersion Int
6) Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Versioned -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
Versioned -> user -> App Response
getSelfWithVersion Versioned
Unversioned Value
user App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200

testVersionDisabledNotAdvertised :: App ()
testVersionDisabledNotAdvertised :: App ()
testVersionDisabledNotAdvertised = do
  [Int]
allVersions <- App Response -> (Response -> App [Int]) -> App [Int]
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Service -> Versioned -> String -> App Request
forall user.
(HasCallStack, MakesValue user) =>
user -> Service -> Versioned -> String -> App Request
baseRequest Domain
OwnDomain Service
Brig Versioned
Versioned String
"/api-version" App Request -> (Request -> App Response) -> App Response
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Request -> App Response
submit String
"GET") ((Response -> App [Int]) -> App [Int])
-> (Response -> App [Int]) -> App [Int]
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
    [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
(<>)
      ([Int] -> [Int] -> [Int]) -> App [Int] -> App ([Int] -> [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"development" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [Int]) -> App [Int]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Int) -> [Value] -> App [Int]
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 Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt)
      App ([Int] -> [Int]) -> App [Int] -> App [Int]
forall a b. App (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [Int]) -> App [Int]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Int) -> [Value] -> App [Int]
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 Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt)
  [Int] -> (Int -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
allVersions Int -> App ()
testWithVersion
  where
    testWithVersion :: Int -> App ()
    testWithVersion :: Int -> App ()
testWithVersion Int
v = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
      ServiceOverrides
forall a. Default a => a
def {brigCfg = setField "optSettings.setDisabledAPIVersions" ["v" <> show v]}
      ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
getAPIVersion String
domain) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
          Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
          [Int]
dev <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"development" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [Int]) -> App [Int]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Int) -> [Value] -> App [Int]
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 Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt
          [Int]
supported <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [Value] -> ([Value] -> App [Int]) -> App [Int]
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> App Int) -> [Value] -> App [Int]
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 Value -> App Int
forall a. (HasCallStack, MakesValue a) => a -> App Int
asInt

          HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"supported versions should not be empty" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
supported)
          HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"the disabled version should not be propagated as dev version" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Int
v Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
dev
          HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"the disabled version should not be propagated as supported version" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Int
v Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
supported

testVersionDisabledDevNotAdvertised :: App ()
testVersionDisabledDevNotAdvertised :: App ()
testVersionDisabledDevNotAdvertised = ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
  ServiceOverrides
forall a. Default a => a
def {brigCfg = setField "optSettings.setDisabledAPIVersions" ["development"]}
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
getAPIVersion String
domain) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
      Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      [Value]
dev <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"development" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
      [Value]
supported <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"supported" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList

      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"supported versions should not be empty" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
supported)
      HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"development versions should be empty" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ [Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
dev