packages feed

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 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"