{-|
Module      : 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 Commands
    ( download
    , upload
    ) where


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

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

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

import           Reader                             ( Env (..), ReaderIO )

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

import           Util                               ( toEpoch )


{-|
  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
FilePath
[FilePath]
Maybe FilePath
hostName :: FilePath
port :: Int
user :: FilePath
password :: FilePath
knownHosts :: FilePath
transferFrom :: FilePath
transferTo :: FilePath
transferExtensions :: [FilePath]
archiveTo :: Maybe FilePath
date :: Integer
noOp :: Bool
noOp :: Env -> Bool
date :: Env -> Integer
archiveTo :: Env -> Maybe FilePath
transferExtensions :: Env -> [FilePath]
transferTo :: Env -> FilePath
transferFrom :: Env -> FilePath
knownHosts :: Env -> FilePath
password :: Env -> FilePath
user :: Env -> FilePath
port :: Env -> Int
hostName :: Env -> FilePath
..} <- 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
$ FilePath
-> FilePath
-> FilePath
-> FilePath
-> Int
-> (Sftp -> IO Int)
-> IO Int
forall a.
FilePath
-> FilePath
-> FilePath
-> FilePath
-> Int
-> (Sftp -> IO a)
-> IO a
withSFTPUser FilePath
knownHosts FilePath
user FilePath
password FilePath
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 -> FilePath -> IO SftpList
sftpListDir Sftp
sftp FilePath
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 = [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
transferExtensions Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [FilePath
extension FilePath -> FilePath -> Bool
`isExtensionOf` (ByteString -> FilePath
C.unpack (ByteString -> FilePath)
-> ((ByteString, b) -> ByteString) -> (ByteString, b) -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, b) -> ByteString
forall a b. (a, b) -> a
fst) (ByteString, b)
x | FilePath
extension <- [FilePath]
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' :: FilePath
f' = ByteString -> FilePath
C.unpack ByteString
f
                    src :: FilePath
src = FilePath
transferFrom FilePath -> FilePath -> FilePath
</> FilePath
f'
                    dst :: FilePath
dst = FilePath
transferTo FilePath -> FilePath -> FilePath
</> FilePath
f'
                Sftp -> FilePath -> FilePath -> IO Integer
sftpReceiveFile Sftp
sftp FilePath
dst FilePath
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
FilePath
[FilePath]
Maybe FilePath
noOp :: Env -> Bool
date :: Env -> Integer
archiveTo :: Env -> Maybe FilePath
transferExtensions :: Env -> [FilePath]
transferTo :: Env -> FilePath
transferFrom :: Env -> FilePath
knownHosts :: Env -> FilePath
password :: Env -> FilePath
user :: Env -> FilePath
port :: Env -> Int
hostName :: Env -> FilePath
hostName :: FilePath
port :: Int
user :: FilePath
password :: FilePath
knownHosts :: FilePath
transferFrom :: FilePath
transferTo :: FilePath
transferExtensions :: [FilePath]
archiveTo :: Maybe FilePath
date :: Integer
noOp :: Bool
..} <- ReaderT Env IO Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    let byExtension :: FilePath -> Bool
byExtension FilePath
x = [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
transferExtensions Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [FilePath
extension FilePath -> FilePath -> Bool
`isExtensionOf` FilePath
x | FilePath
extension <- [FilePath]
transferExtensions]
        byDate :: FilePath -> 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)
-> (FilePath -> IO UTCTime) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO UTCTime
getModificationTime
    [FilePath]
allFiles <- IO [FilePath] -> ReaderT Env IO [FilePath]
forall a. IO a -> ReaderT Env IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> ReaderT Env IO [FilePath])
-> IO [FilePath] -> ReaderT Env IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
transferFrom IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
transferFrom FilePath -> FilePath -> FilePath
</>) ) IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( FilePath -> IO Bool
byDate (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
transferFrom FilePath -> FilePath -> FilePath
</>) )
    let files :: [FilePath]
files = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
byExtension [FilePath]
allFiles

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