<commit_before>{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- Module      : Khan.Model.SSH
-- Copyright   : (c) 2013-2014 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Khan.Model.SSH
     ( Mode (..)
     , execSCP
     , execSSH
     , wait
     ) where

import qualified Data.Text                 as Text
import qualified Filesystem.Path.CurrentOS as Path
import           Khan.Internal
import           Khan.Prelude
import           System.Process            (callCommand)

data Mode
    = Upload   !FilePath !FilePath
    | Download !FilePath !FilePath
      deriving (Show)

execSCP :: MonadIO m => Mode -> Text -> Text -> FilePath -> [String] -> m ()
execSCP mode addr user key xs = exec "scp" (as ++ xs)
  where
    as = map Text.unpack $ ident : case mode of
        Upload   s d -> [toTextIgnore s, remote d]
        Download s d -> [remote s, toTextIgnore d]

    remote = mappend (user <> "@" <> addr <> ":") . toTextIgnore
    ident  = "-i" <> toTextIgnore key

execSSH :: MonadIO m
        => Text
        -> Text
        -> FilePath
        -> [String]
        -> m ()
execSSH addr user key xs = exec "ssh" (args addr user key xs)

wait :: MonadIO m => Int -> Text -> Text -> FilePath -> m Bool
wait s addr user key = do
    say "Waiting {} seconds for SSH connectivity on {}"
        [show s, Text.unpack addr]
    liftIO (go s)
  where
    delay = 20

    go n | n <= 0    = return False
         | otherwise = do
             say "Waiting {} seconds..." [delay]
             delaySeconds delay
             e <- runEitherT . sync $ exec "ssh" xs
             either (const . go $ n - delay)
                    (return . const True)
                    e

    xs = args addr user key
        [ "-q"
        , "-o"
        , "BatchMode=yes"
        , "-o"
        , "StrictHostKeyChecking=no"
        ]

exec :: MonadIO m => String -> [String] -> m ()
exec run xs =
    let cmd = unwords (run : xs)
     in log "{}" [cmd] >> liftIO (callCommand cmd)

args :: Text -> Text -> FilePath -> [String] -> [String]
args addr user key = mappend
    [ "-i" <> Path.encodeString key
    , Text.unpack $ user <> "@" <> addr
    ]<commit_msg>Make sure SSH.wait quits the ssh session once connection is established.<commit_after>{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- Module      : Khan.Model.SSH
-- Copyright   : (c) 2013-2014 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Khan.Model.SSH
     ( Mode (..)
     , execSCP
     , execSSH
     , wait
     ) where

import qualified Data.Text                 as Text
import qualified Filesystem.Path.CurrentOS as Path
import           Khan.Internal
import           Khan.Prelude
import           System.Process            (callCommand)

data Mode
    = Upload   !FilePath !FilePath
    | Download !FilePath !FilePath
      deriving (Show)

execSCP :: MonadIO m => Mode -> Text -> Text -> FilePath -> [String] -> m ()
execSCP mode addr user key xs = exec "scp" (as ++ xs)
  where
    as = map Text.unpack $ ident : case mode of
        Upload   s d -> [toTextIgnore s, remote d]
        Download s d -> [remote s, toTextIgnore d]

    remote = mappend (user <> "@" <> addr <> ":") . toTextIgnore
    ident  = "-i" <> toTextIgnore key

execSSH :: MonadIO m
        => Text
        -> Text
        -> FilePath
        -> [String]
        -> m ()
execSSH addr user key xs = exec "ssh" (args addr user key xs)

wait :: MonadIO m => Int -> Text -> Text -> FilePath -> m Bool
wait s addr user key = do
    say "Waiting {} seconds for SSH connectivity on {}"
        [show s, Text.unpack addr]
    liftIO (go s)
  where
    delay = 20

    go n | n <= 0    = return False
         | otherwise = do
             say "Waiting {} seconds..." [delay]
             delaySeconds delay
             e <- runEitherT . sync $ exec "ssh" xs
             either (const . go $ n - delay)
                    (return . const True)
                    e

    xs = args addr user key
        [ "-q"
        , "-o"
        , "BatchMode=yes"
        , "-o"
        , "StrictHostKeyChecking=no"
        , "exit"
        ]

exec :: MonadIO m => String -> [String] -> m ()
exec run xs =
    let cmd = unwords (run : xs)
    in log "{}" [cmd] >> liftIO (callCommand cmd)

args :: Text -> Text -> FilePath -> [String] -> [String]
args addr user key = mappend
    [ "-i" <> Path.encodeString key
    , Text.unpack $ user <> "@" <> addr
    ]
{'fraction_non_alphanumeric': 0.12531769305962853, 'fraction_numerical': 0.005865102639296188, 'mean_word_length': 1.7834602829162132, 'pattern_counts': {'":': 2, '<': 33, '<?xml version=': 0, '>': 83, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '883407', 'n_tokens_mistral': 1630, 'n_tokens_neox': 1544, 'n_words': 549}