-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

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
      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
      supported <- resp.json %. "supported" & asSet
      domain <- resp.json %. "domain" & asString
      federation <- resp.json %. "federation" & asBool

      -- currently there is one development version
      -- it is however theoretically possible to have multiple development versions
      length dev `shouldMatchInt` 1
      domain `shouldMatch` dom
      federation `shouldMatch` True

      unless (null (Set.intersection supported dev))
        $ assertFailure "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
      user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
      void $ getSelfWithVersion (ExplicitVersion 2) user >>= getJSON 200

    do
      user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      bindResponse (getSelfWithVersion (ExplicitVersion 2) user) $ \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"

      void $ getSelfWithVersion (ExplicitVersion 1) user >>= getJSON 200
      void $ getSelfWithVersion (ExplicitVersion 3) user >>= getJSON 200
      void $ getSelfWithVersion (ExplicitVersion 4) user >>= getJSON 200
      void $ getSelfWithVersion (ExplicitVersion 5) user >>= getJSON 200
      void $ getSelfWithVersion (ExplicitVersion 6) user >>= getJSON 200
      void $ getSelfWithVersion Unversioned user >>= getJSON 200

testVersionDisabledNotAdvertised :: App ()
testVersionDisabledNotAdvertised :: App ()
testVersionDisabledNotAdvertised = do
  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)
  forM_ allVersions 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
          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
          supported <- resp.json %. "supported" & asList >>= traverse asInt

          assertBool "supported versions should not be empty" $ not (null supported)
          assertBool "the disabled version should not be propagated as dev version" $ v `notElem` dev
          assertBool "the disabled version should not be propagated as supported version" $ v `notElem` 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
      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
      supported <- resp.json %. "supported" & asList

      assertBool "supported versions should not be empty" $ not (null supported)
      assertBool "development versions should be empty" $ null dev