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, Int
9, Int
10, Int
11, Int
12, Int
13, Int
14, Int
15]
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"]
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
actualVersions :: Set Int <- do
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
dev <- resp.json %. "development" & asSetOf asIntegral
pure $ sup <> dev
assertBool ("unexpected actually existing versions: " <> show actualVersions)
$
actualVersions
`Set.isSubsetOf` 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
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
]
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
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"
]
swagger <- submit "GET" req >>= getBody 200
liftIO $ B.writeFile (tmp </> "swagger.json") swagger
let 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, out, err) <- liftIO $ readCreateProcessWithExitCode cmd ""
case 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"