Executing privileged Shell commands from Haskell programs with sudo. (Caveat: Change sudo password remember time for security)

Shell.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import System.Exit
import System.IO
import Control.Exception (bracket_)
import System.Process (readProcessWithExitCode)
import Control.Monad.Error (MonadError, ErrorT, runErrorT, throwError, lift)
import Control.Monad.IO.Class

newtype Shell a = Shell { runShell :: ErrorT String IO a }
                deriving (Functor, Monad, MonadError String, MonadIO)

newtype Priv a = Priv { priv :: Shell a }
                deriving (Functor, Monad, MonadError String, MonadIO)

runsh :: String -> String -> Shell String
runsh xs pwd = do
   let (cmd:args) = words xs
   (exit, out, err) <- liftIO $ readProcessWithExitCode cmd args pwd
   if exit == ExitSuccess
   then return out
   else throwError err

sh :: String -> Shell String
sh s = runsh s ""

unsh :: Shell a -> IO a
unsh s = do
  eith <- runErrorT . runShell $ s
  case eith of
    Left err -> error $ "error: " ++ err
    Right a -> return a

shPriv :: String -> Priv String
shPriv s = Priv $ do
  liftIO $ putStrLn "[sudo] password: "
  pwd <- liftIO getPassword
  runsh ("sudo -S " ++ s) (pwd ++ "\n")

getPassword :: IO String
getPassword = do
  putStr "Password: "
  hFlush stdout
  pass <- withEcho False getLine
  putChar '\n'
  return pass

withEcho :: Bool -> IO a -> IO a
withEcho echo action = do
  old <- hGetEcho stdin
  bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action