ftp-client-conduit (empty) → 0.1.0.0
raw patch · 6 files changed
+247/−0 lines, 6 filesdep +basedep +bytestringdep +conduitsetup-changed
Dependencies added: base, bytestring, conduit, connection, ftp-client, ftp-clientconduit, resourcet
Files
- LICENSE +24/−0
- README.md +25/−0
- Setup.hs +2/−0
- ftp-client-conduit.cabal +38/−0
- src/Network/FTP/Client/Conduit.hs +156/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ README.md view
@@ -0,0 +1,25 @@+# FTP Conduit++ftp-client is a client library for the FTP protocol in Haskell.++# Examples++## Insecure+```haskell+withFTP "ftp.server.com" 21 $ \h welcome -> do+ print welcome+ login h "username" "password"+ runConduitRes+ $ retr h filename+ .| sinkFile filename+```++## Secured with TLS+```haskell+withFTPS "ftps.server.com" 21 $ \h welcome -> do+ print welcome+ login h "username" "password"+ runConduitRes+ $ retrS h filename+ .| sinkFile filename+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ftp-client-conduit.cabal view
@@ -0,0 +1,38 @@+name: ftp-client-conduit+version: 0.1.0.0+synopsis: Transfer file with FTP and FTPS with Conduit+description: Please see README.md+homepage: https://github.com/mr/ftp-client+maintainer: mrobinson7627@gmail.com+license: PublicDomain+license-file: LICENSE+author: Matthew Robinson+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.FTP.Client.Conduit+ build-depends: base >= 4.7 && < 5+ , ftp-client == 0.1.0.0+ , conduit >= 1.1+ , bytestring+ , resourcet == 1.1.*+ , connection+ default-language: Haskell2010+ default-extensions: RankNTypes, OverloadedStrings++test-suite ftp-conduit-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , ftp-clientconduit+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/mr/ftp-client
+ src/Network/FTP/Client/Conduit.hs view
@@ -0,0 +1,156 @@+{-|+Module : Network.FTP.Client+Description : Transfer files over FTP and FTPS with Conduit+License : Public Domain+Stability : experimental+Portability : POSIX+-}+module Network.FTP.Client.Conduit (+ -- * Data commands+ nlst,+ retr,+ list,+ stor,+ -- * Secure data commands+ nlstS,+ retrS,+ listS,+ storS+) where++import Data.Conduit+import Control.Monad.IO.Class+import Data.ByteString.Lazy.Internal (defaultChunkSize)+import System.IO+import Network.FTP.Client+ ( createDataSocket+ , sendCommand+ , sendCommands+ , FTPCommand(..)+ , RTypeCode(..)+ , getLineResp+ , createSendDataCommand+ , createTLSSendDataCommand+ , PortActivity(..)+ , getMultiLineResp+ , sIOHandleImpl+ , tlsHandleImpl+ )++import qualified Network.FTP.Client as FTP+import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Control.Monad.Trans.Resource+import Data.Monoid ((<>))+import System.IO.Error+import Network.Connection++getAllLineRespC :: MonadIO m => FTP.Handle -> Producer m ByteString+getAllLineRespC h = loop+ where+ loop = do+ line <- liftIO $ FTP.getLineResp h+ `catchIOError` (\_ -> return "")+ if B.null line+ then return ()+ else do+ yield line+ loop++sendAllLineC :: MonadIO m => FTP.Handle -> Consumer ByteString m ()+sendAllLineC h = loop+ where+ loop = do+ mx <- await+ case mx of+ Nothing -> return ()+ Just x -> do+ liftIO $ FTP.sendLine h x+ loop++sourceDataCommand+ :: MonadResource m+ => FTP.Handle+ -> PortActivity+ -> [FTPCommand]+ -> (FTP.Handle -> ConduitM i o m r)+ -> ConduitM i o m r+sourceDataCommand ch pa cmds f = do+ x <- bracketP+ (createSendDataCommand ch pa cmds)+ hClose+ (f . sIOHandleImpl)+ resp <- liftIO $ getMultiLineResp ch+ liftIO $ print $ "Recieved: " <> (show resp)+ return x++sourceTLSDataCommand+ :: MonadResource m+ => FTP.Handle+ -> PortActivity+ -> [FTPCommand]+ -> (FTP.Handle -> ConduitM i o m r)+ -> ConduitM i o m r+sourceTLSDataCommand ch pa cmds f = do+ x <- bracketP+ (createTLSSendDataCommand ch pa cmds)+ connectionClose+ (f . tlsHandleImpl)+ resp <- liftIO $ getMultiLineResp ch+ liftIO $ print $ "Recieved: " <> (show resp)+ return x++sourceHandle :: MonadIO m => FTP.Handle -> Producer m ByteString+sourceHandle h = loop+ where+ loop = do+ bs <- liftIO $ FTP.recv h defaultChunkSize+ `catchIOError` (\_ -> return "")+ if B.null bs+ then return ()+ else do+ yield bs+ loop++sinkHandle :: MonadIO m => FTP.Handle -> Consumer ByteString m ()+sinkHandle h = loop+ where+ loop = do+ mbs <- await+ case mbs of+ Nothing -> return ()+ Just bs -> do+ liftIO $ FTP.send h bs+ loop++sendType :: MonadResource m => RTypeCode -> FTP.Handle -> Consumer ByteString m ()+sendType TA h = sendAllLineC h+sendType TI h = sinkHandle h++nlst :: MonadResource m => FTP.Handle -> [String] -> Producer m ByteString+nlst ch args = sourceDataCommand ch Passive [RType TA, Nlst args] getAllLineRespC++retr :: MonadResource m => FTP.Handle -> String -> Producer m ByteString+retr ch path = sourceDataCommand ch Passive [RType TI, Retr path] sourceHandle++list :: MonadResource m => FTP.Handle -> [String] -> Producer m ByteString+list ch args = sourceDataCommand ch Passive [RType TA, List args] getAllLineRespC++stor :: MonadResource m => FTP.Handle -> String -> RTypeCode -> Consumer ByteString m ()+stor ch loc rtype =+ sourceDataCommand ch Passive [RType rtype, Stor loc] $ sendType rtype++-- TLS++nlstS :: MonadResource m => FTP.Handle -> [String] -> Producer m ByteString+nlstS ch args = sourceTLSDataCommand ch Passive [RType TA, Nlst args] getAllLineRespC++retrS :: MonadResource m => FTP.Handle -> String -> Producer m ByteString+retrS ch path = sourceTLSDataCommand ch Passive [RType TI, Retr path] sourceHandle++listS :: MonadResource m => FTP.Handle -> [String] -> Producer m ByteString+listS ch args = sourceTLSDataCommand ch Passive [RType TA, List args] getAllLineRespC++storS :: MonadResource m => FTP.Handle -> String -> RTypeCode -> Consumer ByteString m ()+storS ch loc rtype =+ sourceTLSDataCommand ch Passive [RType rtype, Stor loc] $ sendType rtype
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"