module Testlib.RunServices where

import Control.Concurrent
import Control.Monad.Codensity
import System.Directory
import System.Environment (getArgs)
import System.Exit (exitWith)
import System.FilePath
import System.Posix (getWorkingDirectory)
import System.Process
import Testlib.Prelude
import Testlib.ResourcePool

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 k1. Maybe k1
Nothing
        else String -> Maybe String
forall k1. k1 -> Maybe k1
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 k1. k1 -> Maybe k1
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 k1. Maybe k1
Nothing
      Just String
p -> String -> IO (Maybe String)
findProjectRoot String
p

main :: IO ()
main :: IO ()
main = do
  String
cwd <- IO String
getWorkingDirectory
  Maybe String
mbProjectRoot <- String -> IO (Maybe String)
findProjectRoot String
cwd
  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"]

  [String]
args <- IO [String]
getArgs

  let run :: IO ()
run = case [String]
args 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
1000000000)
        [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
<> [String]
args)
          (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
>>= GlobalEnv -> Codensity IO Env
mkEnv) ((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
        ()
_modifyEnv <-
          (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
$ 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