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