{-# LANGUAGE OverloadedRecordDot #-}

module Cloudy.Cmd.Ssh where

import Cloudy.Cli (SshCliOpts (..))
import Cloudy.Cmd.Utils (SelectInstBy, findInstanceInfoForSelectInstBy, mkSelectInstBy)
import Cloudy.LocalConfFile (LocalConfFileOpts (..))
import Cloudy.Db (withCloudyDb, InstanceInfo (..), ScalewayInstance (..))
import Data.Text (unpack, Text)
import Data.Void (absurd)
import System.Posix.Process (executeFile)

data SshSettings = SshSettings
  { SshSettings -> SelectInstBy
selectInstBy :: SelectInstBy
  , SshSettings -> [Text]
sshPassthruArgs :: [Text]
  }
  deriving stock Int -> SshSettings -> ShowS
[SshSettings] -> ShowS
SshSettings -> String
(Int -> SshSettings -> ShowS)
-> (SshSettings -> String)
-> ([SshSettings] -> ShowS)
-> Show SshSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SshSettings -> ShowS
showsPrec :: Int -> SshSettings -> ShowS
$cshow :: SshSettings -> String
show :: SshSettings -> String
$cshowList :: [SshSettings] -> ShowS
showList :: [SshSettings] -> ShowS
Show

mkSettings :: LocalConfFileOpts -> SshCliOpts -> IO SshSettings
mkSettings :: LocalConfFileOpts -> SshCliOpts -> IO SshSettings
mkSettings LocalConfFileOpts
_localConfFileOpts SshCliOpts
cliOpts = do
  SelectInstBy
selectInstBy <- Maybe CloudyInstanceId -> Maybe Text -> IO SelectInstBy
mkSelectInstBy SshCliOpts
cliOpts.id SshCliOpts
cliOpts.name
  SshSettings -> IO SshSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SshSettings { SelectInstBy
$sel:selectInstBy:SshSettings :: SelectInstBy
selectInstBy :: SelectInstBy
selectInstBy, $sel:sshPassthruArgs:SshSettings :: [Text]
sshPassthruArgs = SshCliOpts
cliOpts.passthru }

runSsh :: LocalConfFileOpts -> SshCliOpts -> IO ()
runSsh :: LocalConfFileOpts -> SshCliOpts -> IO ()
runSsh LocalConfFileOpts
localConfFileOpts SshCliOpts
cliOpts = do
  SshSettings
settings <- LocalConfFileOpts -> SshCliOpts -> IO SshSettings
mkSettings LocalConfFileOpts
localConfFileOpts SshCliOpts
cliOpts
  Text
ipAddr <- (Connection -> IO Text) -> IO Text
forall a. (Connection -> IO a) -> IO a
withCloudyDb ((Connection -> IO Text) -> IO Text)
-> (Connection -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
    InstanceInfo
instanceInfo <- Connection -> SelectInstBy -> IO InstanceInfo
findInstanceInfoForSelectInstBy Connection
conn SshSettings
settings.selectInstBy
    case InstanceInfo
instanceInfo of
      CloudyAwsInstance CloudyInstance
_cloudyInstance Void
void -> Void -> IO Text
forall a. Void -> a
absurd Void
void
      CloudyScalewayInstance CloudyInstance
_cloudyInstance ScalewayInstance
scalewayInstance -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalewayInstance
scalewayInstance.scalewayIpAddress
  let sshArgs :: [String]
sshArgs = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text
"root@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ipAddr Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: SshSettings
settings.sshPassthruArgs
  String -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
"ssh" Bool
True [String]
sshArgs Maybe [(String, String)]
forall a. Maybe a
Nothing