diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,19 @@ +## v1.5.0 (2025-09-02) + +### Feat + +- **namespace**: move source files to the Hsftp namespace + +### CI + +- **workflows**: assign permissions to workflows + +## v1.4.1 (2025-08-21) + +### Feat + +- **commands**: do not copy metadata when archiving files after upload + ## v1.4.0 (2025-06-09) ### Build diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ -------------- ``` -Hsftp 1.4.0. Usage: hsftp OPTION +Hsftp 1.5.0. Usage: hsftp OPTION hsftp [OPTIONS] [ITEM] diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -2,24 +2,19 @@ ( main ) where -import CmdOptions ( options ) - -import Commands ( download, upload ) - -import Config - import Control.Monad ( when ) import Control.Monad.Reader import qualified Data.Yaml as Y -import Options ( Direction (..), Options (..) ) - -import Reader ( Env (..) ) +import Hsftp.CmdOptions ( options ) +import Hsftp.Commands ( download, upload ) +import Hsftp.Config +import Hsftp.Options ( Direction (..), Options (..) ) +import Hsftp.Reader ( Env (..) ) +import Hsftp.Util ( createFile, toDate, toEpoch ) import System.Console.CmdArgs ( cmdArgsRun ) - -import Util ( createFile, toDate, toEpoch ) -- | Loads the environment configuration from a file. diff --git a/hsftp.cabal b/hsftp.cabal --- a/hsftp.cabal +++ b/hsftp.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hsftp -version: 1.4.0 +version: 1.5.0 license: BSD-3-Clause license-file: LICENSE copyright: (c) 2024-present IOcrafts @@ -23,12 +23,12 @@ library exposed-modules: - CmdOptions - Commands - Config - Options - Reader - Util + Hsftp.CmdOptions + Hsftp.Commands + Hsftp.Config + Hsftp.Options + Hsftp.Reader + Hsftp.Util pkgconfig-depends: libssh2 hs-source-dirs: src diff --git a/src/CmdOptions.hs b/src/CmdOptions.hs deleted file mode 100644 --- a/src/CmdOptions.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-| -Module : CmdOptions -Description : Command-line options. -Copyright : (c) IOcrafts, 2024-present -License : BSD -Maintainer : Maurizio Dusi -Stability : stable -Portability : POSIX - -This module holds the command-line options accepted by executable. --} - -module CmdOptions - ( options - ) where - -import Data.Version ( showVersion ) - -import Options ( Direction (..), Options (..) ) - -import Paths_hsftp ( version ) - -import System.Console.CmdArgs ( CmdArgs, Mode, args, cmdArgsMode, - enum, explicit, groupname, help, name, - program, summary, typ, (&=) ) - - --- | Defines the command line options for the `hsftp` program. -options :: Mode (CmdArgs Options) -options = cmdArgsMode $ Options - { conf = "" &= typ "FILE" &= help "Load conf from file" - , fromDate = "" &= typ "DATE" &= help "Filter files by date (YYYY-MM-DD HH:MM UTC|PST|...)" &= explicit &= name "from-date" - , extensions = [] &= help "Filter files by extensions" - , direction = enum [Up &= help "upload", Down &= help "download"] - , src = "" &= typ "DIR" &= help "Folder to transfer from" &= explicit &= name "transfer-from" - , dst = "" &= typ "DIR" &= help "Folder to transfer to" &= explicit &= name "transfer-to" - , archive = Nothing &= typ "DIR" &= help "Folder to archive to after upload" &= explicit &= name "archive-to" - , verbose = 0 &= groupname "\nMiscellaneous" &= help "Verbose level: 1, 2 or 3" &= explicit &= name "verbose" - , dryRun = False &= help "Do a dry-run (\"No-op\") transfer." &= explicit &= name "dry-run" &= name "n" - , others = [] &= args - } &= summary ("Hsftp " <> showVersion version <> ". Usage: hsftp OPTION") &= program "hsftp" diff --git a/src/Commands.hs b/src/Commands.hs deleted file mode 100644 --- a/src/Commands.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-| -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 = do - Env{..} <- ask - - liftIO $ withSFTPUser knownHosts user password hostName port $ \sftp -> do - allFiles <- sftpListDir sftp transferFrom - let byDate x = (toInteger . saMtime . snd) x >= date - byExtension x = null transferExtensions || or [extension `isExtensionOf` (C.unpack . fst) x | extension <- transferExtensions] - isFile = (== 0o100000) . (.&. 0o170000) . saPermissions . snd - files = filter (\x -> byDate x && byExtension x && isFile x) allFiles - getFile f = do - let f' = C.unpack f - src = transferFrom f' - dst = transferTo f' - sftpReceiveFile sftp dst src - unless noOp $ mapM_ (getFile . fst) files - return $ length 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 = do - Env{..} <- ask - let byExtension x = null transferExtensions || or [extension `isExtensionOf` x | extension <- transferExtensions] - byDate = fmap ( (>= date) . toEpoch ) . getModificationTime - allFiles <- liftIO $ listDirectory transferFrom >>= - filterM ( doesFileExist . (transferFrom ) ) >>= - filterM ( byDate . (transferFrom ) ) - let files = filter byExtension allFiles - - unless (noOp || null files) $ - liftIO $ withSFTPUser knownHosts user password hostName port $ \sftp -> do - let putFile f = do - let src = transferFrom f - dst = transferTo f - sftpSendFile sftp src dst 0o664 - archiveFile f = case archiveTo of - Nothing -> return () - Just d -> do - let src = transferFrom f - dst = d f - copyFileWithMetadata src dst >> removeFile src - mapM_ (\x -> putFile x >> archiveFile x) files - return $ length files diff --git a/src/Config.hs b/src/Config.hs deleted file mode 100644 --- a/src/Config.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -{-| -Module : Config -Description : Process the YAML configuration file. -Copyright : (c) IOcrafts, 2024-present -License : BSD -Maintainer : Maurizio Dusi -Stability : stable -Portability : POSIX - -This module parses a YAML file with configuration options. - -__Example of conf.yaml:__ - -@ - remote: - hostname: sftp.domain.com - port: 22 - username: username - password: password - known_hosts: \/home\/user\/.ssh\/known_hosts -@ - --} - -module Config - ( Config (..) - , mkConfig - ) where - -import Control.Monad ( MonadPlus (mzero) ) - -import Data.Aeson ( FromJSON (parseJSON), (.!=), (.:) ) -import qualified Data.Yaml as Y - - --- | Represents the configuration settings for the application. -data Config - = Config { -- | The host address of the server. - configHost :: String - -- | The port number to connect to. - , configPort :: Int - -- | The username for authentication. - , configUser :: String - -- | The password for authentication. - , configPassword :: String - -- | The file path to the known hosts file. - , configKnownHosts :: FilePath - } - deriving (Show) - --- | Represents a YAML configuration with a remote value. -newtype YamlConfig - = YamlConfig { yamlRemote :: Remote } - deriving (Show) - --- | Represents a remote SFTP configuration. -data Remote - = Remote { remoteHost :: String - -- ^ SFTP site - , remotePort :: Int - -- ^ SFTP port - , remoteUser :: String - -- ^ SFTP username - , remotePassword :: String - -- ^ SFTP password - , remoteKnownHosts :: FilePath - -- ^ Path to the known_hosts file - } - deriving (Show) - --- | Create a 'Config' from a 'YamlConfig'. --- --- This function takes a 'YamlConfig' and extracts the necessary fields to create a 'Config' object. --- It returns an 'IO' action that produces the resulting 'Config'. -mkConfig :: YamlConfig -> IO Config -mkConfig YamlConfig{..} = do - let Remote {..} = yamlRemote - return $ - Config { configHost = remoteHost - , configPort = remotePort - , configUser = remoteUser - , configPassword = remotePassword - , configKnownHosts = remoteKnownHosts - } - - --- | Parses a JSON object into a 'YamlConfig' value. -instance FromJSON YamlConfig where - parseJSON (Y.Object v) = - YamlConfig <$> v .: "remote" - parseJSON _ = mzero - --- | Parses a JSON object into a 'Remote' data type. -instance FromJSON Remote where - parseJSON (Y.Object v) = - Remote <$> v .: "hostname" - <*> v .: "port" .!= 22 - <*> v .: "username" - <*> v .: "password" - <*> v .: "known_hosts" - parseJSON _ = mzero diff --git a/src/Hsftp/CmdOptions.hs b/src/Hsftp/CmdOptions.hs new file mode 100644 --- /dev/null +++ b/src/Hsftp/CmdOptions.hs @@ -0,0 +1,41 @@ +{-| +Module : Hsftp.CmdOptions +Description : Command-line options. +Copyright : (c) IOcrafts, 2024-present +License : BSD +Maintainer : Maurizio Dusi +Stability : stable +Portability : POSIX + +This module holds the command-line options accepted by executable. +-} + +module Hsftp.CmdOptions + ( options + ) where + +import Data.Version ( showVersion ) + +import Hsftp.Options ( Direction (..), Options (..) ) + +import Paths_hsftp ( version ) + +import System.Console.CmdArgs ( CmdArgs, Mode, args, cmdArgsMode, + enum, explicit, groupname, help, name, + program, summary, typ, (&=) ) + + +-- | Defines the command line options for the `hsftp` program. +options :: Mode (CmdArgs Options) +options = cmdArgsMode $ Options + { conf = "" &= typ "FILE" &= help "Load conf from file" + , fromDate = "" &= typ "DATE" &= help "Filter files by date (YYYY-MM-DD HH:MM UTC|PST|...)" &= explicit &= name "from-date" + , extensions = [] &= help "Filter files by extensions" + , direction = enum [Up &= help "upload", Down &= help "download"] + , src = "" &= typ "DIR" &= help "Folder to transfer from" &= explicit &= name "transfer-from" + , dst = "" &= typ "DIR" &= help "Folder to transfer to" &= explicit &= name "transfer-to" + , archive = Nothing &= typ "DIR" &= help "Folder to archive to after upload" &= explicit &= name "archive-to" + , verbose = 0 &= groupname "\nMiscellaneous" &= help "Verbose level: 1, 2 or 3" &= explicit &= name "verbose" + , dryRun = False &= help "Do a dry-run (\"No-op\") transfer." &= explicit &= name "dry-run" &= name "n" + , others = [] &= args + } &= summary ("Hsftp " <> showVersion version <> ". Usage: hsftp OPTION") &= program "hsftp" diff --git a/src/Hsftp/Commands.hs b/src/Hsftp/Commands.hs new file mode 100644 --- /dev/null +++ b/src/Hsftp/Commands.hs @@ -0,0 +1,90 @@ +{-| +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 = do + Env{..} <- ask + + liftIO $ withSFTPUser knownHosts user password hostName port $ \sftp -> do + allFiles <- sftpListDir sftp transferFrom + let byDate x = (toInteger . saMtime . snd) x >= date + byExtension x = null transferExtensions || or [extension `isExtensionOf` (C.unpack . fst) x | extension <- transferExtensions] + isFile = (== 0o100000) . (.&. 0o170000) . saPermissions . snd + files = filter (\x -> byDate x && byExtension x && isFile x) allFiles + getFile f = do + let f' = C.unpack f + src = transferFrom f' + dst = transferTo f' + sftpReceiveFile sftp dst src + unless noOp $ mapM_ (getFile . fst) files + return $ length 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 = do + Env{..} <- ask + let byExtension x = null transferExtensions || or [extension `isExtensionOf` x | extension <- transferExtensions] + byDate = fmap ( (>= date) . toEpoch ) . getModificationTime + allFiles <- liftIO $ listDirectory transferFrom >>= + filterM ( doesFileExist . (transferFrom ) ) >>= + filterM ( byDate . (transferFrom ) ) + let files = filter byExtension allFiles + + unless (noOp || null files) $ + liftIO $ withSFTPUser knownHosts user password hostName port $ \sftp -> do + let putFile f = do + let src = transferFrom f + dst = transferTo f + sftpSendFile sftp src dst 0o664 + archiveFile f = case archiveTo of + Nothing -> return () + Just d -> do + let src = transferFrom f + dst = d f + copyFile src dst >> removeFile src + mapM_ (\x -> putFile x >> archiveFile x) files + return $ length files diff --git a/src/Hsftp/Config.hs b/src/Hsftp/Config.hs new file mode 100644 --- /dev/null +++ b/src/Hsftp/Config.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Hsftp.Config +Description : Process the YAML configuration file. +Copyright : (c) IOcrafts, 2024-present +License : BSD +Maintainer : Maurizio Dusi +Stability : stable +Portability : POSIX + +This module parses a YAML file with configuration options. + +__Example of conf.yaml:__ + +@ + remote: + hostname: sftp.domain.com + port: 22 + username: username + password: password + known_hosts: \/home\/user\/.ssh\/known_hosts +@ + +-} + +module Hsftp.Config + ( Config (..) + , mkConfig + ) where + +import Control.Monad ( MonadPlus (mzero) ) + +import Data.Aeson ( FromJSON (parseJSON), (.!=), (.:) ) +import qualified Data.Yaml as Y + + +-- | Represents the configuration settings for the application. +data Config + = Config { -- | The host address of the server. + configHost :: String + -- | The port number to connect to. + , configPort :: Int + -- | The username for authentication. + , configUser :: String + -- | The password for authentication. + , configPassword :: String + -- | The file path to the known hosts file. + , configKnownHosts :: FilePath + } + deriving (Show) + +-- | Represents a YAML configuration with a remote value. +newtype YamlConfig + = YamlConfig { yamlRemote :: Remote } + deriving (Show) + +-- | Represents a remote SFTP configuration. +data Remote + = Remote { remoteHost :: String + -- ^ SFTP site + , remotePort :: Int + -- ^ SFTP port + , remoteUser :: String + -- ^ SFTP username + , remotePassword :: String + -- ^ SFTP password + , remoteKnownHosts :: FilePath + -- ^ Path to the known_hosts file + } + deriving (Show) + +-- | Create a 'Config' from a 'YamlConfig'. +-- +-- This function takes a 'YamlConfig' and extracts the necessary fields to create a 'Config' object. +-- It returns an 'IO' action that produces the resulting 'Config'. +mkConfig :: YamlConfig -> IO Config +mkConfig YamlConfig{..} = do + let Remote {..} = yamlRemote + return $ + Config { configHost = remoteHost + , configPort = remotePort + , configUser = remoteUser + , configPassword = remotePassword + , configKnownHosts = remoteKnownHosts + } + + +-- | Parses a JSON object into a 'YamlConfig' value. +instance FromJSON YamlConfig where + parseJSON (Y.Object v) = + YamlConfig <$> v .: "remote" + parseJSON _ = mzero + +-- | Parses a JSON object into a 'Remote' data type. +instance FromJSON Remote where + parseJSON (Y.Object v) = + Remote <$> v .: "hostname" + <*> v .: "port" .!= 22 + <*> v .: "username" + <*> v .: "password" + <*> v .: "known_hosts" + parseJSON _ = mzero diff --git a/src/Hsftp/Options.hs b/src/Hsftp/Options.hs new file mode 100644 --- /dev/null +++ b/src/Hsftp/Options.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} + +{-| +Module : Hsftp.Options +Description : Holds the options for the hsftp utility. +Copyright : (c) IOcrafts, 2024-present +License : BSD +Maintainer : Maurizio Dusi +Stability : stable +Portability : POSIX + +This module holds the available options for the hsftp utility. +-} + +module Hsftp.Options + ( Direction (..) + , Options (..) + ) where + +import Data.Data ( Data, Typeable ) + +data Direction + = Up + | Down + deriving (Data, Eq, Show) + +-- | Represents the options for the program. +data Options + = Options { conf :: FilePath + -- ^ Path to the configuration file. + , fromDate :: String + -- ^ Filter files by date (see 'toDate' for details on supported formats). + , extensions :: [String] + -- ^ Filter files by extensions. + , direction :: Direction + -- ^ Direction of the transfer. + , src :: FilePath + -- ^ Transfer from this folder (folder must exist). + , dst :: FilePath + -- ^ Transfer to this folder (folder must exist). + , archive :: Maybe FilePath + -- ^ Archive into this folder after successful upload (folder must exist). + , verbose :: Int + -- ^ Verbose level. + , dryRun :: Bool + -- ^ Do a dry-run (no-op) transfer. + , others :: [FilePath] + -- ^ List of files and/or folders. + } + deriving stock (Data, Show, Typeable) diff --git a/src/Hsftp/Reader.hs b/src/Hsftp/Reader.hs new file mode 100644 --- /dev/null +++ b/src/Hsftp/Reader.hs @@ -0,0 +1,38 @@ +{-| +Module : Hsftp.Reader +Description : Monad for keeping shared state. +Copyright : (c) IOcrafts, 2024-present +License : BSD +Maintainer : Maurizio Dusi +Stability : stable +Portability : POSIX + +This module provides the Reader monad for keeping shared state. + +-} + + +module Hsftp.Reader + ( Env (..) + , ReaderIO + ) where + +import Control.Monad.Reader + +data Env + = Env { hostName :: String + , port :: Int + , knownHosts :: String + , user :: String + , password :: String + , transferFrom :: String + , transferTo :: String + , transferExtensions :: [String] + , archiveTo :: Maybe String + , date :: Integer + , noOp :: Bool + } + deriving (Show) + + +type ReaderIO a = ReaderT Env IO a diff --git a/src/Hsftp/Util.hs b/src/Hsftp/Util.hs new file mode 100644 --- /dev/null +++ b/src/Hsftp/Util.hs @@ -0,0 +1,63 @@ +{-| +Module : Hsftp.Util +Description : Collections of utility functions. +Copyright : (c) IOcrafts, 2024-present +License : BSD +Maintainer : Maurizio Dusi +Stability : stable +Portability : POSIX + +This module provides utility functions for file, date and time manipulation. + +-} + + +module Hsftp.Util + ( createFile + , toDate + , toEpoch + ) where + +import Control.Monad ( unless ) + +import Data.Time + +import System.Directory ( doesFileExist ) + +{-| + Convert a string to seconds since Epoch. + The input string should be in the format %F %R %Z (YYYY-MM-DD HH-mm and abbreviated time zone name). + If the parsing fails, it defaults to the beginning of Epoch (i.e., zero). + + Example usage: + + >>> toDate "2022-01-01 12:00 UTC" + 2022-01-01 12:00:00 UTC +-} +toDate :: String -> UTCTime +toDate d = case parseTimeM True defaultTimeLocale "%F %R %Z" d of + Just x -> x + Nothing -> UTCTime (fromGregorian 1970 01 01) (secondsToDiffTime 0) + +{-| + Convert a 'UTCTime' value to seconds since Epoch. + + Example usage: + + >>> toEpoch (UTCTime (fromGregorian 2022 01 01) (secondsToDiffTime 0)) + 1640995200 +-} +toEpoch :: UTCTime -> Integer +toEpoch d = read $ formatTime defaultTimeLocale "%s" d + +{-| + Create a file if it does not exist. + + Example usage: + + >>> createFile "test.txt" +-} +createFile :: FilePath -> IO () +createFile cfile = do + fileExists <- doesFileExist cfile + unless fileExists $ writeFile cfile "" diff --git a/src/Options.hs b/src/Options.hs deleted file mode 100644 --- a/src/Options.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DerivingStrategies #-} - -{-| -Module : Options -Description : Holds the options for the hedictl utility. -Copyright : (c) IOcrafts, 2024-present -License : BSD -Maintainer : Maurizio Dusi -Stability : stable -Portability : POSIX - -This module holds the available options for the hedictl utility. --} - -module Options - ( Direction (..) - , Options (..) - ) where - -import Data.Data ( Data, Typeable ) - -data Direction - = Up - | Down - deriving (Data, Eq, Show) - --- | Represents the options for the program. -data Options - = Options { conf :: FilePath - -- ^ Path to the configuration file. - , fromDate :: String - -- ^ Filter files by date (see 'toDate' for details on supported formats). - , extensions :: [String] - -- ^ Filter files by extensions. - , direction :: Direction - -- ^ Direction of the transfer. - , src :: FilePath - -- ^ Transfer from this folder (folder must exist). - , dst :: FilePath - -- ^ Transfer to this folder (folder must exist). - , archive :: Maybe FilePath - -- ^ Archive into this folder after successful upload (folder must exist). - , verbose :: Int - -- ^ Verbose level. - , dryRun :: Bool - -- ^ Do a dry-run (no-op) transfer. - , others :: [FilePath] - -- ^ List of files and/or folders. - } - deriving stock (Data, Show, Typeable) diff --git a/src/Reader.hs b/src/Reader.hs deleted file mode 100644 --- a/src/Reader.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-| -Module : Reader -Description : Holds environment variables. -Copyright : (c) IOcrafts, 2024-present -License : BSD -Maintainer : Maurizio Dusi -Stability : stable -Portability : POSIX - -This module holds the environment variables used by the program. --} - -module Reader - ( Env (..) - , ReaderIO - ) where - -import Control.Monad.Reader ( ReaderT ) - - --- | Represents the environment configuration for the SFTP client. -data Env - = Env { hostName :: String - -- ^ The hostname of the SFTP server. - , port :: Int - -- ^ The port number to connect to. - , user :: String - -- ^ The username for authentication. - , password :: String - -- ^ The password for authentication. - , knownHosts :: FilePath - -- ^ The path to the known hosts file. - , transferFrom :: FilePath - -- ^ The source file path for transfer. - , transferTo :: FilePath - -- ^ The destination file path for transfer. - , transferExtensions :: [String] - -- ^ The list of file extensions to transfer. - , archiveTo :: Maybe FilePath - -- ^ Optional path to archive transferred files. - , date :: Integer - -- ^ The date for filtering files to transfer. - , noOp :: Bool - -- ^ Whether or not to perform the actual transfer. - } - -type ReaderIO = ReaderT Env IO diff --git a/src/Util.hs b/src/Util.hs deleted file mode 100644 --- a/src/Util.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-| -Module : Util -Description : Collections of utility functions. -Copyright : (c) IOcrafts, 2024-present -License : BSD -Maintainer : Maurizio Dusi -Stability : stable -Portability : POSIX - -This module provides utility functions for file, date and time manipulation. - --} - - -module Util - ( createFile - , toDate - , toEpoch - ) where - -import Control.Monad ( unless ) - -import Data.Time - -import System.Directory ( doesFileExist ) - -{-| - Convert a string to seconds since Epoch. - The input string should be in the format %F %R %Z (YYYY-MM-DD HH-mm and abbreviated time zone name). - If the parsing fails, it defaults to the beginning of Epoch (i.e., zero). - - Example usage: - - >>> toDate "2022-01-01 12:00 UTC" - 2022-01-01 12:00:00 UTC --} -toDate :: String -> UTCTime -toDate d = case parseTimeM True defaultTimeLocale "%F %R %Z" d of - Just x -> x - Nothing -> UTCTime (fromGregorian 1970 01 01) (secondsToDiffTime 0) - -{-| - Convert a 'UTCTime' value to seconds since Epoch. - - Example usage: - - >>> toEpoch (UTCTime (fromGregorian 2022 01 01) (secondsToDiffTime 0)) - 1640995200 --} -toEpoch :: UTCTime -> Integer -toEpoch d = read $ formatTime defaultTimeLocale "%s" d - -{-| - Create a file if it does not exist. - - Example usage: - - >>> createFile "test.txt" --} -createFile :: FilePath -> IO () -createFile cfile = do - fileExists <- doesFileExist cfile - unless fileExists $ writeFile cfile "" diff --git a/test/TestCommands.hs b/test/TestCommands.hs --- a/test/TestCommands.hs +++ b/test/TestCommands.hs @@ -19,12 +19,11 @@ , sftpUploadTests ) where -import Commands ( download, upload ) - import Control.Monad ( filterM ) import Control.Monad.Reader -import Reader ( Env (..) ) +import Hsftp.Commands ( download, upload ) +import Hsftp.Reader ( Env (..) ) import System.Directory ( createDirectoryIfMissing, doesFileExist, listDirectory, diff --git a/test/TestReader.hs b/test/TestReader.hs --- a/test/TestReader.hs +++ b/test/TestReader.hs @@ -14,7 +14,7 @@ ( readerTests ) where -import Reader ( Env (..) ) +import Hsftp.Reader ( Env (..) ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( testCase, (@?=) ) diff --git a/test/TestUtil.hs b/test/TestUtil.hs --- a/test/TestUtil.hs +++ b/test/TestUtil.hs @@ -16,13 +16,13 @@ import Data.Time +import Hsftp.Util ( createFile, toDate, toEpoch ) + import System.Directory ( doesFileExist ) import System.IO.Temp ( withTempFile ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( testCase, (@?=) ) - -import Util ( createFile, toDate, toEpoch ) utilTests :: TestTree utilTests =