{-|
Module      : Hsftp.Commands
Description : Supported commands.
Copyright   : (c) IOcrafts, 2024-present
License     : BSD
Maintainer  : Maurizio Dusi
Stability   : stable
Portability : POSIX

This module holds a collection of supported commands.
-}


module Hsftp.Commands
    ( download
    , upload
    ) where


import           Control.Monad                      ( filterM, unless )
import           Control.Monad.Reader

import           Data.Bits                          ( (.&.) )
import qualified Data.ByteString.Char8              as C

import           Hsftp.Reader                       ( Env (..), ReaderIO )
import           Hsftp.Util                         ( toEpoch )

import           Network.SSH.Client.LibSSH2
import           Network.SSH.Client.LibSSH2.Foreign ( SftpAttributes (..) )

import           System.Directory                   ( copyFile, doesFileExist,
                                                      getModificationTime,
                                                      listDirectory,
                                                      removeFile )
import           System.FilePath                    ( isExtensionOf, (</>) )


{-|
  Download files from a remote server using SFTP.
  Both remote and local folders must exist.
  The function returns the number of files downloaded.
-}
download :: ReaderIO Int
download :: ReaderIO Int
download = do
    Env{Bool
Int
Integer
String
[String]
Maybe String
hostName :: String
port :: Int
knownHosts :: String
user :: String
password :: String
transferFrom :: String
transferTo :: String
transferExtensions :: [String]
archiveTo :: Maybe String
date :: Integer
noOp :: Bool
noOp :: Env -> Bool
date :: Env -> Integer
archiveTo :: Env -> Maybe String
transferExtensions :: Env -> [String]
transferTo :: Env -> String
transferFrom :: Env -> String
password :: Env -> String
user :: Env -> String
knownHosts :: Env -> String
port :: Env -> Int
hostName :: Env -> String
..} <- ReaderT Env IO Env
forall r (m :: * -> *). MonadReader r m => m r
ask

    IO Int -> ReaderIO Int
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ReaderIO Int) -> IO Int -> ReaderIO Int
forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> Int -> (Sftp -> IO Int) -> IO Int
forall a.
String
-> String -> String -> String -> Int -> (Sftp -> IO a) -> IO a
withSFTPUser String
knownHosts String
user String
password String
hostName Int
port ((Sftp -> IO Int) -> IO Int) -> (Sftp -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Sftp
sftp -> do
        SftpList
allFiles <- Sftp -> String -> IO SftpList
sftpListDir Sftp
sftp String
transferFrom
        let byDate :: (a, SftpAttributes) -> Bool
byDate (a, SftpAttributes)
x = (CULong -> Integer
forall a. Integral a => a -> Integer
toInteger (CULong -> Integer)
-> ((a, SftpAttributes) -> CULong)
-> (a, SftpAttributes)
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SftpAttributes -> CULong
saMtime (SftpAttributes -> CULong)
-> ((a, SftpAttributes) -> SftpAttributes)
-> (a, SftpAttributes)
-> CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, SftpAttributes) -> SftpAttributes
forall a b. (a, b) -> b
snd) (a, SftpAttributes)
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
date
            byExtension :: (ByteString, b) -> Bool
byExtension (ByteString, b)
x = [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
transferExtensions Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [String
extension String -> String -> Bool
`isExtensionOf` (ByteString -> String
C.unpack (ByteString -> String)
-> ((ByteString, b) -> ByteString) -> (ByteString, b) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, b) -> ByteString
forall a b. (a, b) -> a
fst) (ByteString, b)
x | String
extension <- [String]
transferExtensions]
            isFile :: (a, SftpAttributes) -> Bool
isFile = (CULong -> CULong -> Bool
forall a. Eq a => a -> a -> Bool
== CULong
0o100000) (CULong -> Bool)
-> ((a, SftpAttributes) -> CULong) -> (a, SftpAttributes) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CULong -> CULong -> CULong
forall a. Bits a => a -> a -> a
.&. CULong
0o170000) (CULong -> CULong)
-> ((a, SftpAttributes) -> CULong) -> (a, SftpAttributes) -> CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SftpAttributes -> CULong
saPermissions (SftpAttributes -> CULong)
-> ((a, SftpAttributes) -> SftpAttributes)
-> (a, SftpAttributes)
-> CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, SftpAttributes) -> SftpAttributes
forall a b. (a, b) -> b
snd
            files :: SftpList
files = ((ByteString, SftpAttributes) -> Bool) -> SftpList -> SftpList
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString, SftpAttributes)
x -> (ByteString, SftpAttributes) -> Bool
forall {a}. (a, SftpAttributes) -> Bool
byDate (ByteString, SftpAttributes)
x Bool -> Bool -> Bool
&& (ByteString, SftpAttributes) -> Bool
forall {b}. (ByteString, b) -> Bool
byExtension (ByteString, SftpAttributes)
x Bool -> Bool -> Bool
&& (ByteString, SftpAttributes) -> Bool
forall {a}. (a, SftpAttributes) -> Bool
isFile (ByteString, SftpAttributes)
x) SftpList
allFiles
            getFile :: ByteString -> IO Integer
getFile ByteString
f = do
                let f' :: String
f' = ByteString -> String
C.unpack ByteString
f
                    src :: String
src = String
transferFrom String -> String -> String
</> String
f'
                    dst :: String
dst = String
transferTo String -> String -> String
</> String
f'
                Sftp -> String -> String -> IO Integer
sftpReceiveFile Sftp
sftp String
dst String
src
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
noOp (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((ByteString, SftpAttributes) -> IO Integer) -> SftpList -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> IO Integer
getFile (ByteString -> IO Integer)
-> ((ByteString, SftpAttributes) -> ByteString)
-> (ByteString, SftpAttributes)
-> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, SftpAttributes) -> ByteString
forall a b. (a, b) -> a
fst) SftpList
files
        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ SftpList -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length SftpList
files

{-|
  Upload files to a remote server using SFTP.
  Both remote and local folders must exist.
  The function returns the number of files uploaded.
-}
upload :: ReaderIO Int
upload :: ReaderIO Int
upload = do
    Env{Bool
Int
Integer
String
[String]
Maybe String
noOp :: Env -> Bool
date :: Env -> Integer
archiveTo :: Env -> Maybe String
transferExtensions :: Env -> [String]
transferTo :: Env -> String
transferFrom :: Env -> String
password :: Env -> String
user :: Env -> String
knownHosts :: Env -> String
port :: Env -> Int
hostName :: Env -> String
hostName :: String
port :: Int
knownHosts :: String
user :: String
password :: String
transferFrom :: String
transferTo :: String
transferExtensions :: [String]
archiveTo :: Maybe String
date :: Integer
noOp :: Bool
..} <- ReaderT Env IO Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    let byExtension :: String -> Bool
byExtension String
x = [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
transferExtensions Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [String
extension String -> String -> Bool
`isExtensionOf` String
x | String
extension <- [String]
transferExtensions]
        byDate :: String -> IO Bool
byDate = (UTCTime -> Bool) -> IO UTCTime -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
date) (Integer -> Bool) -> (UTCTime -> Integer) -> UTCTime -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Integer
toEpoch ) (IO UTCTime -> IO Bool)
-> (String -> IO UTCTime) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO UTCTime
getModificationTime
    [String]
allFiles <- IO [String] -> ReaderT Env IO [String]
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> ReaderT Env IO [String])
-> IO [String] -> ReaderT Env IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
listDirectory String
transferFrom IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
transferFrom String -> String -> String
</>) ) IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( String -> IO Bool
byDate (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
transferFrom String -> String -> String
</>) )
    let files :: [String]
files = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
byExtension [String]
allFiles

    Bool -> ReaderT Env IO () -> ReaderT Env IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
noOp Bool -> Bool -> Bool
|| [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files) (ReaderT Env IO () -> ReaderT Env IO ())
-> ReaderT Env IO () -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$
        IO () -> ReaderT Env IO ()
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Env IO ()) -> IO () -> ReaderT Env IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> Int -> (Sftp -> IO ()) -> IO ()
forall a.
String
-> String -> String -> String -> Int -> (Sftp -> IO a) -> IO a
withSFTPUser String
knownHosts String
user String
password String
hostName Int
port ((Sftp -> IO ()) -> IO ()) -> (Sftp -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Sftp
sftp -> do
            let putFile :: String -> IO Integer
putFile String
f = do
                    let src :: String
src = String
transferFrom String -> String -> String
</> String
f
                        dst :: String
dst = String
transferTo String -> String -> String
</> String
f
                    Sftp -> String -> String -> Int -> IO Integer
sftpSendFile Sftp
sftp String
src String
dst Int
0o664
                archiveFile :: String -> IO ()
archiveFile String
f = case Maybe String
archiveTo of
                    Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just String
d -> do
                        let src :: String
src = String
transferFrom String -> String -> String
</> String
f
                            dst :: String
dst = String
d String -> String -> String
</> String
f
                        String -> String -> IO ()
copyFile String
src String
dst IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
removeFile String
src
            (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
x -> String -> IO Integer
putFile String
x IO Integer -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
archiveFile String
x) [String]
files
    Int -> ReaderIO Int
forall a. a -> ReaderT Env IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ReaderIO Int) -> Int -> ReaderIO Int
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
files