Skip to content
Permalink
Browse files

WIP - make a variable for deployment name

  • Loading branch information...
shmish111 committed Jun 13, 2019
1 parent 217c232 commit 19c264e28f0c60ccbd10aadc3718fa5424592395
@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

@@ -12,47 +13,55 @@ import qualified Data.ByteString.Char8 as BS
import Data.Map as Map
import Data.Map (Map)
import Data.Text (Text)
import Data.Text as Text
import qualified Data.Text as Text
import Deploy.Server (app)
import Deploy.Worker (runWorker)
import Deploy.Worker (runWorker, SlackChannel, Deployment)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (run)
import Options.Generic (ParseRecord, getRecord)
import Options.Generic (ParseRecord, ParseField, ParseFields, getRecord)
import Servant.GitHub.Webhook (gitHubKey)
import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout)
import Web.Slack (mkSlackConfig)
import Control.Newtype.Generics (Newtype, unpack)

newtype SlackToken = SlackToken Text
deriving (Generic, Newtype)

newtype WebhookKey = WebhookKey Text
deriving (Generic, Newtype)

data Options = Options
{ port :: Int
, configDir :: FilePath
, stateFile :: FilePath
, include :: [String]
, keyfile :: FilePath
, slackChannel :: Text
, slackChannel :: SlackChannel
, deploymentName :: Deployment
} deriving (Generic, Show, ParseRecord)

data Secrets = Secrets
{ githubWebhookKey :: Text
, slackToken :: Text
{ githubWebhookKey :: WebhookKey
, slackToken :: SlackToken
}

instance FromJSON Secrets where
parseJSON =
withObject "Secrets" $ \v ->
Secrets <$> v .: "githubWebhookKey" <*> v .: "slackToken"
Secrets <$> (WebhookKey <$> v .: "githubWebhookKey") <*> (SlackToken <$> v .: "slackToken")

main :: IO ()
main = do
-- When using systemd, journald does something weird with buffering so lets force it to be line buffered
hSetBuffering stdout LineBuffering
hSetBuffering stderr LineBuffering
Options {port, configDir, stateFile, include, keyfile, slackChannel} <- getRecord "Plutus CD Server"
Options {..} <- getRecord "Plutus CD Server"
eJSON <- eitherDecodeFileStrict keyfile
case eJSON of
Left err -> putStrLn $ "failed to load keyfile with error " <> err
Right Secrets {githubWebhookKey, slackToken} -> do
Right Secrets {..} -> do
chan <- newChan
slackConfig <- mkSlackConfig slackToken
forkIO $ runWorker chan configDir stateFile include (slackConfig, slackChannel)
slackConfig <- mkSlackConfig (unpack slackToken)
forkIO $ runWorker chan configDir stateFile include slackConfig slackChannel deploymentName
putStrLn $ "start listening on port " <> show port
run port $ app chan (gitHubKey . pure . BS.pack . Text.unpack $ githubWebhookKey)
run port $ app chan (gitHubKey . pure . BS.pack . Text.unpack . unpack $ githubWebhookKey)
@@ -27,6 +27,8 @@ library
, bytestring
, github-webhooks
, mtl
, newtype-generics
, optparse-generic
, servant
, servant-github-webhook
, servant-server
@@ -51,6 +53,7 @@ executable deployment-server-exe
, bytestring
, containers
, deployment-server
, newtype-generics
, optparse-generic
, servant-github-webhook
, slack-web
@@ -1,4 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
module Deploy.Worker where

import Control.Concurrent.Chan (Chan, readChan)
@@ -8,45 +12,64 @@ import Control.Monad.Reader (runReaderT)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Char (isSpace)
import Data.Text (Text)
import qualified Data.Text as Text
import GitHub.Data.Webhooks.Events (PullRequestEvent)
import System.Exit (ExitCode (ExitFailure, ExitSuccess))
import System.IO.Temp (withSystemTempDirectory)
import System.Process.Typed (readProcess, runProcess, setEnv, setWorkingDir, shell)
import Web.Slack (SlackConfig, chatPostMessage)
import Web.Slack.Chat (mkPostMsgReq)
import Control.Newtype.Generics (Newtype, unpack)
import Options.Generic (ParseRecord, ParseField, ParseFields, getRecord)
import GHC.Generics (Generic)

runWorker :: Chan PullRequestEvent -> FilePath -> FilePath -> [String] -> (SlackConfig, Text) -> IO ()
runWorker chan configDir stateFile extraIncludes slackConfig = forever $ do
newtype SlackChannel = SlackChannel Text
deriving stock (Generic)
deriving anyclass (Newtype, ParseFields, ParseRecord, ParseField)
deriving newtype (Show)

instance Read SlackChannel where
readsPrec _ s = [(SlackChannel . Text.pack $ s, "")]

newtype Deployment = Deployment Text
deriving stock (Generic)
deriving anyclass (Newtype, ParseFields, ParseRecord, ParseField)
deriving newtype (Show)

instance Read Deployment where
readsPrec _ s = [(Deployment . Text.pack $ s, "")]

runWorker :: Chan PullRequestEvent -> FilePath -> FilePath -> [String] -> SlackConfig -> SlackChannel -> Deployment -> IO ()
runWorker chan configDir stateFile extraIncludes slackConfig slackChannel deployment = forever $ do
event <- readChan chan
deploy event configDir stateFile extraIncludes slackConfig
deploy event configDir stateFile extraIncludes slackConfig slackChannel deployment

deploy :: PullRequestEvent -> FilePath -> FilePath -> [String] -> (SlackConfig, Text) -> IO ()
deploy event configDir stateFile extraIncludes slackConfig = withSystemTempDirectory "deployment" $ \tempDir -> liftIO $ do
deploy :: PullRequestEvent -> FilePath -> FilePath -> [String] -> SlackConfig -> SlackChannel -> Deployment -> IO ()
deploy event configDir stateFile extraIncludes slackConfig slackChannel deployment = withSystemTempDirectory "deployment" $ \tempDir -> liftIO $ do
let plutusDir = tempDir <> "/plutus"
nixopsDir = plutusDir <> "/deployment/nixops"
putStrLn "Deploy origin/master"
runIn tempDir "git clone https://github.com/input-output-hk/plutus.git"
runIn plutusDir "git checkout origin/master"
(_, stdout', _) <- readIn plutusDir "git rev-parse HEAD"
let gitHead = rstrip . BS.unpack $ stdout'
deployment = "playgrounds"
extraIncludesString = unwords . fmap (\s -> "-I" <> s) $ extraIncludes
args = extraIncludesString <+> "-s" <+> stateFile <+> "-d" <+> deployment
args = extraIncludesString <+> "-s" <+> stateFile <+> "-d" <+> (Text.unpack . unpack) deployment
runIn nixopsDir $ "cp" <+> configDir <> "/*.json ."
putStrLn $ "deploy" <+> deployment
putStrLn $ "deploy" <+> (Text.unpack . unpack) deployment
runIn nixopsDir $ "nixops modify ./default.nix ./network.nix" <+> args
exitCode <- runIn nixopsDir $ "nixops deploy --exclude nixops" <+> args
putStrLn $ "finished deployment with exit code " <> show exitCode
alert slackConfig exitCode
alert slackConfig slackChannel exitCode
where
runIn dir = runProcess . setWorkingDir dir . shell
readIn dir = readProcess . setWorkingDir dir . shell
rstrip = reverse . dropWhile isSpace . reverse
a <+> b = a <> " " <> b

alert :: (SlackConfig, Text) -> ExitCode -> IO ()
alert (config, channel) exitCode = do
let msg = mkPostMsgReq channel $ case exitCode of
alert :: SlackConfig -> SlackChannel -> ExitCode -> IO ()
alert config channel exitCode = do
let msg = mkPostMsgReq (unpack channel) $ case exitCode of
ExitSuccess -> "origin/master deployed successfully"
ExitFailure i -> "failed to deploy origin/master"
result <- flip runReaderT config $ chatPostMessage msg
@@ -33,7 +33,8 @@ let
nixosLocation = "/root/.nix-defexpr/channels/nixos";
slackChannel = "plutus-notifications";
nixopsStateFile = "/root/.nixops/deployments.nixops";
options = { inherit stdOverlays machines defaultMachine plutus secrets nixpkgsLocation nixosLocation slackChannel nixopsStateFile; };
deploymentName = "playgrounds";
options = { inherit stdOverlays machines defaultMachine plutus secrets nixpkgsLocation nixosLocation slackChannel nixopsStateFile deploymentName; };
defaultMachine = (import ./default-machine.nix) options;
meadowOptions = options // { serviceConfig = meadowConfig;
serviceName = "meadow";
@@ -8,6 +8,7 @@
, slackChannel
, nixopsStateFile
, nixosLocation
, deploymentName
, ... }: node: { config, pkgs, lib, ... }:

let
@@ -200,6 +201,7 @@ in
--port 8080 \
--configDir ${configDir} \
--stateFile ${nixopsStateFile} \
--deploymentName ${deploymentName} \
--include nixos=${nixosLocation} \
--include nixpkgs=${nixpkgsLocation}
'';

0 comments on commit 19c264e

Please sign in to comment.
You can’t perform that action at this time.