mdunnio · Feb 15, 2018 · Mar 11, 2018 · Mar 11, 2018 · Mar 11, 2018 · Mar 11, 2018
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -0,0 +1,84 @@
+name: CI
+
+on:
+  pull_request:
+  push:
+    branches: [master]
+
+jobs:
+  cabal:
+    name: cabal / ghc-${{ matrix.ghc }} / ${{ matrix.os }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os:
+          - ubuntu-latest
+          # - macOS-latest
+        cabal:
+          - "latest"
+        ghc:
+          - "9.2.8"
+          - "9.4.8"
+          - "9.6.3"
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: haskell-actions/setup@v2
+        id: setup-haskell-cabal
+        name: Setup Haskell
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: ${{ matrix.cabal }}
+
+      - uses: actions/cache@v3
+        name: Cache cabal-store
+        with:
+          path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+          key: ${{ matrix.os }}-${{ matrix.ghc }}-cabal
+
+      - name: Build
+        run: |
+          cabal update
+          cabal build all --enable-tests --enable-benchmarks --write-ghc-environment-files=always
+
+      # TODO: Tests require the `vault` executable to be available.
+      # - name: Test
+      #   run: |
+      #     cabal test all --enable-tests --enable-benchmarks --write-ghc-environment-files=always
+
+  stack:
+    name: stack ${{ matrix.resolver }} / ${{ matrix.os }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os:
+          - ubuntu-latest
+          # - macOS-latest
+        stack: ["latest"]
+        resolver:
+          - "--stack-yaml ./stack.yaml"
+
+    steps:
+    - uses: actions/checkout@v4
+
+    - uses: haskell-actions/setup@v2
+      name: Setup Haskell Stack
+      with:
+        stack-version: ${{ matrix.stack }}
+        enable-stack: true
+
+    - uses: actions/cache@v3
+      name: Cache ~/.stack
+      with:
+        path: ~/.stack
+        key: ${{ matrix.os }}-stack-${{ matrix.resolver }}
+
+    - name: Build
+      run: |
+        stack build --test --bench --no-run-tests --no-run-benchmarks
+
+    # TODO: Tests require the `vault` executable to be available.
+    # - name: Test
+    #   run: |
+    #     stack test --bench --no-run-benchmarks
diff --git a/.gitignore b/.gitignore
@@ -1,2 +1,3 @@
 dist-newstyle/
 dist/
+.stack-work/
diff --git a/.hgignore b/.hgignore
@@ -0,0 +1,2 @@
+syntax: regexp
+\.stack-work/
diff --git a/stack.yaml b/stack.yaml
@@ -0,0 +1,6 @@
+resolver: lts-23.3
+flags: {}
+packages:
+  - vault-tool
+  - vault-tool-server
+extra-deps: []
diff --git a/stack.yaml.lock b/stack.yaml.lock
@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+    sha256: dd89d2322cb5af74c6ab9d96c0c5f6c8e6653e0c991d619b4bb141a49cb98668
+    size: 679282
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/3.yaml
+  original: lts-23.3
diff --git a/vault-tool-server/src/Network/VaultTool/VaultServerProcess.hs b/vault-tool-server/src/Network/VaultTool/VaultServerProcess.hs
@@ -19,23 +19,43 @@ module Network.VaultTool.VaultServerProcess
     ) where
 
 import Control.Concurrent (threadDelay)
-import Control.Concurrent.Async
+import Control.Concurrent.Async (waitAnyCancel, withAsync)
 import Control.Exception (Exception, IOException, catches, Handler(Handler), bracket, bracketOnError, throwIO, try)
 import Control.Monad (forever)
-import Data.Aeson
+import Data.Aeson (ToJSON, Value, (.=), eitherDecode', encode, object, toJSON)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Network.HTTP.Client (HttpException)
 import System.Exit (ExitCode)
 import System.FilePath ((</>))
 import System.IO (Handle, hClose)
-import System.IO.Temp
-import System.Process
+import System.IO.Temp (withSystemTempDirectory)
+import System.Process (
+    ProcessHandle,
+    StdStream (..),
+    close_fds,
+    createProcess,
+    env,
+    getProcessExitCode,
+    proc,
+    std_err,
+    std_in,
+    std_out,
+    terminateProcess,
+    waitForProcess,
+ )
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
-import Network.VaultTool
+import Network.VaultTool (
+    VaultAddress (..),
+    VaultException,
+    VaultUnsealKey (..),
+    unauthenticatedVaultConnection,
+    vaultHealth,
+    defaultManager,
+ )
 
 -- | The ""backend"" section of the Vault server configuration.
 --
@@ -101,8 +121,7 @@ readVaultBackendConfig file = do
 -- | File should have one line per key (blank lines are ignored)
 readVaultUnsealKeys :: FilePath -> IO [VaultUnsealKey]
 readVaultUnsealKeys file =
-    T.readFile file >>=
-        (pure . map VaultUnsealKey . (filter (not . T.null)) . map T.strip . T.lines)
+    map VaultUnsealKey . filter (not . T.null) . map T.strip . T.lines <$> T.readFile file
 
 withVaultConfigFile :: VaultConfig -> (FilePath -> IO a) -> IO a
 withVaultConfigFile vaultConfig action = do
@@ -119,18 +138,18 @@ data VaultServerProcess = VaultServerProcess
     }
 
 data VaultServerLaunchException
-    = VaultServerLaunchException_VaultStartTimeout
-    | VaultServerLaunchException_ConnectTimeout
-    | VaultServerLaunchException_ExecFailure IOException
-    | VaultServerLaunchException_ProcessFailure ExitCode Text
+    = VaultStartTimeout
+    | ConnectTimeout
+    | ExecFailure IOException
+    | ProcessFailure ExitCode Text
     deriving (Show, Eq)
 
 instance Exception VaultServerLaunchException
 
 withVaultServerProcess :: Maybe FilePath -> FilePath -> VaultAddress -> IO a -> IO a
 withVaultServerProcess mbVaultExe vaultConfigFile addr act = do
     bracket (launchVaultServerProcess mbVaultExe vaultConfigFile addr)
-        (shutdownVaultServerProcess)
+        shutdownVaultServerProcess
         (const act)
 
 launchVaultServerProcess :: Maybe FilePath -> FilePath -> VaultAddress -> IO VaultServerProcess
@@ -147,19 +166,19 @@ launchVaultServerProcess mbVaultExe vaultConfigFile addr = do
     vaultExe = fromMaybe "vault" mbVaultExe
     waitUntilRunningThread stdoutH = do
         withAsync (waitUntilVaultStarted stdoutH) $ \startA -> do
-            withAsync (timeout vaultStartTimeoutMilliseconds VaultServerLaunchException_VaultStartTimeout) $ \timeoutA -> do
+            withAsync (timeout vaultStartTimeoutMilliseconds VaultStartTimeout) $ \timeoutA -> do
                 _ <- waitAnyCancel [startA, timeoutA]
                 pure ()
         withAsync waitUntilVaultConnect $ \connectA -> do
-            withAsync (timeout vaultConnectTimeoutMilliseconds VaultServerLaunchException_ConnectTimeout) $ \timeoutA -> do
+            withAsync (timeout vaultConnectTimeoutMilliseconds ConnectTimeout) $ \timeoutA -> do
                 _ <- waitAnyCancel [connectA, timeoutA]
                 pure ()
     checkProcessFailureThread vs = do
         mbExitCode <- getProcessExitCode (vs_processHandle vs)
         case mbExitCode of
             Just exitCode -> do
                 stderrText <- T.hGetContents (vs_stderrH vs)
-                throwIO $ VaultServerLaunchException_ProcessFailure exitCode stderrText
+                throwIO $ ProcessFailure exitCode stderrText
             Nothing -> do
                 threadDelay (checkExitedSnoozeMilliseconds * 1000)
                 checkProcessFailureThread vs
@@ -200,7 +219,7 @@ execProcess vaultExe vaultConfigFile = do
                                             , close_fds = True
                                             }
     case tryResult of
-        Left ex -> throwIO $ VaultServerLaunchException_ExecFailure ex
+        Left ex -> throwIO $ ExecFailure ex
         Right (Just stdinH, Just stdoutH, Just stderrH, processHandle) ->
             pure VaultServerProcess
                 { vs_processHandle = processHandle
@@ -221,7 +240,8 @@ shutdownVaultServerProcess vs = do
 
 vaultIsRunning :: VaultAddress -> IO Bool
 vaultIsRunning addr = do
-    (vaultHealth addr >> pure True) `catches`
+    conn <- flip unauthenticatedVaultConnection addr <$> defaultManager
+    (True <$ vaultHealth conn) `catches`
         [ Handler $ \(_ :: HttpException) -> pure False
         , Handler $ \(_ :: VaultException) -> pure False
         ]