module Testlib.RunServices (main, backendA, backendB) where

import Control.Concurrent
import Control.Monad.Codensity
import Control.Monad.IO.Class
import Options.Applicative
import System.Directory
import System.Exit
import System.FilePath
import System.Posix (getWorkingDirectory)
import System.Process
import Testlib.Ports
import Testlib.Prelude

parentDir :: FilePath -> Maybe FilePath
parentDir :: String -> Maybe String
parentDir String
path =
  let dirs :: [String]
dirs = String -> [String]
splitPath String
path
   in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dirs
        then Maybe String
forall a. Maybe a
Nothing
        else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
dirs)

containsGit :: FilePath -> IO Bool
containsGit :: String -> IO Bool
containsGit String
path =
  String -> IO Bool
doesPathExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath [String
path, String
".git"]

findProjectRoot :: FilePath -> IO (Maybe FilePath)
findProjectRoot :: String -> IO (Maybe String)
findProjectRoot String
path = do
  Bool
c <- String -> IO Bool
containsGit String
path
  if Bool
c
    then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
    else case String -> Maybe String
parentDir String
path of
      Maybe String
Nothing -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
      Just String
p -> String -> IO (Maybe String)
findProjectRoot String
p

data Opts = Opts
  { Opts -> Bool
withManualTestingOverrides :: Bool,
    Opts -> [String]
runSubprocess :: [String]
  }
  deriving (Int -> Opts -> ShowS
[Opts] -> ShowS
Opts -> String
(Int -> Opts -> ShowS)
-> (Opts -> String) -> ([Opts] -> ShowS) -> Show Opts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Opts -> ShowS
showsPrec :: Int -> Opts -> ShowS
$cshow :: Opts -> String
show :: Opts -> String
$cshowList :: [Opts] -> ShowS
showList :: [Opts] -> ShowS
Show)

optsParser :: Parser Opts
optsParser :: Parser Opts
optsParser =
  Bool -> [String] -> Opts
Opts
    (Bool -> [String] -> Opts)
-> Parser Bool -> Parser ([String] -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"with-manual-testing-overrides"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm'
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Run services with settings tuned for manual app usage (not recommended for running integration tests)"
      )
    Parser ([String] -> Opts) -> Parser [String] -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
      ( Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
          ( String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"COMMAND_WITH_ARGS"
              Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"When specified, the command will be run after services have started and service will be killed after the command exits"
          )
      )

main :: IO ()
main :: IO ()
main = do
  String
cwd <- IO String
getWorkingDirectory
  Maybe String
mbProjectRoot <- String -> IO (Maybe String)
findProjectRoot String
cwd
  Opts
opts <- ParserInfo Opts -> IO Opts
forall a. ParserInfo a -> IO a
execParser (Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Opts
optsParser Parser Opts -> Parser (Opts -> Opts) -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Opts -> Opts)
forall a. Parser (a -> a)
helper) InfoMod Opts
forall a. InfoMod a
fullDesc)
  String
cfg <- case Maybe String
mbProjectRoot of
    Maybe String
Nothing -> String -> IO String
forall a. HasCallStack => String -> a
error String
"Could not find project root. Please make sure you call run-services from somewhere in wire-server."
    Just String
projectRoot ->
      String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
joinPath [String
projectRoot, String
"services/integration.yaml"]

  let run :: IO ()
run = case Opts
opts.runSubprocess of
        [] -> do
          String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn String
"services started"
          IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound)
        [String]
_ -> do
          let cp :: CreateProcess
cp = String -> [String] -> CreateProcess
proc String
"sh" ([String
"-c", String
"exec \"$@\"", String
"--"] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Opts
opts.runSubprocess)
          (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp
          ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph

  Codensity IO Env -> forall b. (Env -> IO b) -> IO b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (String -> Codensity IO GlobalEnv
mkGlobalEnv String
cfg Codensity IO GlobalEnv
-> (GlobalEnv -> Codensity IO Env) -> Codensity IO Env
forall a b.
Codensity IO a -> (a -> Codensity IO b) -> Codensity IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> GlobalEnv -> Codensity IO Env
mkEnv Maybe String
forall a. Maybe a
Nothing) ((Env -> IO ()) -> IO ()) -> (Env -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Env
env ->
    Env -> App () -> IO ()
forall a. Env -> App a -> IO a
runAppWithEnv Env
env
      (App () -> IO ()) -> App () -> IO ()
forall a b. (a -> b) -> a -> b
$ Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity
      (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
        Codensity App () -> Codensity App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
          (Codensity App () -> Codensity App ())
-> Codensity App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ (HasCallStack => BackendResource -> Codensity App ())
-> HasCallStack => [BackendResource] -> Codensity App ()
forall a.
(HasCallStack => a -> Codensity App ())
-> HasCallStack => [a] -> Codensity App ()
traverseConcurrentlyCodensity
            ( \BackendResource
r ->
                Codensity App String -> Codensity App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
                  (Codensity App String -> Codensity App ())
-> Codensity App String -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ if Opts
opts.withManualTestingOverrides
                    then HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
r ServiceOverrides
manualTestingOverrides
                    else HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
r ServiceOverrides
forall a. Monoid a => a
mempty
            )
            [BackendResource
backendA, BackendResource
backendB]
        IO () -> Codensity App ()
forall a. IO a -> Codensity App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
run

backendA :: BackendResource
backendA :: BackendResource
backendA =
  BackendResource
    { berName :: BackendName
berName = BackendName
BackendA,
      berBrigKeyspace :: String
berBrigKeyspace = String
"brig_test",
      berGalleyKeyspace :: String
berGalleyKeyspace = String
"galley_test",
      berSparKeyspace :: String
berSparKeyspace = String
"spar_test",
      berGundeckKeyspace :: String
berGundeckKeyspace = String
"gundeck_test",
      berElasticsearchIndex :: String
berElasticsearchIndex = String
"directory_test",
      berPostgresqlDBName :: String
berPostgresqlDBName = String
"backendA",
      berFederatorInternal :: Word16
berFederatorInternal = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort (Service -> PortNamespace
ServiceInternal Service
FederatorInternal) BackendName
BackendA,
      berFederatorExternal :: Word16
berFederatorExternal = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort PortNamespace
FederatorExternal BackendName
BackendA,
      berDomain :: String
berDomain = String
"example.com",
      berAwsUserJournalQueue :: String
berAwsUserJournalQueue = String
"integration-user-events.fifo",
      berAwsPrekeyTable :: String
berAwsPrekeyTable = String
"integration-brig-prekeys",
      berAwsS3Bucket :: String
berAwsS3Bucket = String
"dummy-bucket",
      berAwsQueueName :: String
berAwsQueueName = String
"integration-gundeck-events",
      berBrigInternalEvents :: String
berBrigInternalEvents = String
"integration-brig-events-internal",
      berEmailSMSSesQueue :: String
berEmailSMSSesQueue = String
"integration-brig-events",
      berEmailSMSEmailSender :: String
berEmailSMSEmailSender = String
"backend-integration@wire.com",
      berGalleyJournal :: String
berGalleyJournal = String
"integration-team-events.fifo",
      berVHost :: String
berVHost = String
"backendA",
      berNginzSslPort :: Word16
berNginzSslPort = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort PortNamespace
NginzSSL BackendName
BackendA,
      berInternalServicePorts :: forall a. Num a => Service -> a
berInternalServicePorts = BackendName -> Service -> a
forall a. Num a => BackendName -> Service -> a
internalServicePorts BackendName
BackendA,
      berEnableService :: Service -> Bool
berEnableService = Bool -> Service -> Bool
forall a b. a -> b -> a
const Bool
True,
      berNginzHttp2Port :: Word16
berNginzHttp2Port = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort PortNamespace
NginzHttp2 BackendName
BackendA,
      berMlsPrivateKeyPaths :: Value
berMlsPrivateKeyPaths =
        [Pair] -> Value
object
          [ ShowS
forall a. IsString a => String -> a
fromString String
"removal"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ ShowS
forall a. IsString a => String -> a
fromString String
"ed25519" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendA/ed25519.pem",
                  ShowS
forall a. IsString a => String -> a
fromString String
"ecdsa_secp256r1_sha256" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendA/ecdsa_secp256r1_sha256.pem",
                  ShowS
forall a. IsString a => String -> a
fromString String
"ecdsa_secp384r1_sha384" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendA/ecdsa_secp384r1_sha384.pem",
                  ShowS
forall a. IsString a => String -> a
fromString String
"ecdsa_secp521r1_sha512" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendA/ecdsa_secp521r1_sha512.pem"
                ]
          ]
    }

backendB :: BackendResource
backendB :: BackendResource
backendB =
  BackendResource
    { berName :: BackendName
berName = BackendName
BackendB,
      berBrigKeyspace :: String
berBrigKeyspace = String
"brig_test2",
      berGalleyKeyspace :: String
berGalleyKeyspace = String
"galley_test2",
      berSparKeyspace :: String
berSparKeyspace = String
"spar_test2",
      berGundeckKeyspace :: String
berGundeckKeyspace = String
"gundeck_test2",
      berElasticsearchIndex :: String
berElasticsearchIndex = String
"directory2_test",
      berPostgresqlDBName :: String
berPostgresqlDBName = String
"backendB",
      berFederatorInternal :: Word16
berFederatorInternal = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort (Service -> PortNamespace
ServiceInternal Service
FederatorInternal) BackendName
BackendB,
      berFederatorExternal :: Word16
berFederatorExternal = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort PortNamespace
FederatorExternal BackendName
BackendB,
      berDomain :: String
berDomain = String
"b.example.com",
      berAwsUserJournalQueue :: String
berAwsUserJournalQueue = String
"integration-user-events2.fifo",
      berAwsPrekeyTable :: String
berAwsPrekeyTable = String
"integration-brig-prekeys2",
      berAwsS3Bucket :: String
berAwsS3Bucket = String
"dummy-bucket2",
      berAwsQueueName :: String
berAwsQueueName = String
"integration-gundeck-events2",
      berBrigInternalEvents :: String
berBrigInternalEvents = String
"integration-brig-events-internal2",
      berEmailSMSSesQueue :: String
berEmailSMSSesQueue = String
"integration-brig-events2",
      berEmailSMSEmailSender :: String
berEmailSMSEmailSender = String
"backend-integration2@wire.com",
      berGalleyJournal :: String
berGalleyJournal = String
"integration-team-events2.fifo",
      -- FUTUREWORK: set up vhosts in dev/ci for example.com and b.example.com
      -- in case we want backendA and backendB to federate with a third backend
      -- (because otherwise both queues will overlap)
      berVHost :: String
berVHost = String
"backendB",
      berNginzSslPort :: Word16
berNginzSslPort = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort PortNamespace
NginzSSL BackendName
BackendB,
      berInternalServicePorts :: forall a. Num a => Service -> a
berInternalServicePorts = BackendName -> Service -> a
forall a. Num a => BackendName -> Service -> a
internalServicePorts BackendName
BackendB,
      berEnableService :: Service -> Bool
berEnableService = \case
        Service
WireServerEnterprise -> Bool
False
        Service
_ -> Bool
True,
      berNginzHttp2Port :: Word16
berNginzHttp2Port = PortNamespace -> BackendName -> Word16
forall a. Num a => PortNamespace -> BackendName -> a
servicePort PortNamespace
NginzHttp2 BackendName
BackendB,
      berMlsPrivateKeyPaths :: Value
berMlsPrivateKeyPaths =
        [Pair] -> Value
object
          [ ShowS
forall a. IsString a => String -> a
fromString String
"removal"
              String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
                [ ShowS
forall a. IsString a => String -> a
fromString String
"ed25519" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendB/ed25519.pem",
                  ShowS
forall a. IsString a => String -> a
fromString String
"ecdsa_secp256r1_sha256" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendB/ecdsa_secp256r1_sha256.pem",
                  ShowS
forall a. IsString a => String -> a
fromString String
"ecdsa_secp384r1_sha384" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendB/ecdsa_secp384r1_sha384.pem",
                  ShowS
forall a. IsString a => String -> a
fromString String
"ecdsa_secp521r1_sha512" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"test/resources/backendB/ecdsa_secp521r1_sha512.pem"
                ]
          ]
    }

manualTestingOverrides :: ServiceOverrides
manualTestingOverrides :: ServiceOverrides
manualTestingOverrides =
  let smtpEndpoint :: Value
smtpEndpoint = [Pair] -> Value
object [String
"host" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"localhost", String
"port" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
2500 :: Int)]
      authSettings :: Value
authSettings =
        [Pair] -> Value
object
          [ String
"userTokenTimeout" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
4838400 :: Int),
            String
"sessionTokenTimeout" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
86400 :: Int),
            String
"accessTokenTimeout" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
900 :: Int),
            String
"providerTokenTimeout" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
900 :: Int),
            String
"legalHoldUserTokenTimeout" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
4838400 :: Int),
            String
"legalHoldAccessTokenTimeout" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
900 :: Int)
          ]
   in ServiceOverrides
forall a. Default a => a
def
        { brigCfg =
            mergeField "emailSMS.email.smtpEndpoint" smtpEndpoint
              >=> setField "emailSMS.email.smtpConnType" "plain"
              >=> removeField "emailSMS.email.sesQueue"
              >=> removeField "emailSMS.email.sesEndpoint"
              >=> mergeField "zauth.authSettings" authSettings
              >=> setField @_ @Int "optSettings.setActivationTimeout" 3600
              >=> setField @_ @Int "optSettings.setVerificationTimeout" 3600
              >=> setField @_ @Int "optSettings.setTeamInvitationTimeout" 3600
              >=> setField @_ @Int "optSettings.setUserCookieRenewAge" 1209600
              >=> removeField "optSettings.setSuspendInactiveUsers"
        }