Set of scripts to startup all components of PI locally

pi-backend.hs

#!/usr/bin/env stack
-- stack script --resolver lts-19.18 --package ansi-terminal,turtle

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

import Data.Bool (bool)
import System.Console.ANSI (setTitle)
import Turtle
import Prelude hiding (FilePath)


main :: IO ()
main = startBackend =<< options "backend starter" ((,) <$> stageParser <*> noRebuildParser)


startBackend :: (Stage, Bool) -> IO ()
startBackend (stage, noRebuild) = do
    echo "Starting backend"
    setTitle "backend"
    cd "/home/jhrcek/Devel/github.com/Holmusk/PI/backend"
    let runBackend =
            if noRebuild
                then "AWS_PROFILE=staging-PI $(stack exec which -- backend) " <> stageFlag stage
                else "AWS_PROFILE=staging-PI stack build --fast --exec 'backend " <> stageFlag stage <> "'"
    shells runBackend empty


-- TODO support this via something like `data Profiling = NoProfiling | YesProfiling`
-- shells ("AWS_PROFILE=staging-PI stack build --profile --exec 'backend " <> stageFlag stage <> " +RTS -p -RTS'") empty

stageParser :: Parser Stage
stageParser =
    bool Testing Staging <$> switch "staging" 's' "Use staging DB"


noRebuildParser :: Parser Bool
noRebuildParser =
    switch "no-rebuild" 'n' "Rebuild backend binary if necessary"


data Stage = Testing | Staging


stageFlag :: Stage -> Text
stageFlag = \case
    Staging -> "--staging"
    Testing -> "--testing"

pi-db.hs

#!/usr/bin/env stack
-- stack script --resolver lts-19.18 --package ansi-terminal,foldl,text,turtle

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

import Control.Concurrent (forkIO)
import System.Console.ANSI (setTitle)
import Turtle
import Prelude hiding (FilePath)

import qualified Control.Foldl as Fold
import qualified Data.Text as Text


main :: IO ()
main = do
    args <- options "PI DB Starter" argsParser
    setTitle "DB"
    startDb args


startDb :: Args -> IO ()
startDb Args{migrate, noRebuild} =
    foldIO startDockerContainer migrateAfterInit
  where
    startDockerContainer =
        inprocWithErr
            "docker"
            [ "run"
            , "-p"
            , "5432:5432"
            , "-e", "POSTGRES_USER=postgres"
            , "-e", "POSTGRES_DB=pi"
            , "-e", "POSTGRES_PASSWORD=Holmusk123!"
             --, "-e", "PGDATA=/var/lib/postgresql/data/pgdata"
            , "postgres:12.8-alpine"
            , "-c", "log_duration=true"
            , "-c", "log_statement=all"
            -- , "-c", "max_connections=10"
            , "-c", "log_min_duration_statement=1000"
            ]
            empty

    migrateAfterInit = Fold.mapM_ $ \case
        Left stdoutLn -> do
            echo stdoutLn
            when
                (migrate && Text.isInfixOf "[1] LOG:  database system is ready to accept connections" (lineToText stdoutLn))
                ( void .
                    forkIO $ do
                        cd "/home/jhrcek/Devel/github.com/Holmusk/PI/backend"
                        let runMigrate =
                                if noRebuild
                                    then "$(stack exec which -- migrate)"
                                    else "make migrate"
                        shells runMigrate empty
                )
        Right stderrLn -> echo stderrLn


argsParser :: Parser Args
argsParser =
    Args
        <$> switch "migrate" 'm' "Run DB migration"
        <*> switch "no-rebuild" 'n' "Skip rebuild of migrate binary"


data Args = Args
    { migrate :: Bool
    , noRebuild :: Bool
    }

pi-executor.hs

#!/usr/bin/env stack
-- stack script --resolver lts-19.18 --package ansi-terminal,turtle,text,optparse-applicative

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

import qualified Data.Text as Text

import Data.Maybe (fromMaybe)
import Options.Applicative
import System.Console.ANSI (setTitle)
import Turtle hiding (option, switch)
import Prelude hiding (FilePath)


main :: IO ()
main = getFlags >>= startExecutor


startExecutor :: ExecutorFlags -> IO ()
startExecutor flags@ExecutorFlags{stage, apiPort, noRebuild} = do
    setTitle $ "executor:" <> show apiPort
    case stage of
        Testing -> waitUntilDbReady
        Staging -> pure ()
    echo "Starting executor"
    cd "/home/jhrcek/Devel/github.com/Holmusk/PI/backend"
    let runExecutor =
            if noRebuild
                then "AWS_PROFILE=staging-PI $(stack exec which -- executor) " <> renderFlags flags
                else "AWS_PROFILE=staging-PI stack build --fast --exec 'executor " <> renderFlags flags <> "'"
    shells runExecutor empty


data ExecutorFlags = ExecutorFlags
    { apiPort :: Int
    , prometheusPort :: Int
    , artifactFolder :: FilePath
    , stage :: Stage
    , noRebuild :: Bool
    }


data Stage = Testing | Staging deriving (Show, Read)


getFlags :: IO ExecutorFlags
getFlags =
    execParser $
        info
            (helper <*> flagsParser)
            (fullDesc <> progDesc "PI executor starter")


flagsParser :: Parser ExecutorFlags
flagsParser =
    ExecutorFlags
        <$> option
            auto
            ( long "api-port"
                <> value 8082
                <> showDefault
                <> help "Port on which executor HTTP API is exposed"
            )
        <*> option
            auto
            ( long "prometheus-port"
                <> value 8083
                <> showDefault
                <> help "Port on which executor's prometheus API is exposed"
            )
        <*> strOption
            ( long "artifact-folder"
                <> value "artifacts"
                <> showDefault
                <> help "Artifacts directory"
            )
        <*> ( fmap (fromMaybe Testing) . optional $
                flag' Testing (long "testing")
                    <|> flag' Staging (long "staging")
            )
        <*> switch
            ( long "no-rebuild"
                <> showDefault
                <> help "Skip rebuild of executor binary"
            )


renderFlags :: ExecutorFlags -> Text
renderFlags ExecutorFlags{apiPort, prometheusPort, artifactFolder, stage} =
    format
        (s % " --api-port=" % d % " --prometheus-port=" % d % " --artifact-folder=" % fp)
        stageFlag
        apiPort
        prometheusPort
        artifactFolder
  where
    stageFlag :: Text
    stageFlag = case stage of
        Staging -> "--staging"
        Testing -> "--testing"


waitUntilDbReady :: IO ()
waitUntilDbReady = do
    echo "Waiting until DB is ready"
    loop
  where
    -- executor needs to register itself in this table on startup,
    -- so don't start until that table is created
    checkExecutorInstancesTableExists =
        shellStrictWithErr
            -- Consider DB ready for executor when schema has been initialized and seedDb created a row in executor_capabilities
            "PGPASSWORD='Holmusk123!' psql \
            \--host localhost \
            \--port 5432 \
            \--dbname pi \
            \--user postgres \
            \--tuples-only \
            \--command 'SELECT COUNT(capability_id) FROM executor_capabilities'"
            empty

    loop = do
        (exitCode, stdOut, stdErr) <- checkExecutorInstancesTableExists
        case exitCode of
            ExitSuccess
                | Text.words stdOut /= ["1"] -> echo "executor_capability not initialized yet" >> sleep 1 >> loop
                | otherwise -> echo "DB is ready!"
            ExitFailure _
                | "psql: error: could not connect to server: Connection refused" `Text.isInfixOf` stdErr ->
                    echo "Postgres not started" >> sleep 1 >> loop
                | "psql: error: server closed the connection unexpectedly" `Text.isInfixOf` stdErr ->
                    echo "Postgres rejected connection" >> sleep 1 >> loop
                | "psql: error: FATAL:  the database system is starting up" `Text.isInfixOf` stdErr ->
                    echo "Postgres is starting up" >> sleep 1 >> loop
                | "ERROR:  relation \"executor_capabilities\" does not exist" `Text.isInfixOf` stdErr ->
                    echo "Schema not initialized yet" >> sleep 1 >> loop
                | otherwise -> die $ "DB readiness check ended with unexpected output: " <> stdErr

pi-frontend.hs

#!/usr/bin/env stack
-- stack script --resolver lts-19.18 --package ansi-terminal,turtle

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

import System.Console.ANSI (setTitle)
import Turtle
import Prelude hiding (FilePath)


main :: IO ()
main = do
    args <- options "PI Frontend Starter" argsParser
    setTitle "frontend"
    cd "/home/jhrcek/Devel/github.com/Holmusk/PI/frontend"
    procs
        "npm"
        ( "run" :
          "start" :
          let flags = toFlags args
           in if null flags then [] else "--" : toFlags args
        )
        empty


data Args = Args
    { debug :: Bool
    , openBrowser :: Bool
    , useStaging :: Bool
    }


toFlags :: Args -> [Text]
toFlags Args{debug, openBrowser, useStaging} =
    concat
        [ toFlag debug "--elm-debugger"
        , toFlag openBrowser "--open"
        , toFlag useStaging "--staging-api"
        ]
  where
    toFlag b flg = if b then pure flg else empty


argsParser :: Parser Args
argsParser =
    Args
        <$> switch "debug" 'd' "Enable Elm Debugger"
        <*> switch "open" 'o' "Open in Browser"
        <*> switch "staging" 's' "Use Staging API"

pi-start-everything.sh

#!/bin/bash
set -euxo pipefail

cd /home/jhrcek/Devel/github.com/Holmusk/PI/backend
stack build --fast
gnome-terminal --tab -- /bin/sh -c 'pi-db.hs --no-rebuild --migrate; exec bash'
gnome-terminal --tab -- /bin/sh -c 'pi-backend.hs --no-rebuild; exec bash'
gnome-terminal --tab -- /bin/sh -c 'pi-executor.hs --no-rebuild; exec bash'
#gnome-terminal --tab -- /bin/sh -c 'pi-executor.hs --no-rebuild --testing --api-port 8084 --prometheus-port 8085 --artifact-folder artifacts2; exec bash'
gnome-terminal --tab -- /bin/sh -c 'pi-frontend.hs --debug --open; exec bash'