Merge pull request #1 from viking66/refactor

Refactor to allow for different secret engines

stack.yaml

@@ -18,7 +18,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-11.19
+resolver: lts-18.10
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -63,4 +63,4 @@ packages:
 # extra-lib-dirs: [/path/to/dir]
 #
 # Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
+# compiler-check: newer-minor

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
@@ -130,7 +149,7 @@ 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
@@ -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
         ]