module Hydra.Network.EtcdBinarySpec where

import Hydra.Prelude

import Data.ByteString.Lazy.Char8 qualified as LBS
import Hydra.Network (WhichEtcd (EmbeddedEtcd))
import Hydra.Network.EtcdBinary (getEtcdBinary)
import System.FilePath ((</>))
import System.Process.Typed (proc, readProcessStdout_, runProcess_)
import Test.Hydra.Prelude

spec :: Spec
spec :: Spec
spec =
  [Char] -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"installs and runs embedded etcd from a path containing spaces, including after restart" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$
    NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
30 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> ([Char] -> IO ()) -> IO ()
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> m r) -> m r
withTempDir [Char]
"embedded-etcd" (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
tmp ->
        -- Another process must not inherit the installer's write handle: on
        -- Linux that prevents executing etcd with "Text file busy".
        ([Char], IO Any) -> (Async IO Any -> IO ()) -> IO ()
forall (m :: * -> *) a b.
MonadAsync m =>
([Char], m a) -> (Async m a -> m b) -> m b
withAsyncLabelled ([Char]
"unrelated-child", IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (ProcessConfig () () () -> IO ())
-> ProcessConfig () () () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> ProcessConfig () () ()
proc [Char]
"sleep" [[Char]
"0.05"]) ((Async IO Any -> IO ()) -> IO ())
-> (Async IO Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async IO Any
_ -> do
          let persistenceDir :: [Char]
persistenceDir = [Char]
tmp [Char] -> [Char] -> [Char]
</> [Char]
"node state with spaces"
              checkExecutable :: IO ()
checkExecutable = do
                [Char]
executable <- [Char] -> WhichEtcd -> IO [Char]
getEtcdBinary [Char]
persistenceDir WhichEtcd
EmbeddedEtcd
                ByteString
output <- ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (ProcessConfig () () () -> IO ByteString)
-> ProcessConfig () () () -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> ProcessConfig () () ()
proc [Char]
executable [[Char]
"--version"]
                ByteString -> [Char]
LBS.unpack ByteString
output [Char] -> [Char] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldContain` [Char]
"etcd Version:"
          Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
50 IO ()
checkExecutable