{-|
Module      : OnRmt
Description : Parallel remote SSH execution library
Copyright   : (c) Kevin Quick, 2016, 2017
License     : BSD-3
Maintainer  : quick@sparq.org
Stability   : stable
Portability : POSIX

The OnRmt library provides functionality for a tool that can be used
to perform operations via SSH to multiple remote machines in parallel
and report the results.  Multiple operations can be performed in
succession.  OnRmt can be likened to an interactive version of Fabric,
written in Haskell.

The UI is extensible and OnRmt comes with a command-line
representation (CLI) and a text user interface (TUI) based on
itemfield, brick, and vty.

OnRmt is provided as a library but is fully complete and lacks only an
invocation from a main function with the set of known remote SSH
nodes.

-}

module Network.OnRmt
       (
         -- * Exports from Concurrent.Worker
         WorkEntry(..), WorkGroup(..), WorkItems(..), WorkMsg(..)
       , WorkControls(..), StateCmd(..), DispBlk(..),
         WorkId, WorkState(..)
         -- * Main Parameters and entrypoint
       , OnRmtParams(..), onRmt
       ) where


import           Concurrent.Worker (worker, StateCmd(..), WorkMsg(..)
                                   , WorkGroup(..), WorkControls(..)
                                   , WorkEntry(..), WorkItems(..)
                                   , WorkId, WorkState(..), DispBlk(..))
import           Control.Concurrent
import qualified Data.Text as T
import           Network.OnRmt.UI


-- | The OnRmtParams data structure specifies the operational
-- parameters for running OnRmt.  These fields can be adjusted by the
-- client as desired.
data OnRmtParams = OnRmtParams
    {
      appName     :: T.Text -- ^ The declared name (and version) of
                            -- this app for the banner line
    , maxParallel :: Int    -- ^ Number of remotes to run in parallel
                            -- at any one time
    , directSSH   :: Bool   -- ^ ssh directly to target instead of
                            -- bouncing via localhost.  The localhost
                            -- bounce is useful for capturing and
                            -- responding to ssh key passphrases and
                            -- passwords, but in general it imposes a
                            -- lower limit on the maxParallel setting.
    }


-- | The onRmt function is the main entry point.  It creates the
-- vty-ui interface and provides the main operational loop for user
-- interaction and remote operations.
onRmt :: (WorkGroup a, OnRmtUI ui uistate, Show uistate)
         =>  IO a -> OnRmtParams -> ui -> (StateCmd -> IO ()) -> uistate -> IO uistate
onRmt getentries params ui stateGen s =
    do workRequestChan <- newChan
       entries <- getentries
       forkIO $ worker stateGen workRequestChan workCfg entries
       result <- runUI ui (writeChan workRequestChan) s
       putStr "Final status: "
       return result
    where workCfg = WorkControls { numParallel = maxParallel params
                                 , useDirectSSH = directSSH params
                                 , queryResponses = []
                                 }