module Test.Swagger where

import qualified API.Brig as BrigP
import qualified Data.ByteString as B
import qualified Data.Set as Set
import Data.String.Conversions
import GHC.Stack
import System.Exit
import System.FilePath
import System.Process
import Testlib.Assertions
import Testlib.Prelude
import UnliftIO.Temporary

existingVersions :: Set Int
existingVersions :: Set Int
existingVersions = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [Int
0, Int
1, Int
2, Int
3, Int
4, Int
5, Int
6, Int
7, Int
8]

internalApis :: Set String
internalApis :: Set String
internalApis = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String
"brig", String
"cannon", String
"cargohold", String
"cannon", String
"spar"]

-- | See https://docs.wire.com/understand/api-client-perspective/swagger.html
testSwagger :: (HasCallStack) => App ()
testSwagger :: HasCallStack => App ()
testSwagger = do
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse App Response
HasCallStack => App Response
BrigP.getApiVersions ((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 Int
actualVersions :: Set Int <- do
      Set Int
sup <- 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 Int)) -> App (Set Int)
forall a b. a -> (a -> b) -> b
& (Value -> App Int)
-> MakesValue (App Value) => App Value -> App (Set Int)
forall b a.
(HasCallStack, Ord b) =>
(Value -> App b) -> MakesValue a => a -> App (Set b)
asSetOf Value -> App Int
forall i a. (Integral i, HasCallStack, MakesValue a) => a -> App i
asIntegral
      Set 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 (Set Int)) -> App (Set Int)
forall a b. a -> (a -> b) -> b
& (Value -> App Int)
-> MakesValue (App Value) => App Value -> App (Set Int)
forall b a.
(HasCallStack, Ord b) =>
(Value -> App b) -> MakesValue a => a -> App (Set b)
asSetOf Value -> App Int
forall i a. (Integral i, HasCallStack, MakesValue a) => a -> App i
asIntegral
      Set Int -> App (Set Int)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Int -> App (Set Int)) -> Set Int -> App (Set Int)
forall a b. (a -> b) -> a -> b
$ Set Int
sup Set Int -> Set Int -> Set Int
forall a. Semigroup a => a -> a -> a
<> Set Int
dev
    HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool (String
"unexpected actually existing versions: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Set Int -> String
forall a. Show a => a -> String
show Set Int
actualVersions)
      (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$
      -- make sure nobody has added a new version without adding it to `existingVersions`.
      -- ("subset" because blocked versions like v3 are not actually existing, but still
      -- documented.)
      Set Int
actualVersions
      Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Int
existingVersions

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse App Response
HasCallStack => App Response
BrigP.getSwaggerPublicTOC ((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
    ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs Response
resp.body HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
"<html>"

  Set Int -> (Int -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set Int
existingVersions ((Int -> App ()) -> App ()) -> (Int -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Int
v -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => Int -> App Response
Int -> App Response
BrigP.getSwaggerPublicAllUI Int
v) ((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
      ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs Response
resp.body HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
"<!DOCTYPE html>"
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => Int -> App Response
Int -> App Response
BrigP.getSwaggerPublicAllJson Int
v) ((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
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response
resp.json

  -- !
  -- FUTUREWORK: Implement BrigP.getSwaggerInternalTOC (including the end-point); make sure
  -- newly added internal APIs make this test fail if not added to `internalApis`.

  Set String -> (String -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set String
internalApis ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
api -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => String -> App Response
String -> App Response
BrigP.getSwaggerInternalUI String
api) ((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
      ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs Response
resp.body HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` String
"<!DOCTYPE html>"
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => String -> App Response
String -> App Response
BrigP.getSwaggerInternalJson String
api) ((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
      App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Response
resp.json

testSwaggerInternalVersionedNotFound :: (HasCallStack) => App ()
testSwaggerInternalVersionedNotFound :: HasCallStack => App ()
testSwaggerInternalVersionedNotFound = do
  Set String -> (String -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set String
internalApis ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
api -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> App Response
getSwaggerInternalUI String
api) ((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
  where
    getSwaggerInternalUI :: String -> App Response
    getSwaggerInternalUI :: String -> App Response
getSwaggerInternalUI String
srv =
      Domain -> Service -> Versioned -> String -> App Request
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Service -> Versioned -> String -> App Request
rawBaseRequest Domain
OwnDomain Service
Brig (Int -> Versioned
ExplicitVersion Int
2) ([String] -> String
joinHttpPath [String
"api-internal", String
"swagger-ui", String
srv])
        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"

testSwaggerToc :: (HasCallStack) => App ()
testSwaggerToc :: HasCallStack => App ()
testSwaggerToc = do
  [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String
"/api/swagger-ui", String
"/api/swagger-ui/index.html", String
"/api/swagger.json"] ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
path ->
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> App Response
get String
path) ((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
      let body :: String
body = forall a b. ConvertibleStrings a b => a -> b
cs @_ @String Response
resp.body
      Set Int -> (Int -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set Int
existingVersions ((Int -> App ()) -> App ()) -> (Int -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Int
v ->
        String
body HasCallStack => String -> String -> App ()
String -> String -> App ()
`shouldContainString` (String
"\nv" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":")
  where
    get :: String -> App Response
    get :: String -> App Response
get String
path = Domain -> Service -> Versioned -> String -> App Request
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Service -> Versioned -> String -> App Request
rawBaseRequest Domain
OwnDomain Service
Brig Versioned
Unversioned String
path 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"

data Swagger = SwaggerPublic | SwaggerInternal Service

instance TestCases Swagger where
  mkTestCases :: IO [TestCase Swagger]
mkTestCases =
    [TestCase Swagger] -> IO [TestCase Swagger]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      [ String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=ibrig]" (Service -> Swagger
SwaggerInternal Service
Brig),
        String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=icannon]" (Service -> Swagger
SwaggerInternal Service
Cannon),
        String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=icargohold]" (Service -> Swagger
SwaggerInternal Service
Cargohold),
        String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=igalley]" (Service -> Swagger
SwaggerInternal Service
Galley),
        String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=igundeck]" (Service -> Swagger
SwaggerInternal Service
Gundeck),
        String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=ispar]" (Service -> Swagger
SwaggerInternal Service
Spar),
        String -> Swagger -> TestCase Swagger
forall a. String -> a -> TestCase a
MkTestCase String
"[swagger=public]" Swagger
SwaggerPublic
      ]

-- | This runs the swagger linter [vacuum](https://quobix.com/vacuum/).
--
-- The reason for adding the linter in the integration tests, and not in the lint job, is that
-- it calls brig for the swagger docs it validates, but no running brig during linting.
--
-- There is also a make rule that does this, for convenience in your develop
-- flow. Make sure that brig is running before using the make rule.
testSwaggerLint :: (HasCallStack) => Swagger -> App ()
testSwaggerLint :: HasCallStack => Swagger -> App ()
testSwaggerLint Swagger
sw = do
  String -> (String -> App ()) -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"swagger" ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
tmp -> do
    Request
req <- case Swagger
sw of
      Swagger
SwaggerPublic ->
        Domain -> Service -> Versioned -> String -> App Request
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Service -> Versioned -> String -> App Request
baseRequest Domain
OwnDomain Service
Brig Versioned
Versioned
          (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath [String
"api", String
"swagger.json"]
      (SwaggerInternal Service
service) ->
        Domain -> Service -> Versioned -> String -> App Request
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Service -> Versioned -> String -> App Request
baseRequest Domain
OwnDomain Service
Brig Versioned
Unversioned
          (String -> App Request) -> String -> App Request
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinHttpPath
            [ String
"api-internal",
              String
"swagger-ui",
              Service -> String
serviceName Service
service String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-swagger.json"
            ]
    ByteString
swagger <- String -> Request -> App Response
submit String
"GET" Request
req App Response -> (Response -> App ByteString) -> App ByteString
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 ByteString
Int -> Response -> App ByteString
getBody Int
200
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
B.writeFile (String
tmp String -> String -> String
</> String
"swagger.json") ByteString
swagger
    let cmd :: CreateProcess
cmd = String -> CreateProcess
shell (String -> CreateProcess) -> String -> CreateProcess
forall a b. (a -> b) -> a -> b
$ String
"vacuum lint -a -d -e " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
tmp String -> String -> String
</> String
"swagger.json")
    (ExitCode
exitCode, String
out, String
err) <- IO (ExitCode, String, String) -> App (ExitCode, String, String)
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, String, String) -> App (ExitCode, String, String))
-> IO (ExitCode, String, String) -> App (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cmd String
""
    case ExitCode
exitCode of
      ExitCode
ExitSuccess -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ExitCode
_ -> do
        IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn String
out
        IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn String
err
        String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"swagger validation errors"