{-# LANGUAGE NoImplicitPrelude   #-}

-- | The module of this name differs as between Windows and non-Windows builds.

-- This is the Windows version.

module Stack.Docker.Handlers
  ( handleSetGroups
  , handleSignals
  ) where

import           RIO.Process
                   ( ExitCodeException, proc , runProcess_, setDelegateCtlc )
import           Stack.Types.Config ( HasConfig )
import           Stack.Types.Docker ( DockerOpts (..))
import           Stack.Prelude
import           System.PosixCompat.Types ( GroupID )

handleSetGroups :: [GroupID] -> IO ()
handleSetGroups :: [GroupID] -> IO ()
handleSetGroups [GroupID]
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

handleSignals ::
     (Exception e, HasConfig env)
  => DockerOpts
  -> Bool
  -> String
  -> RIO env (Either e ())
handleSignals :: forall e env.
(Exception e, HasConfig env) =>
DockerOpts -> Bool -> String -> RIO env (Either e ())
handleSignals DockerOpts
docker Bool
keepStdinOpen String
containerID = do
  let args' :: [String]
args' = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [String
"start"]
        , [String
"-a" | Bool -> Bool
not (DockerOpts -> Bool
dockerDetach DockerOpts
docker)]
        , [String
"-i" | Bool
keepStdinOpen]
        , [String
containerID]
        ]
  RIO env (Either e ()) -> RIO env () -> RIO env (Either e ())
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally
    (RIO env () -> RIO env (Either e ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (RIO env () -> RIO env (Either e ()))
-> RIO env () -> RIO env (Either e ())
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> (ProcessConfig () () () -> RIO env ()) -> RIO env ()
forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
 MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
"docker" [String]
args' ((ProcessConfig () () () -> RIO env ()) -> RIO env ())
-> (ProcessConfig () () () -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> RIO env ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ (ProcessConfig () () () -> RIO env ())
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
Bool
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setDelegateCtlc Bool
False)
    ( Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DockerOpts -> Bool
dockerPersist DockerOpts
docker Bool -> Bool -> Bool
|| DockerOpts -> Bool
dockerDetach DockerOpts
docker) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
        String -> [String] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
String -> [String] -> RIO env ()
readProcessNull String
"docker" [String
"rm", String
"-f", String
containerID]
          RIO env () -> (ExitCodeException -> RIO env ()) -> RIO env ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(ExitCodeException
_ :: ExitCodeException) -> () -> RIO env ()
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    )