module Matterhorn.Scripts
  ( findAndRunScript
  , listScripts
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Control.Concurrent ( takeMVar, newEmptyMVar )
import qualified Control.Concurrent.STM as STM
import qualified Data.Text as T
import           System.Exit ( ExitCode(..) )

import           Network.Mattermost.Types ( ChannelId )

import           Matterhorn.FilePaths ( Script(..), getAllScripts, locateScriptPath )
import           Matterhorn.State.Common
import           Matterhorn.State.Messages ( sendMessage )
import           Matterhorn.Types


findAndRunScript :: ChannelId -> Text -> Text -> MH ()
findAndRunScript :: ChannelId -> Text -> Text -> MH ()
findAndRunScript ChannelId
cId Text
scriptName Text
input = do
    Script
fpMb <- IO Script -> MH Script
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Script -> MH Script) -> IO Script -> MH Script
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Script
locateScriptPath (Text -> FilePath
T.unpack Text
scriptName)
    TChan ProgramOutput
outputChan <- Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
-> MH (TChan ProgramOutput)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (TChan ProgramOutput) ChatResources)
 -> ChatState -> Const (TChan ProgramOutput) ChatState)
-> ((TChan ProgramOutput
     -> Const (TChan ProgramOutput) (TChan ProgramOutput))
    -> ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TChan ProgramOutput
 -> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources
Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
    case Script
fpMb of
      ScriptPath FilePath
scriptPath -> do
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId
-> TChan ProgramOutput -> FilePath -> Text -> IO (Maybe (MH ()))
runScript ChannelId
cId TChan ProgramOutput
outputChan FilePath
scriptPath Text
input
      NonexecScriptPath FilePath
scriptPath -> do
        let msg :: Text
msg = (Text
"The script `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` cannot be " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"executed. Try running\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"$ chmod u+x " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"to correct this error. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scriptHelpAddendum)
        MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
msg
      Script
ScriptNotFound -> do
        MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchScript Text
scriptName

runScript :: ChannelId -> STM.TChan ProgramOutput -> FilePath -> Text -> IO (Maybe (MH ()))
runScript :: ChannelId
-> TChan ProgramOutput -> FilePath -> Text -> IO (Maybe (MH ()))
runScript ChannelId
cId TChan ProgramOutput
outputChan FilePath
fp Text
text = do
  MVar ProgramOutput
outputVar <- IO (MVar ProgramOutput)
forall a. IO (MVar a)
newEmptyMVar
  TChan ProgramOutput
-> FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan FilePath
fp [] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
text) (MVar ProgramOutput -> Maybe (MVar ProgramOutput)
forall a. a -> Maybe a
Just MVar ProgramOutput
outputVar)
  ProgramOutput
po <- MVar ProgramOutput -> IO ProgramOutput
forall a. MVar a -> IO a
takeMVar MVar ProgramOutput
outputVar
  Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ case ProgramOutput -> ExitCode
programExitCode ProgramOutput
po of
    ExitCode
ExitSuccess -> do
        case FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ ProgramOutput -> FilePath
programStderr ProgramOutput
po of
            Bool
True -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
                    EditMode
mode <- case ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
                        Maybe TeamId
Nothing -> Getting EditMode ChatState EditMode -> MH EditMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const EditMode TeamState)
-> ChatState -> Const EditMode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode)
                        Just TeamId
tId -> Getting EditMode ChatState EditMode -> MH EditMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode)
                    ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage ChannelId
cId EditMode
mode (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ProgramOutput -> FilePath
programStdout ProgramOutput
po) []
            Bool
False -> Maybe (MH ())
forall a. Maybe a
Nothing
    ExitFailure Int
_ -> Maybe (MH ())
forall a. Maybe a
Nothing

listScripts :: MH ()
listScripts :: MH ()
listScripts = do
  ([FilePath]
execs, [FilePath]
nonexecs) <- IO ([FilePath], [FilePath]) -> MH ([FilePath], [FilePath])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ([FilePath], [FilePath])
getAllScripts
  let scripts :: Text
scripts = (Text
"Available scripts are:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                 [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                         | FilePath
cmd <- [FilePath]
execs
                         ])
  Text -> MH ()
postInfoMessage Text
scripts
  case [FilePath]
nonexecs of
    [] -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [FilePath]
_  -> do
      let errMsg :: Text
errMsg = (Text
"Some non-executable script files are also " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"present. If you want to run these as scripts " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"in Matterhorn, mark them executable with \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"$ chmod u+x [script path]\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"```\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                            | FilePath
cmd <- [FilePath]
nonexecs
                            ] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scriptHelpAddendum)
      MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
errMsg

scriptHelpAddendum :: Text
scriptHelpAddendum :: Text
scriptHelpAddendum =
  Text
"For more help with scripts, run the command\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  Text
"```\n/help scripts\n```\n"