module Rivet.Lib.SimpleDeploy where import Prelude hiding ((++)) import Control.Monad (void) import Control.Monad.Trans (liftIO) import Data.Configurator import Data.Configurator.Types import qualified Data.Text as T import Rivet.Common tasks :: [Task] tasks = [Task "deploy:status" 0 deployStatus "" ,Task "deploy:migrate" 0 deployMigrate "" ,Task "deploy:migrate:status" 0 deployMigrateStatus "" ,Task "deploy:migrate:down" 0 deployMigrateDown "" ,Task "deploy:rollout" 0 deployRollout "" ,Task "deploy:rollback" 1 deployRollback "SHA (short)" ,Task "deploy:stage" 1 deployStage "SHA (short)" ] deployMigrate proj conf _ = do stageHost <- liftIO $ require conf (T.pack "stage-host") prodImage <- liftIO $ require conf (T.pack "production-image") tag <- getDockerTag proj stageHost "stage" if length tag < 5 then liftIO $ putStrLn "Couldn't get tag from staging." else do let c = "docker run -w /srv -i -t -v /srv/data:/srv/data -v /var/run/postgresql/.s.PGSQL.5432:/var/run/postgresql/.s.PGSQL.5432 -v /srv/prod_" ++ tag ++ ".cfg:/srv/Rivetfile " ++ prodImage ++ ":" ++ tag ++ " rivet db:migrate prod" void $ exec $ "ssh " ++ stageHost ++ " " ++ c deployMigrateStatus proj conf _ = do stageHost <- liftIO $ require conf (T.pack "stage-host") prodImage <- liftIO $ require conf (T.pack "production-image") tag <- getDockerTag proj stageHost "stage" if length tag < 5 then liftIO $ putStrLn "Couldn't get tag from staging." else do let c = "docker run -w /srv -i -t -v /srv/data:/srv/data -v /var/run/postgresql/.s.PGSQL.5432:/var/run/postgresql/.s.PGSQL.5432 -v /srv/prod_" ++ tag ++ ".cfg:/srv/Rivetfile " ++ prodImage ++ ":" ++ tag ++ " rivet db:status prod" void $ exec $ "ssh " ++ stageHost ++ " " ++ c deployMigrateDown proj conf _ = do stageHost <- liftIO $ require conf (T.pack "stage-host") prodImage <- liftIO $ require conf (T.pack "production-image") tag <- getDockerTag proj stageHost "stage" if length tag < 5 then liftIO $ putStrLn "Couldn't get tag from staging." else do let c = "docker run -w /srv -i -t -v /srv/data:/srv/data -v /var/run/postgresql/.s.PGSQL.5432:/var/run/postgresql/.s.PGSQL.5432 -v /srv/prod_" ++ tag ++ ".cfg:/srv/Rivetfile " ++ prodImage ++ ":" ++ tag ++ " rivet db:migrate:down prod" void $ exec $ "ssh " ++ stageHost ++ " " ++ c deployStatus proj conf _ = do stageHost <- liftIO $ require conf (T.pack "stage-host") prodHost <- liftIO $ require conf (T.pack "prod-host") stageTag <- getDockerTag proj stageHost "stage" prodTag <- getDockerTag proj prodHost "prod" if length stageTag < 5 then liftIO $ putStrLn "Couldn't get staging tag." else do liftIO $ putStrLn "Staging is running..." void $ exec $ "git rev-list --format=%B --max-count=1 " ++ stageTag if length prodTag < 5 then liftIO $ putStrLn "Couldn't get production tag." else do liftIO $ putStrLn "Production is running..." void $ exec $ "git rev-list --format=%B --max-count=1 " ++ prodTag deployRollout proj conf _ = do stageHost <- liftIO $ require conf (T.pack "stage-host") prodHost <- liftIO $ require conf (T.pack "prod-host") prodImage <- liftIO $ require conf (T.pack "production-image") prodInstances <- liftIO $ lookupDefault (1 :: Int) conf (T.pack "production-instances") tag <- getDockerTag proj stageHost "stage" if length tag < 5 then liftIO $ putStrLn "Couldn't get tag from staging." else do liftIO $ putStrLn "Deploying..." exec $ "git rev-list --format=%B --max-count=1 " ++ tag void $ exec $ "ssh " ++ prodHost ++ " /srv/deploy.sh " ++ proj ++ " prod " ++ prodImage ++ " " ++ tag ++ " " ++ (show prodInstances) deployRollback proj conf (tag:_) = do prodHost <- liftIO $ require conf (T.pack "prod-host") prodImage <- liftIO $ require conf (T.pack "production-image") prodInstances <- liftIO $ lookupDefault (1 :: Int) conf (T.pack "production-instances") liftIO $ putStrLn $ "Rolling back to " ++ tag ++ "..." exec $ "git rev-list --format=%B --max-count=1 " ++ tag void $ exec $ "ssh " ++ prodHost ++ " /srv/deploy.sh " ++ proj ++ " prod " ++ prodImage ++ " " ++ tag ++ " " ++ (show prodInstances) deployStage proj conf (tag:_) = do stageHost <- liftIO $ require conf (T.pack "stage-host") prodImage <- liftIO $ require conf (T.pack "production-image") liftIO $ putStrLn $ "Deploying stage to " ++ tag ++ "..." exec $ "git rev-list --format=%B --max-count=1 " ++ tag void $ exec $ "ssh " ++ stageHost ++ " /srv/deploy.sh " ++ proj ++ " stage " ++ prodImage ++ " " ++ tag ++ " 1"