never executed always true always false

    1 module PureClaw.Handles.Shell
    2   ( -- * Process result
    3     ProcessResult (..)
    4     -- * Handle type
    5   , ShellHandle (..)
    6     -- * Implementations
    7   , mkShellHandle
    8   , mkNoOpShellHandle
    9   ) where
   10 
   11 import Data.ByteString (ByteString)
   12 import Data.ByteString.Lazy qualified as BL
   13 import Data.Text qualified as T
   14 import System.Exit
   15 import System.Process.Typed qualified as P
   16 
   17 import PureClaw.Handles.Log
   18 import PureClaw.Security.Command
   19 
   20 -- | Result of a subprocess execution.
   21 data ProcessResult = ProcessResult
   22   { _pr_exitCode :: ExitCode
   23   , _pr_stdout   :: ByteString
   24   , _pr_stderr   :: ByteString
   25   }
   26   deriving stock (Show, Eq)
   27 
   28 -- | Subprocess execution capability. Only accepts 'AuthorizedCommand',
   29 -- which is proof that the command passed security policy evaluation.
   30 --
   31 -- The real implementation strips the subprocess environment to prevent
   32 -- secret leakage via inherited environment variables.
   33 newtype ShellHandle = ShellHandle
   34   { _sh_execute :: AuthorizedCommand -> IO ProcessResult
   35   }
   36 
   37 -- | Minimal safe environment for subprocesses. Provides only PATH so
   38 -- commands can be resolved, but inherits nothing else from the parent.
   39 safeEnv :: [(String, String)]
   40 safeEnv = [("PATH", "/usr/bin:/bin:/usr/local/bin")]
   41 
   42 -- | Real shell handle using @typed-process@. Strips the subprocess
   43 -- environment (provides only a minimal PATH) as noted in the architecture.
   44 mkShellHandle :: LogHandle -> ShellHandle
   45 mkShellHandle logger = ShellHandle
   46   { _sh_execute = \cmd -> do
   47       let prog = getCommandProgram cmd
   48           args = map T.unpack (getCommandArgs cmd)
   49           config = P.setEnv safeEnv
   50                  $ P.proc prog args
   51       _lh_logInfo logger $ "Executing: " <> T.pack prog <> " " <> T.unwords (getCommandArgs cmd)
   52       (exitCode, outLazy, errLazy) <- P.readProcess config
   53       pure ProcessResult
   54         { _pr_exitCode = exitCode
   55         , _pr_stdout   = BL.toStrict outLazy
   56         , _pr_stderr   = BL.toStrict errLazy
   57         }
   58   }
   59 
   60 -- | No-op shell handle. Returns success with empty output.
   61 mkNoOpShellHandle :: ShellHandle
   62 mkNoOpShellHandle = ShellHandle
   63   { _sh_execute = \_ -> pure ProcessResult
   64       { _pr_exitCode = ExitSuccess
   65       , _pr_stdout   = ""
   66       , _pr_stderr   = ""
   67       }
   68   }