Lib.hs

module Lib (
  Service (..),
  Remote (..),
  makeTunnel,
  killTunnel,
  portFromPsOutput
) where

import GHC.IO.Exception
import Data.Maybe
import Control.Monad
import System.Process
import Data.List.Split

data Service = Service {
  name :: String,
  port :: Integer
} deriving (Eq, Show, Read)

data Remote = Remote {
  alias :: String,
  host :: String
} deriving (Eq, Show, Read)

-- Makes the tunnel for a service. Fails if a tunnel already exists.
makeTunnel :: Service -> Remote -> IO ()
makeTunnel service remote =
  let portStr = show (port service)
      hostPort = portStr ++ ":localhost:" ++ portStr
  -- Establish SSH tunnel in background
  in void $ spawnProcess "ssh" ["-NL", hostPort, host remote]


-- Kills the tunnel for a service if it exists.
killTunnel :: Service -> IO ()
killTunnel service = do
    pid <- fetchPid service
    _ <- putStrLn $ show pid
    case pid of
      Nothing -> return ()
      Just p -> killPid p

killPid :: String -> IO ()
killPid pid = void $ readProcess "kill" ["-9", pid] []

portFromPsOutput :: String -> Maybe String
portFromPsOutput out = do
  -- Find the line containing our pid
  line <- listToMaybe $ tail $ splitOn "\n" out
  -- Remove empty parts of line
  let lineParts = filter (\str -> (length str) /= 0) (splitOneOf " \t" line)
  listToMaybe $ tail $ lineParts

fetchPid :: Service -> IO (Maybe String)
fetchPid service = do
  (code, output, _) <-
    readProcessWithExitCode "lsof" ["-wni", "tcp:" ++ (show $ port service)] []
  return $ if (code == ExitSuccess) then
    portFromPsOutput output
  else
    Nothing