ftp-client 0.3.0.0 → 0.4.0.0

raw patch · 3 files changed

+165/−104 lines, 3 filesdep +exceptionsdep ~basedep ~ftp-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: base, ftp-client

API changes (from Hackage documentation)

Files

• README.md +1/−1
• ftp-client.cabal +6/−5
• src/Network/FTP/Client.hs +158/−98

@@ -17,5 +17,5 @@ withFTPS "ftps.server.com" 21 $ \h welcome -> do     print welcome     login h "username" "password"-    print =<< nlstS h []+    print =<< nlst h [] ```

@@ -1,5 +1,5 @@ name: ftp-client-version: 0.3.0.0+version: 0.4.0.0 cabal-version: >=1.10 build-type: Simple license: PublicDomain@@ -22,12 +22,13 @@     exposed-modules:         Network.FTP.Client     build-depends:-        base >=4.7 && <5,+        base >=4.8 && <5,         bytestring >=0.10.8.1 && <0.11,         network >=2.6.3.1 && <2.7,         attoparsec >=0.10 && <0.14,         connection ==0.2.*,-        transformers >=0.5.2.0 && <0.6+        transformers >=0.5.2.0 && <0.6,+        exceptions >=0.8.3 && <0.9     default-language: Haskell2010     default-extensions: OverloadedStrings     hs-source-dirs: src@@ -36,8 +37,8 @@     type: exitcode-stdio-1.0     main-is: Spec.hs     build-depends:-        base >=4.9.0.0 && <4.10,-        ftp-client >=0.3.0.0 && <0.4+        base >=4.9.1.0 && <4.10,+        ftp-client >=0.4.0.0 && <0.5     default-language: Haskell2010     hs-source-dirs: test     ghc-options: -threaded -rtsopts -with-rtsopts=-N

@@ -56,7 +56,10 @@ import qualified System.IO as SIO import Data.Monoid ((<>), mconcat) import Control.Exception+import Control.Monad.Catch (MonadCatch, MonadMask)+import qualified Control.Monad.Catch as M import Control.Monad+import Control.Monad.IO.Class import Data.Bits import Network.Connection import System.IO.Error@@ -67,11 +70,11 @@ debugging :: Bool debugging = False -debugPrint :: Show a => a -> IO ()+debugPrint :: (Show a, MonadIO m) => a -> m () debugPrint s = debugPrint' s debugging     where         debugPrint' _ False = return ()-        debugPrint' s True = print s+        debugPrint' s True = liftIO $ print s  data Security = Clear | TLS @@ -199,9 +202,9 @@  -- | Get a full response from the server -- Used in 'sendCommand'-getMultiLineResp :: Handle -> IO FTPResponse+getMultiLineResp :: MonadIO m => Handle -> m FTPResponse getMultiLineResp h = do-    line <- getLineResp h+    line <- liftIO $ getLineResp h     let (code, rest) = C.splitAt 3 line     message <- if C.head rest == '-'         then loopMultiLine h code line@@ -211,21 +214,26 @@         (read $ C.unpack code)         (C.drop 4 message) -loopMultiLine :: Handle -> ByteString -> ByteString -> IO ByteString+loopMultiLine+    :: MonadIO m+    => Handle+    -> ByteString+    -> ByteString+    -> m ByteString loopMultiLine h code line = do-    nextLine <- getLineResp h+    nextLine <- liftIO $ getLineResp h     let multiLine = line <> "\n" <> nextLine         nextCode = C.take 3 nextLine     if nextCode == code         then return multiLine         else loopMultiLine h nextCode multiLine -sendCommandLine :: Handle -> ByteString -> IO ()-sendCommandLine h dat = send h $ dat <> "\r\n"+sendCommandLine :: MonadIO m => Handle -> ByteString -> m ()+sendCommandLine h = liftIO . send h . (<> "\r\n")  -- | Send a command to the server and get a response back. -- Some commands use a data 'Handle', and their data is not returned here.-sendCommand :: Handle -> FTPCommand -> IO FTPResponse+sendCommand :: MonadIO m => Handle -> FTPCommand -> m FTPResponse sendCommand h fc = do     let command = serializeCommand fc     debugPrint $ "Sending: " <> command@@ -237,54 +245,59 @@ -- | Equvalent to -- -- > mapM . sendCommand-sendCommands :: Handle -> [FTPCommand] -> IO [FTPResponse]+sendCommands :: MonadIO m => Handle -> [FTPCommand] -> m [FTPResponse] sendCommands = mapM . sendCommand  -- Control connection -createSocket :: Maybe String -> Int -> S.AddrInfo -> IO (S.Socket, S.AddrInfo)+createSocket :: MonadIO m => Maybe String -> Int -> S.AddrInfo -> m (S.Socket, S.AddrInfo) createSocket host portNum hints = do-    addr:_ <- S.getAddrInfo (Just hints) host (Just $ show portNum)+    addr:_ <- liftIO $ S.getAddrInfo (Just hints) host (Just $ show portNum)     debugPrint $ "Addr: " <> show addr-    sock <- S.socket+    sock <- liftIO $ S.socket         (S.addrFamily addr)         (S.addrSocketType addr)         (S.addrProtocol addr)     return (sock, addr) -withSocketPassive :: String -> Int -> (S.Socket -> IO a) -> IO a+withSocketPassive+    :: (MonadIO m, MonadMask m)+    => String+    -> Int+    -> (S.Socket -> m a)+    -> m a withSocketPassive host portNum f = do     let hints = S.defaultHints {         S.addrSocketType = S.Stream     }-    bracketOnError+    M.bracketOnError         (createSocket (Just host) portNum hints)-        (\(sock, _) -> S.close sock)+        (liftIO . S.close . fst)         (\(sock, addr) -> do-            S.connect sock (S.addrAddress addr)+            liftIO $ S.connect sock (S.addrAddress addr)             debugPrint "Connected"             f sock         ) -withSocketActive :: (S.Socket -> IO a) -> IO a+withSocketActive :: (MonadIO m, MonadMask m) => (S.Socket -> m a) -> m a withSocketActive f = do     let hints = S.defaultHints {         S.addrSocketType = S.Stream,         S.addrFlags = [S.AI_PASSIVE]     }-    bracketOnError+    M.bracketOnError         (createSocket Nothing 0 hints)-        (\(sock, _) -> S.close sock)+        (liftIO . S.close . fst)         (\(sock, addr) -> do-            S.bind sock (S.addrAddress addr)-            S.listen sock 1+            liftIO $ S.bind sock (S.addrAddress addr)+            liftIO $ S.listen sock 1             debugPrint "Listening"             f sock         ) -createSIOHandle :: String -> Int -> IO SIO.Handle+createSIOHandle :: (MonadIO m, MonadMask m) => String -> Int -> m SIO.Handle createSIOHandle host portNum = withSocketPassive host portNum-    (\sock -> S.socketToHandle sock SIO.ReadWriteMode)+    $ liftIO . flip S.socketToHandle SIO.ReadWriteMode  sIOHandleImpl :: SIO.Handle -> Handle sIOHandleImpl h = Handle@@ -295,10 +308,15 @@     , security = Clear     } -withSIOHandle :: String -> Int -> (Handle -> IO a) -> IO a-withSIOHandle host portNum f = bracket-    (createSIOHandle host portNum)-    SIO.hClose+withSIOHandle+    :: (MonadIO m, MonadMask m)+    => String+    -> Int+    -> (Handle -> m a)+    -> m a+withSIOHandle host portNum f = M.bracket+    (liftIO $ createSIOHandle host portNum)+    (liftIO . SIO.hClose)     (f . sIOHandleImpl)  -- | Takes a host name and port. A handle for interacting with the server@@ -310,88 +328,106 @@ --     login h "username" "password" --     print =<< nlst h [] -- @-withFTP :: String -> Int -> (Handle -> FTPResponse -> IO a) -> IO a+withFTP+    :: (MonadIO m, MonadMask m)+    => String+    -> Int+    -> (Handle -> FTPResponse -> m a)+    -> m a withFTP host portNum f = withSIOHandle host portNum $ \h -> do     resp <- getMultiLineResp h     f h resp  -- Data connection -withDataSocketPasv :: Handle -> (S.Socket -> IO a) -> IO a+withDataSocketPasv+    :: (MonadIO m, MonadMask m)+    => Handle+    -> (S.Socket -> m a)+    -> m a withDataSocketPasv h f = do     (host, portNum) <- pasv h     debugPrint $ "Host: " <> host     debugPrint $ "Port: " <> show portNum     withSocketPassive host portNum f -withDataSocketActive :: Handle -> (S.Socket -> IO a) -> IO a+withDataSocketActive+    :: (MonadIO m, MonadMask m)+    => Handle+    -> (S.Socket -> m a)+    -> m a withDataSocketActive h f = withSocketActive $ \socket -> do-    (S.SockAddrInet sPort sHost) <- S.getSocketName socket+    (S.SockAddrInet sPort sHost) <- liftIO $ S.getSocketName socket     port h sHost sPort     f socket  -- | Open a socket that can be used for data transfers-withDataSocket :: PortActivity -> Handle -> (S.Socket -> IO a) -> IO a+withDataSocket+    :: (MonadIO m, MonadMask m)+    => PortActivity+    -> Handle+    -> (S.Socket -> m a)+    -> m a withDataSocket Active  = withDataSocketActive withDataSocket Passive = withDataSocketPasv -acceptData :: S.Socket -> PortActivity -> IO S.Socket-acceptData sock Passive = return sock-acceptData sock Active = do-    (socket, _) <- S.accept sock-    return socket+acceptData :: MonadIO m => PortActivity -> S.Socket -> m S.Socket+acceptData Passive = return+acceptData Active = return . fst <=< liftIO . S.accept  -- | Send setup commands to the server and -- create a data 'System.IO.Handle' createSendDataCommand-    :: Handle+    :: (MonadIO m, MonadMask m)+    => Handle     -> PortActivity     -> [FTPCommand]-    -> IO (SIO.Handle)+    -> m (SIO.Handle) createSendDataCommand h pa cmds = withDataSocket pa h $ \socket -> do     sendCommands h cmds-    acceptedSock <- acceptData socket pa-    S.socketToHandle acceptedSock SIO.ReadWriteMode+    acceptedSock <- acceptData pa socket+    liftIO $ S.socketToHandle acceptedSock SIO.ReadWriteMode  -- | Provides a data 'Handle' in a callback for a command withDataCommand-    :: Handle+    :: (MonadIO m, MonadMask m)+    => Handle     -> PortActivity     -> [FTPCommand]-    -> (Handle -> IO a)-    -> IO a+    -> (Handle -> m a)+    -> m a withDataCommand ch pa cmds f = do-    x <- bracket+    x <- M.bracket         (createSendDataCommand ch pa cmds)-        SIO.hClose+        (liftIO . SIO.hClose)         (f . sIOHandleImpl)     resp <- getMultiLineResp ch     debugPrint $ "Recieved: " <> (show resp)     return x  -- | Recieve data and interpret it linewise-getAllLineResp :: Handle -> IO ByteString+getAllLineResp :: (MonadIO m, MonadCatch m) => Handle -> m ByteString getAllLineResp h = getAllLineResp' h []     where         getAllLineResp' h ret = (do-            line <- getLineResp h+            line <- liftIO $ getLineResp h             getAllLineResp' h (ret <> [line]))-                `catchIOError` (\_ -> return $ C.intercalate "\n" ret)+                `M.catchIOError` (\_ -> return $ C.intercalate "\n" ret)  -- | Recieve all data and return it as a 'Data.ByteString.ByteString'-recvAll :: Handle -> IO ByteString+recvAll :: (MonadIO m, MonadCatch m) => Handle -> m ByteString recvAll h = recvAll' ""     where         recvAll' bs = (do-            chunk <- recv h defaultChunkSize+            chunk <- liftIO $ recv h defaultChunkSize             recvAll' $ bs <> chunk)-                `catchIOError` (\_ -> return bs)+                `M.catchIOError` (\_ -> return bs)  -- TLS connection -connectTLS :: SIO.Handle -> String -> Int -> IO Connection+connectTLS :: MonadIO m => SIO.Handle -> String -> Int -> m Connection connectTLS h host portNum = do-    context <- initConnectionContext+    context <- liftIO initConnectionContext     let tlsSettings = TLSSettingsSimple             { settingDisableCertificateValidation = True             , settingDisableSession = False@@ -403,9 +439,13 @@             , connectionUseSecure = Just tlsSettings             , connectionUseSocks = Nothing             }-    connectFromHandle context h connectionParams+    liftIO $ connectFromHandle context h connectionParams -createTLSConnection :: String -> Int -> IO (FTPResponse, Connection)+createTLSConnection+    :: (MonadIO m, MonadMask m)+    => String+    -> Int+    -> m (FTPResponse, Connection) createTLSConnection host portNum = do     h <- createSIOHandle host portNum     let insecureH = sIOHandleImpl h@@ -423,10 +463,15 @@     , security = TLS     } -withTLSHandle :: String -> Int -> (Handle -> FTPResponse -> IO a) -> IO a-withTLSHandle host portNum f = bracket+withTLSHandle+    :: (MonadMask m, MonadIO m)+    => String+    -> Int+    -> (Handle -> FTPResponse -> m a)+    -> m a+withTLSHandle host portNum f = M.bracket     (createTLSConnection host portNum)-    (\(_, conn) -> connectionClose conn)+    (liftIO . connectionClose . snd)     (\(resp, conn) -> f (tlsHandleImpl conn) resp)  -- | Takes a host name and port. A handle for interacting with the server@@ -438,7 +483,12 @@ --     login h "username" "password" --     print =<< nlst h [] -- @-withFTPS :: String -> Int -> (Handle -> FTPResponse -> IO a) -> IO a+withFTPS+    :: (MonadMask m, MonadIO m)+    => String+    -> Int+    -> (Handle -> FTPResponse -> m a)+    -> m a withFTPS host portNum = withTLSHandle host portNum  -- TLS data connection@@ -446,31 +496,33 @@ -- | Send setup commands to the server and -- create a data TLS connection createTLSSendDataCommand-    :: Handle+    :: (MonadIO m, MonadMask m)+    => Handle     -> PortActivity     -> [FTPCommand]-    -> IO Connection+    -> m Connection createTLSSendDataCommand ch pa cmds = do     sendCommands ch [Pbsz 0, Prot P]     withDataSocket pa ch $ \socket -> do         sendCommands ch cmds-        acceptedSock <- acceptData socket pa-        (S.SockAddrInet sPort sHost) <- S.getSocketName acceptedSock+        acceptedSock <- acceptData pa socket+        (S.SockAddrInet sPort sHost) <- liftIO $ S.getSocketName acceptedSock         let (h1, h2, h3, h4) = S.hostAddressToTuple sHost             hostName = intercalate "." $ (show . fromEnum) <$> [h1, h2, h3, h4]-        h <- S.socketToHandle acceptedSock SIO.ReadWriteMode-        connectTLS h hostName (fromEnum sPort)+        h <- liftIO $ S.socketToHandle acceptedSock SIO.ReadWriteMode+        liftIO $ connectTLS h hostName (fromEnum sPort)  withTLSDataCommand-    :: Handle+    :: (MonadIO m, MonadMask m)+    => Handle     -> PortActivity     -> [FTPCommand]-    -> (Handle -> IO a)-    -> IO a+    -> (Handle -> m a)+    -> m a withTLSDataCommand ch pa cmds f = do-    x <- bracket+    x <- M.bracket         (createTLSSendDataCommand ch pa cmds)-        connectionClose+        (liftIO . connectionClose)         (f . tlsHandleImpl)     resp <- getMultiLineResp ch     debugPrint $ "Recieved: " <> (show resp)@@ -493,100 +545,108 @@  -- Control commands -login :: Handle -> String -> String -> IO FTPResponse+login :: MonadIO m => Handle -> String -> String -> m FTPResponse login h user pass = last <$> sendCommands h [User user, Pass pass] -pasv :: Handle -> IO (String, Int)+pasv :: MonadIO m => Handle -> m (String, Int) pasv h = do     resp <- sendCommand h Pasv     let (Right (host, portNum)) = parseOnly parse227 (frMessage resp)     return (host, portNum) -port :: Handle -> S.HostAddress -> S.PortNumber -> IO FTPResponse+port :: MonadIO m => Handle -> S.HostAddress -> S.PortNumber -> m FTPResponse port h ha pn = sendCommand h (Port ha pn) -acct :: Handle -> String -> IO FTPResponse+acct :: MonadIO m => Handle -> String -> m FTPResponse acct h pass = sendCommand h (Acct pass) -rename :: Handle -> String -> String -> IO FTPResponse+rename :: MonadIO m => Handle -> String -> String -> m FTPResponse rename h from to = do     res <- sendCommand h (Rnfr from)     case frStatus res of         Continue -> sendCommand h (Rnto to)         _ -> return res -dele :: Handle -> String -> IO FTPResponse+dele :: MonadIO m => Handle -> String -> m FTPResponse dele h file = sendCommand h (Dele file) -cwd :: Handle -> String -> IO FTPResponse+cwd :: MonadIO m => Handle -> String -> m FTPResponse cwd h dir =     sendCommand h $ if dir == ".."         then Cdup         else Cwd dir -size :: Handle -> String -> IO Int+size :: MonadIO m => Handle -> String -> m Int size h file = do     resp <- sendCommand h (Size file)     return $ read $ C.unpack $ frMessage resp -mkd :: Handle -> String -> IO String+mkd :: MonadIO m => Handle -> String -> m String mkd h dir = do     resp <- sendCommand h (Mkd dir)     let (Right dir) = parseOnly parse257 (frMessage resp)     return dir -rmd :: Handle -> String -> IO FTPResponse+rmd :: MonadIO m => Handle -> String -> m FTPResponse rmd h dir = sendCommand h (Rmd dir) -pwd :: Handle -> IO String+pwd :: MonadIO m => Handle -> m String pwd h = do     resp <- sendCommand h Pwd     let (Right dir) = parseOnly parse257 (frMessage resp)     return dir -quit :: Handle -> IO FTPResponse+quit :: MonadIO m => Handle -> m FTPResponse quit h = sendCommand h Quit  -- TLS commands -pbsz :: Handle -> Int -> IO FTPResponse+pbsz :: MonadIO m => Handle -> Int -> m FTPResponse pbsz h = sendCommand h . Pbsz -prot :: Handle -> ProtType -> IO FTPResponse+prot :: MonadIO m => Handle -> ProtType -> m FTPResponse prot h = sendCommand h . Prot -ccc :: Handle -> IO FTPResponse+ccc :: MonadIO m => Handle -> m FTPResponse ccc h = sendCommand h Ccc -auth :: Handle -> IO FTPResponse+auth :: MonadIO m => Handle -> m FTPResponse auth h = sendCommand h Auth  -- Data commands -sendType :: RTypeCode -> ByteString -> Handle -> IO ()+sendType :: MonadIO m => RTypeCode -> ByteString -> Handle -> m () sendType TA dat h = void $ mapM (sendCommandLine h) $ C.split '\n' dat-sendType TI dat h = send h dat+sendType TI dat h = liftIO $ send h dat  withDataCommandSecurity-    :: Handle+    :: (MonadIO m, MonadMask m)+    => Handle     -> PortActivity     -> [FTPCommand]-    -> (Handle -> IO a)-    -> IO a+    -> (Handle -> m a)+    -> m a withDataCommandSecurity h =     case security h of         Clear -> withDataCommand h         TLS -> withTLSDataCommand h -nlst :: Handle -> [String] -> IO ByteString+nlst :: (MonadIO m, MonadMask m) => Handle -> [String] -> m ByteString nlst h args = withDataCommandSecurity h Passive [RType TA, Nlst args] getAllLineResp -retr :: Handle -> String -> IO ByteString+retr :: (MonadIO m, MonadMask m) => Handle -> String -> m ByteString retr h path = withDataCommandSecurity h Passive [RType TI, Retr path] recvAll -list :: Handle -> [String] -> IO ByteString+list :: (MonadIO m, MonadMask m) => Handle -> [String] -> m ByteString list h args = withDataCommandSecurity h Passive [RType TA, List args] recvAll -stor :: Handle -> String -> B.ByteString -> RTypeCode -> IO ()+stor+    :: (MonadIO m, MonadMask m)+    => Handle+    -> String+    -> B.ByteString+    -> RTypeCode+    -> m () stor h loc dat rtype =-    withDataCommandSecurity h Passive [RType rtype, Stor loc] $ sendType rtype dat+    withDataCommandSecurity h Passive [RType rtype, Stor loc]+        $ sendType rtype dat