Skip to content
Permalink
Browse files

WIP - some more CD updates

  • Loading branch information...
shmish111 committed Jun 12, 2019
1 parent 6cce7fe commit ff1ca443f35480a75f85737080c6ffaeda4c068f
@@ -6,20 +6,39 @@ module Main where

import Control.Concurrent (forkIO)
import Control.Concurrent.Chan (newChan)
import Data.Aeson (eitherDecodeFileStrict)
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 Deploy.Server (app)
import Deploy.Worker (runWorker)
import GHC.Generics (Generic)
import Network.Wai.Handler.Warp (run)
import Options.Generic (ParseRecord, getRecord)
import Servant.GitHub.Webhook (gitHubKey)

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

main :: IO ()
main = do
Options { port, configDir } <- getRecord "Plutus CD Server"
chan <- newChan
forkIO $ runWorker chan configDir
run port $ app chan (gitHubKey . pure $ "key")
Options { port, configDir, stateFile, include, keyfile } <- getRecord "Plutus CD Server"
eJSON <- eitherDecodeFileStrict keyfile :: IO (Either String (Map String Text))
case eJSON of
Left err -> putStrLn $ "failed to load keyfile with error " <> err
Right object -> case Map.lookup "githubWebhookKey" object of
Nothing -> putStrLn $ "failed to find githubWebhookKey in " <> keyfile
Just key -> do
chan <- newChan
forkIO $ runWorker chan configDir stateFile include
putStrLn $ "start listening on port " <> show port
run port $ app chan (gitHubKey . pure . BS.pack . Text.unpack $ key)

@@ -25,13 +25,13 @@ library
build-depends:
base
, bytestring
, servant-github-webhook
, github-webhooks
, servant
, servant-github-webhook
, servant-server
, github-webhooks
, wai
, typed-process
, temporary
, typed-process
, wai
default-language: Haskell2010
ghc-options: -fprint-potential-instances

@@ -44,10 +44,14 @@ executable deployment-server-exe
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.7 && <5
, aeson
, bytestring
, containers
, deployment-server
, optparse-generic
, servant-github-webhook
, text
, warp
, optparse-generic
default-language: Haskell2010

test-suite deployment-server-test
@@ -2,29 +2,39 @@
module Deploy.Worker where

import Control.Concurrent.Chan (Chan, readChan)
import Control.Monad (forever)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Char (isSpace)
import GitHub.Data.Webhooks.Events (PullRequestEvent)
import System.IO.Temp (withSystemTempDirectory)
import System.Process.Typed (runProcess, setWorkingDir, shell, readProcess)
import qualified Data.ByteString.Lazy.Char8 as BS
import System.Process.Typed (readProcess, runProcess, setEnv, setWorkingDir, shell)

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

deploy :: PullRequestEvent -> FilePath -> IO ()
deploy event configDir = withSystemTempDirectory "deployment" $ \tempDir -> liftIO $ do
deploy :: PullRequestEvent -> FilePath -> FilePath -> [String] -> IO ()
deploy event configDir stateFile extraIncludes = 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, _) <- readProcess . setWorkingDir plutusDir $ "git rev-parse HEAD"
runIn nixopsDir $ shell $ "cp " <> configDir <> "/*.json ."
runIn nixopsDir $ shell $ "nixops create ./default.nix ./network.nix -d " <> BS.unpack stdout
runIn nixopsDir $ shell $ "nixops deploy -d " <> BS.unpack stdout
(_, 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
runIn nixopsDir $ "cp" <+> configDir <> "/*.json ."
putStrLn $ "deploy" <+> deployment
runIn nixopsDir $ "nixops modify ./default.nix ./network.nix" <+> args
runIn nixopsDir $ "nixops deploy --exclude nixops" <+> args
pure ()
where
runIn dir = runProcess . setWorkingDir dir
runIn dir = runProcess . setWorkingDir dir . shell
readIn dir = readProcess . setWorkingDir dir . shell
rstrip = reverse . dropWhile isSpace . reverse
a <+> b = a <> " " <> b

@@ -183,8 +183,8 @@ in

systemd.services.githubhooks = {
enable = true;
path = ["${githubhooks}"];
script = "deployment-server-exe --port 8080 --configDir ${configDir}";
path = ["${githubhooks}" pkgs.git pkgs.nixops pkgs.nix pkgs.gnutar pkgs.gzip ];
script = "deployment-server-exe --keyfile ${configDir}/secrets.json --port 8080 --configDir ${configDir} --stateFile /root/.nixops/deployments.nixops --include nixos=/root/.nix-defexpr/channels/nixos --include nixpkgs=https://github.com/shmish111/nixpkgs/archive/c73222f0ef9ba859f72e5ea2fb16e3f0e0242492.tar.gz";
};
};
}

0 comments on commit ff1ca44

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