{-# LANGUAGE OverloadedStrings #-}

module Test.Federator where

import API.Brig
import API.Federator (getMetrics)
import Data.Attoparsec.Text
import qualified Data.ByteString as BS
import Data.String.Conversions
import Data.Text
import SetupHelpers (randomUser)
import Testlib.Prelude

runFederatorMetrics :: (ServiceMap -> HostPort) -> App ()
runFederatorMetrics :: (ServiceMap -> HostPort) -> App ()
runFederatorMetrics ServiceMap -> HostPort
getService = do
  let handleRes :: r -> App r
handleRes r
res = r
res r -> App () -> App r
forall a b. a -> App b -> App a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ r
res.status a -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  Response
first <- App Response -> (Response -> App Response) -> App Response
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> (ServiceMap -> HostPort) -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> (ServiceMap -> HostPort) -> App Response
getMetrics Domain
OwnDomain ServiceMap -> HostPort
getService) Response -> App Response
forall {a} {r}. (MakesValue a, HasField "status" r a) => r -> App r
handleRes
  Response
second <- App Response -> (Response -> App Response) -> App Response
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> (ServiceMap -> HostPort) -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> (ServiceMap -> HostPort) -> App Response
getMetrics Domain
OwnDomain ServiceMap -> HostPort
getService) Response -> App Response
forall {a} {r}. (MakesValue a, HasField "status" r a) => r -> App r
handleRes
  HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Two metric requests should never match" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Response
first.body ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Response
second.body
  HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Second metric response should never be 0 length (the first might be)" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length Response
second.body Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"The seconds metric response should have text indicating that it is returning metrics"
    (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Bool
BS.isInfixOf ByteString
expectedString Response
second.body
  where
    expectedString :: ByteString
expectedString = ByteString
"# TYPE http_request_duration_seconds histogram"

-- | The metrics setup for both internal and external federator servers
-- are the same, so we can simply run the same test for both.
testFederatorMetricsInternal :: App ()
testFederatorMetricsInternal :: App ()
testFederatorMetricsInternal = (ServiceMap -> HostPort) -> App ()
runFederatorMetrics ServiceMap -> HostPort
federatorInternal

testFederatorMetricsExternal :: App ()
testFederatorMetricsExternal :: App ()
testFederatorMetricsExternal = (ServiceMap -> HostPort) -> App ()
runFederatorMetrics ServiceMap -> HostPort
federatorExternal

testFederatorNumRequestsMetrics :: (HasCallStack) => App ()
testFederatorNumRequestsMetrics :: HasCallStack => App ()
testFederatorNumRequestsMetrics = do
  Value
u1 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
u2 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OtherDomain CreateUser
forall a. Default a => a
def
  Integer
incomingBefore <- (Text -> Parser Integer) -> Domain -> Domain -> App Integer
getMetric Text -> Parser Integer
parseIncomingRequestCount Domain
OtherDomain Domain
OwnDomain
  Integer
outgoingBefore <- (Text -> Parser Integer) -> Domain -> Domain -> App Integer
getMetric Text -> Parser Integer
parseOutgoingRequestCount Domain
OwnDomain Domain
OtherDomain
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> Domain -> App Response
forall user searchTerm domain.
(MakesValue user, MakesValue searchTerm, MakesValue domain) =>
user -> searchTerm -> domain -> App Response
searchContacts Value
u1 (Value
u2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") Domain
OtherDomain) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp ->
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  Integer
incomingAfter <- (Text -> Parser Integer) -> Domain -> Domain -> App Integer
getMetric Text -> Parser Integer
parseIncomingRequestCount Domain
OtherDomain Domain
OwnDomain
  Integer
outgoingAfter <- (Text -> Parser Integer) -> Domain -> Domain -> App Integer
getMetric Text -> Parser Integer
parseOutgoingRequestCount Domain
OwnDomain Domain
OtherDomain
  HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Incoming requests count should have increased by at least 2" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Integer
incomingAfter Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
incomingBefore Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2
  HasCallStack => String -> Bool -> App ()
String -> Bool -> App ()
assertBool String
"Outgoing requests count should have increased by at least 2" (Bool -> App ()) -> Bool -> App ()
forall a b. (a -> b) -> a -> b
$ Integer
outgoingAfter Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
outgoingBefore Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2
  where
    getMetric :: (Text -> Parser Integer) -> Domain -> Domain -> App Integer
    getMetric :: (Text -> Parser Integer) -> Domain -> Domain -> App Integer
getMetric Text -> Parser Integer
p Domain
domain Domain
origin = do
      Response
m <- Domain -> (ServiceMap -> HostPort) -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> (ServiceMap -> HostPort) -> App Response
getMetrics Domain
domain ServiceMap -> HostPort
federatorInternal
      Text
d <- String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> App String -> App Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
origin
      Integer -> App Integer
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> App Integer) -> Integer -> App Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Either String Integer -> Integer
forall b a. b -> Either a b -> b
fromRight Integer
0 (Parser Integer -> Text -> Either String Integer
forall a. Parser a -> Text -> Either String a
parseOnly (Text -> Parser Integer
p Text
d) (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Response
m.body))

    parseIncomingRequestCount :: Text -> Parser Integer
    parseIncomingRequestCount :: Text -> Parser Integer
parseIncomingRequestCount Text
d =
      Parser Text Char -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text Text
string (Text
"com_wire_federator_incoming_requests{origin_domain=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"} "))
        Parser Text String -> Parser Integer -> Parser Integer
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall a. Integral a => Parser a
decimal

    parseOutgoingRequestCount :: Text -> Parser Integer
    parseOutgoingRequestCount :: Text -> Parser Integer
parseOutgoingRequestCount Text
d =
      Parser Text Char -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Text Char
anyChar (Text -> Parser Text Text
string (Text
"com_wire_federator_outgoing_requests{target_domain=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"} "))
        Parser Text String -> Parser Integer -> Parser Integer
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall a. Integral a => Parser a
decimal