module Network.FTP.Client.Conduit (
nlst,
retr,
list,
stor,
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
( 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
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