ftp-client 0.5.1.2 → 0.5.1.3

raw patch · 4 files changed

+107/−27 lines, 4 filesdep +ftp-clientdep +tastydep +tasty-hspecdep ~exceptionsdep ~transformersPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: ftp-client, tasty, tasty-hspec

Dependency ranges changed: exceptions, transformers

API changes (from Hackage documentation)

Files

• ftp-client.cabal +9/−5
• src/Network/FTP/Client.hs +23/−20
• test/Spec.hs +0/−2
• test/test.hs +75/−0

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: ftp-client-version: 0.5.1.2+version: 0.5.1.3 license: PublicDomain license-file: LICENSE maintainer: mrobinson7627@gmail.com@@ -30,15 +30,19 @@         network >=2.6.3.6 && <2.9,         attoparsec >=0.10 && <0.14,         connection >=0.2 && <0.4,-        transformers >=0.5.5.0 && <0.6,-        exceptions >=0.10.0 && <0.11,+        transformers >=0.5.6.2 && <0.6,+        exceptions >=0.10.3 && <0.11,         containers >=0.5.11.0 && <0.7  test-suite ftp-client-test     type: exitcode-stdio-1.0-    main-is: Spec.hs+    main-is: test.hs     hs-source-dirs: test     default-language: Haskell2010     ghc-options: -threaded -rtsopts -with-rtsopts=-N     build-depends:-        base >=4.11.1.0 && <5+        base >=4.11.1.0 && <5,+        bytestring >=0.10.8.2 && <0.11,+        tasty >=1.2.3 && <1.3,+        tasty-hspec >=1.1.5.1 && <1.2,+        ftp-client -any

@@ -30,6 +30,7 @@     -- * Types     FTPCommand(..),     FTPResponse(..),+    FTPMessage(..),     ResponseStatus(..),     MlsxResponse(..),     RTypeCode(..),@@ -45,6 +46,7 @@     -- * Lower Level Functions     sendCommand,     sendCommandS,+    recvAll,     sendAll,     sendAllS,     getLineResp,@@ -80,15 +82,13 @@ import Data.Typeable  debugging :: Bool-debugging = True+debugging = False  debugPrint :: (Show a, MonadIO m) => a -> m ()-debugPrint s = if debugging-    then return ()-    else liftIO $ print s+debugPrint s = when debugging (liftIO $ print s)  debugResponse :: (Show a, MonadIO m) => a -> m ()-debugResponse s = debugPrint $ "Recieved: " <> (show s)+debugResponse s = debugPrint $ "Recieved: " <> show s  data Security = Clear | TLS @@ -102,6 +102,7 @@     }  data FTPMessage = SingleLine ByteString | MultiLine [ByteString]+    deriving Eq  instance Show FTPMessage where     show (SingleLine message) = C.unpack message@@ -112,10 +113,10 @@     frStatus :: ResponseStatus, -- ^ Interpretation of the first digit of an FTP response code     frCode :: Int, -- ^ The three digit response code     frMessage :: FTPMessage -- ^ Text of the response-}+} deriving Eq  instance Show FTPResponse where-    show fr = (show $ frCode fr) <> " " <> (show $ frMessage fr)+    show fr = show (frCode fr) <> " " <> show (frMessage fr)  -- | First digit of an FTP response data ResponseStatus@@ -203,11 +204,11 @@ serializeCommand (RType rt)   = "TYPE " <> serialzeRTypeCode rt serializeCommand (Retr file)  = "RETR " <> file serializeCommand (Nlst [])    = "NLST"-serializeCommand (Nlst args)  = "NLST " <> intercalate " " args+serializeCommand (Nlst args)  = "NLST " <> unwords args serializeCommand (Port ha pn) = "PORT " <> formatPort ha pn serializeCommand (Stor loc)   = "STOR " <> loc serializeCommand (List [])    = "LIST"-serializeCommand (List args)  = "LIST " <> intercalate " " args+serializeCommand (List args)  = "LIST " <> unwords args serializeCommand (Rnfr from)  = "RNFR " <> from serializeCommand (Rnto to)    = "RNTO " <> to serializeCommand (Dele file)  = "DELE " <> file@@ -248,7 +249,7 @@             SingleLine message -> SingleLine $ C.drop 4 message             MultiLine [] -> MultiLine []             MultiLine (message:messages) ->-                MultiLine ((C.drop 4 message):messages)+                MultiLine $ C.drop 4 message : messages     let response = FTPResponse             (responseStatus code)             (read $ C.unpack code)@@ -343,7 +344,7 @@         (createSocket (Just host) portNum hints)         (liftIO . S.close . fst)         (\(sock, addr) -> do-            debugPrint $ "Connecting"+            debugPrint "Connecting"             liftIO $ S.connect sock (S.addrAddress addr)             debugPrint "Connected"             f sock@@ -468,7 +469,7 @@     => Handle     -> PortActivity     -> FTPCommand-    -> m (SIO.Handle)+    -> m SIO.Handle createSendDataCommand h pa cmd = withDataSocket pa h $ \socket -> do     resp <- sendCommand h cmd     ensureSucessfulData h resp@@ -509,8 +510,10 @@     where         recvAll' bs = ( do             chunk <- liftIO $ recv h defaultChunkSize-            recvAll' $ bs <> chunk)-                `M.catchIOError` (\_ -> return bs)+            if C.null chunk+               then return bs+               else recvAll' $ bs <> chunk+            ) `M.catchIOError` (\_ -> return bs)  -- TLS connection @@ -578,7 +581,7 @@     -> Int     -> (Handle -> FTPResponse -> m a)     -> m a-withFTPS host portNum = withTLSHandle host portNum+withFTPS = withTLSHandle  -- TLS data connection @@ -600,7 +603,7 @@           (S.SockAddrInet p h) <- S.getSocketName acceptedSock           return (p, h)         let (h1, h2, h3, h4) = S.hostAddressToTuple sHost-            hostName = intercalate "." $ (show . fromEnum) <$> [h1, h2, h3, h4]+            hostName = intercalate "." $ show . fromEnum <$> [h1, h2, h3, h4]         h <- liftIO $ S.socketToHandle acceptedSock SIO.ReadWriteMode         liftIO $ connectTLS h hostName (fromEnum sPort) @@ -619,7 +622,7 @@         (liftIO . connectionClose)         (f . tlsHandleImpl)     resp <- getResponse ch-    debugPrint $ "Recieved: " <> (show resp)+    debugPrint $ "Recieved: " <> show resp     return x  parseResponse :: MonadIO m => FTPResponse -> Parser a -> m a@@ -692,7 +695,7 @@     resp <- sendCommandS h (Size file)     ensureCode resp 213     return $ case frMessage resp of-        SingleLine message -> read $ C.unpack $ message+        SingleLine message -> read . C.unpack $ message         MultiLine _ -> 0  mkd :: MonadIO m => Handle -> String -> m String@@ -739,7 +742,7 @@ -- Data commands  sendType :: MonadIO m => RTypeCode -> ByteString -> Handle -> m ()-sendType TA dat h = void $ mapM (sendCommandLine h) $ C.split '\n' dat+sendType TA dat h = mapM_ (sendCommandLine h) $ C.split '\n' dat sendType TI dat h = liftIO $ send h dat  withDataCommandSecurity@@ -802,7 +805,7 @@             getMlsxResponse' h $                 if C.null line                     then ret-                    else (parseMlsxLine line):ret+                    else parseMlsxLine line : ret             ) `M.catchIOError` (\_ -> return ret)  mlsd :: (MonadIO m, MonadMask m) => Handle -> String -> m [MlsxResponse]

@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"

@@ -0,0 +1,75 @@+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C+import Test.Tasty+import Test.Tasty.Hspec+import Network.FTP.Client hiding (Success)+import qualified Network.FTP.Client as F+import Control.Monad.IO.Class+import Control.Concurrent.MVar++data TestHandleMVars = TestHandleMVars+    { thmSend :: MVar [ByteString]+    , thmSendLine :: MVar [ByteString]+    , thmRecv :: MVar [Int]+    }++data TestHandle = TestHandle TestHandleMVars Handle++testHandle+    :: [ByteString]+    -> [ByteString]+    -> Security+    -> IO TestHandle+testHandle recvResps recvLineResps sec = do+    sendMVar <- newMVar []+    sendLineMVar <- newMVar []+    recvMVar <- newMVar []+    recvCount <- newMVar 0+    recvLineCount <- newMVar 0+    let testHandleMVars = TestHandleMVars+            sendMVar sendLineMVar recvMVar+        handle = Handle+            { send = \s ->+                modifyMVar_ sendMVar+                    (\ss -> return $ ss <> [s])+            , sendLine = \s ->+                modifyMVar_ sendLineMVar+                    (\ss -> return $ ss <> [s])+            , recv = \i -> do+                modifyMVar_ recvMVar+                    (\is -> return $ is <> [i])+                (recvResps !!) <$> modifyMVar recvCount+                    (\i -> return (i + 1, i))+            , recvLine =+                (recvLineResps !!) <$> modifyMVar recvLineCount+                    (\i -> return (i + 1, i))+            , security = sec+            }+    return $ TestHandle testHandleMVars handle++main :: IO ()+main = hspec $ do+    describe "Network.FTP.Client.sendCommand" $ do+        it "sends USER for User" $ do+            let expected = FTPResponse+                    F.Success 200+                    (SingleLine $ C.pack "Ok")+            (TestHandle mvars h) <- testHandle [] [C.pack "200 Ok"] Clear+            sendCommand h (User "megan") `shouldReturn` expected+            takeMVar (thmSend mvars) `shouldReturn` [C.pack "USER megan\r\n"]+        it "sends USER for User and receives a multiline response" $ do+            let expected = FTPResponse+                    F.Success 200+                    (MultiLine [C.pack "line1", C.pack "line2", C.pack "200 line3"])+            (TestHandle mvars h) <- testHandle []+                [ C.pack "200-line1\r\n"+                , C.pack "line2\r\n"+                , C.pack "200 line3\r\n"+                ] Clear+            sendCommand h (User "megan") `shouldReturn` expected+            takeMVar (thmSend mvars) `shouldReturn` [C.pack "USER megan\r\n"]+    describe "Network.FTP.Client.recvAll" $+        it "doesn't hang on empty response" $ do+            let expected = C.pack ""+            (TestHandle mvars h) <- testHandle [C.pack ""] [] Clear+            recvAll h `shouldReturn` expected