diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Jan Gerlinger + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +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 OR COPYRIGHT HOLDERS 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/irc-dcc.cabal b/irc-dcc.cabal new file mode 100644 --- /dev/null +++ b/irc-dcc.cabal @@ -0,0 +1,66 @@ +name: irc-dcc +version: 1.0.0 +synopsis: A DCC message parsing and helper library for IRC clients +description: DCC (Direct Client-to-Client) is an IRC sub-protocol for + establishing and maintaining direct connections to + exchange messages and files. + . + See for + more details. +license: MIT +license-file: LICENSE +homepage: https://github.com/JanGe/irc-dcc +bug-reports: https://github.com/JanGe/irc-dcc/issues +author: Jan Gerlinger +maintainer: git@jangerlinger.de +category: Network +-- copyright: +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Network.IRC.DCC + , Network.IRC.DCC.FileTransfer + other-modules: Network.IRC.DCC.Internal + , Network.Socket.ByteString.Extended + -- other-extensions: + build-depends: base >= 4.7 && < 5 + , attoparsec + , binary + , bytestring + , errors + , io-streams + , iproute + , irc-ctcp + , network + , path + , transformers + , utf8-string + default-language: Haskell2010 + ghc-options: -Wall -fno-warn-unused-do-bind + +test-suite tests + hs-source-dirs: tests + , src + main-is: Main.hs + other-modules: Network.IRC.DCCTest + , Network.IRC.DCC.Internal + type: exitcode-stdio-1.0 + build-depends: base >= 4.7 && < 5 + , tasty + , tasty-hspec + , hspec-attoparsec + , attoparsec + , binary + , bytestring + , iproute + , irc-ctcp + , network + , path + , utf8-string + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/JanGe/irc-dcc.git diff --git a/src/Network/IRC/DCC.hs b/src/Network/IRC/DCC.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/DCC.hs @@ -0,0 +1,30 @@ +module Network.IRC.DCC ( + -- * Types + -- ** DCC service + CtcpCommand(..) + , Service(..) + -- ** Messaging commands (DCC CHAT) + , OpenChat(..) + , CloseChat(..) + -- ** File Transfer commands (DCC SEND) + , OfferFile(..) + , TryResumeFile(..) + , AcceptResumeFile(..) + , OfferFileSink(..) + -- *** Helper Types + , TransferType(..) + , FileMetadata(..) + , Token(..) + , FileOffset + -- * DCC command parsing + , runParser + , parseService + , parseOpenChat + , parseCloseChat + , parseOfferFile + , parseTryResumeFile + , parseAcceptResumeFile + , parseOfferFileSink + ) where + +import Network.IRC.DCC.Internal diff --git a/src/Network/IRC/DCC/FileTransfer.hs b/src/Network/IRC/DCC/FileTransfer.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/DCC/FileTransfer.hs @@ -0,0 +1,79 @@ +{-| Functions for receiving files. + + Each chunk is acknowledged by sending the total sum of bytes received for a + file. See the + . +-} +module Network.IRC.DCC.FileTransfer + ( acceptFile + , resumeFile + ) where + +import Network.IRC.DCC.Internal + +import Control.Error +import Control.Monad (unless) +import Data.ByteString.Char8 (ByteString, length, null) +import Network.Socket.ByteString.Extended +import Path (File, Path, Rel, + fromRelFile) +import Prelude hiding (length, null) +import System.IO (BufferMode (NoBuffering), IOMode (WriteMode, AppendMode)) +import System.IO.Streams (OutputStream, + withFileAsOutputExt, write) + +-- | Accept a DCC file offer +acceptFile :: Integral a + => OfferFile + -> (PortNumber -> ExceptT String IO ()) + -- ^ Callback when socket is ready + -> (a -> IO ()) + -- ^ Callback when a chunk of data was transfered + -> ExceptT String IO () +acceptFile (OfferFile tt f) = + download (fileName f) WriteMode 0 tt + +-- | Accept a DCC file offer for a partially downloaded file +resumeFile :: Integral a + => AcceptResumeFile + -> (PortNumber -> ExceptT String IO ()) + -- ^ Callback when socket is ready + -> (a -> IO ()) + -- ^ Callback when a chunk of data was transfered + -> ExceptT String IO () +resumeFile (AcceptResumeFile tt f pos) = + download (fileName f) AppendMode (fromIntegral pos) tt + +download :: Integral a + => Path Rel File + -> IOMode + -> a + -> TransferType + -> (PortNumber -> ExceptT String IO ()) + -> (a -> IO ()) + -> ExceptT String IO () +download fn mode pos tt onListen onChunk = + withSocket tt onListen $ + toFile (fromRelFile fn) . stream pos onChunk + where withSocket (Active i p) = withActiveSocket i p + withSocket (Passive i _) = withPassiveSocket i + toFile f = withFileAsOutputExt f mode NoBuffering + +stream :: Integral a + => a + -> (a -> IO ()) + -> Socket + -> OutputStream ByteString + -> IO () +stream pos onChunk sock h = + do buf <- recv sock (4096 * 1024) + unless (null buf) $ + do let l = fromIntegral (length buf) + onChunk l + let pos' = pos + l + sendPosition sock pos' + Just buf `write` h + stream pos' onChunk sock h + +sendPosition :: Integral a => Socket -> a -> IO () +sendPosition sock = sendAll sock . toNetworkByteOrder diff --git a/src/Network/IRC/DCC/Internal.hs b/src/Network/IRC/DCC/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/DCC/Internal.hs @@ -0,0 +1,332 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.IRC.DCC.Internal where + +import Control.Applicative +import Control.Monad (when) +import Data.Attoparsec.ByteString.Char8 +import Data.Binary (byteSwap32) +import Data.ByteString.Char8 (ByteString, pack) +import qualified Data.ByteString.UTF8 as UTF8 (toString) +import Data.IP (IPv4, fromHostAddress, + toHostAddress) +import Data.Monoid ((<>)) +import Data.Word (Word64) +import Network.IRC.CTCP (CTCPByteString, decodeCTCP, + encodeCTCP) +import Network.Socket (PortNumber) +import Path (File, Path, Rel, filename, + fromRelFile, parseAbsFile, + parseRelFile) + +-- | Type of DCC service offered +data Service + -- | Offer chat session + = Messaging OpenChat + -- | Offer file transfer + | FileTransfer OfferFile + deriving (Eq, Show) + +-- | Type of DCC chat to open +data OpenChat + -- | Text messages exchange + = Chat IPv4 PortNumber + -- | Drawing commands exchange + | Whiteboard IPv4 PortNumber + deriving (Eq, Show) + +-- | Signal intent to close DCC chat connection +data CloseChat = CloseChat + +-- | DCC file transfer instructions +data OfferFile = OfferFile TransferType FileMetadata + deriving (Eq, Show) + +-- | Signal intent to resume DCC file transfer at specific position +data TryResumeFile = TryResumeFile TransferType FileMetadata FileOffset + deriving (Eq, Show) + +-- | Signal acceptance to resume DCC file transfer at specific position +data AcceptResumeFile = AcceptResumeFile TransferType FileMetadata FileOffset + deriving (Eq, Show) + +-- | Signal readiness to accept a connection +data OfferFileSink = OfferFileSink Token FileMetadata IPv4 PortNumber + deriving (Eq, Show) + +-- | Type of a DCC file transfer connection +data TransferType + -- | Connection where the owner of the file offers a socket to connect to + = Active IPv4 PortNumber + -- | Connection where the recipient of the file offers a socket to connect to + | Passive IPv4 Token + deriving (Eq, Show) + +-- | Properties of a file +data FileMetadata = FileMetadata { fileName :: Path Rel File + , fileSize :: Maybe FileOffset } + deriving (Eq, Show) + +-- | An identifier for knowing which negotiation a request belongs to +data Token = Token ByteString + deriving (Eq, Show) + +type FileOffset = Word64 + +-- | Class for types that can be sent as CTCP commands +class CtcpCommand a where + encodeCtcp :: a -> CTCPByteString + +instance CtcpCommand ByteString where + encodeCtcp = encodeCTCP + +instance CtcpCommand OpenChat where + encodeCtcp = encodeCtcp . encodeOpenChat + +instance CtcpCommand CloseChat where + encodeCtcp = encodeCtcp . encodeChatClose + +instance CtcpCommand OfferFile where + encodeCtcp = encodeCtcp . encodeOfferFile + +instance CtcpCommand TryResumeFile where + encodeCtcp = encodeCtcp . encodeTryResumeFile + +instance CtcpCommand AcceptResumeFile where + encodeCtcp = encodeCtcp . encodeAcceptResume + +instance CtcpCommand OfferFileSink where + encodeCtcp = encodeCtcp . encodeOfferFileSink + +runParser :: Parser a -> CTCPByteString -> Either String a +runParser p = parseOnly p . decodeCTCP + +parseService :: Parser Service +parseService = Messaging <$> parseOpenChat + <|> FileTransfer <$> parseOfferFile + +encodeService :: Service -> ByteString +encodeService (Messaging m) = encodeOpenChat m +encodeService (FileTransfer o) = encodeOfferFile o + +parseOpenChat :: Parser OpenChat +parseOpenChat = choice [ do "DCC CHAT chat " + (i, p) <- parseSocket + endOfInput + return $ Chat i p + , do "DCC CHAT wboard " + (i, p) <- parseSocket + endOfInput + return $ Whiteboard i p + ] + +encodeOpenChat :: OpenChat -> ByteString +encodeOpenChat (Chat i p) = "DCC CHAT chat " <> encodeSocket (i, p) +encodeOpenChat (Whiteboard i p) = "DCC CHAT wboard " <> encodeSocket (i, p) + +parseCloseChat :: Parser CloseChat +parseCloseChat = do "DCC CLOSE" + endOfInput + return CloseChat + +encodeChatClose :: CloseChat -> ByteString +encodeChatClose _ = "DCC CLOSE" + +parseOfferFile :: Parser OfferFile +parseOfferFile = + do "DCC SEND " + fn <- parseFileName + space + i <- parseIpBigEndian + space + choice [ do p <- parseTcpPort + fs <- Just <$> (space *> parseFileOffset) + <|> return Nothing + endOfInput + return (OfferFile + (Active i p) + (FileMetadata fn fs)) + , do "0" + space + fs <- parseFileOffset + space + t <- parseToken + endOfInput + return (OfferFile + (Passive i t) + (FileMetadata fn (Just fs))) + ] + +encodeOfferFile :: OfferFile -> ByteString +encodeOfferFile (OfferFile (Active i p) (FileMetadata fn fs)) = + "DCC SEND " + <> encodeFileName fn + <> " " <> encodeIpBigEndian i + <> " " <> encodeTcpPort p + <> appendSpacedIfJust (encodeFileOffset <$> fs) +encodeOfferFile (OfferFile (Passive i t) (FileMetadata fn fs)) = + "DCC SEND " + <> encodeFileName fn + <> " " <> encodeIpBigEndian i + <> " 0" + <> appendSpacedIfJust (encodeFileOffset <$> fs) + <> " " <> encodeToken t + +parseTryResumeFile :: OfferFile -> Parser TryResumeFile +parseTryResumeFile (OfferFile tt f) = + do "DCC RESUME" + space + fn' <- parseFileName + when (fn' /= fileName f) $ + fail "File name for resume didn't match file name in offer." + space + pos <- case tt of + Active _ p -> do + string (encodeTcpPort p) + space + parseFileOffset + Passive _ t -> do + "0" + space + pos <- parseFileOffset + space + string (encodeToken t) + return pos + endOfInput + return (TryResumeFile tt f pos) + + +encodeTryResumeFile :: TryResumeFile -> ByteString +encodeTryResumeFile (TryResumeFile (Active _ p) (FileMetadata fn _) pos) = + "DCC RESUME " + <> encodeFileName fn + <> " " <> encodeTcpPort p + <> " " <> encodeFileOffset pos +encodeTryResumeFile (TryResumeFile (Passive _ t) (FileMetadata fn _) pos) = + "DCC RESUME " + <> encodeFileName fn + <> " 0 " + <> encodeFileOffset pos + <> " " <> encodeToken t + +parseAcceptResumeFile :: TryResumeFile -> Parser AcceptResumeFile +parseAcceptResumeFile (TryResumeFile tt f _) = + do "DCC ACCEPT " + fn' <- parseFileName + when (fn' /= fileName f) $ + fail "File name for accepting resume didn't match file name in offer." + space + ackPos <- case tt of + Active _ p -> do + string (encodeTcpPort p) + space + parseFileOffset + Passive _ t -> do + "0" + space + ackPos <- parseFileOffset + space + string (encodeToken t) + return ackPos + endOfInput + return (AcceptResumeFile tt f ackPos) + +encodeAcceptResume :: AcceptResumeFile -> ByteString +encodeAcceptResume (AcceptResumeFile (Active _ p) (FileMetadata fn _) pos) = + "DCC ACCEPT " + <> encodeFileName fn + <> " " <> encodeTcpPort p + <> " " <> encodeFileOffset pos +encodeAcceptResume (AcceptResumeFile (Passive _ t) (FileMetadata fn _) pos) = + "DCC ACCEPT " + <> encodeFileName fn + <> " 0 " + <> encodeFileOffset pos + <> " " <> encodeToken t + +parseOfferFileSink :: AcceptResumeFile -> Parser (Maybe OfferFileSink) +parseOfferFileSink (AcceptResumeFile (Passive _ t) f _) = + do "DCC SEND " + fn <- parseFileName + when (fn /= fileName f) $ + fail "File name for accepting resume didn't match file name in offer." + space + (i, p) <- parseSocket + string (appendSpacedIfJust (encodeFileOffset <$> fileSize f)) + space + string (encodeToken t) + endOfInput + return (Just (OfferFileSink t f i p)) +parseOfferFileSink _ = return Nothing + +encodeOfferFileSink :: OfferFileSink -> ByteString +encodeOfferFileSink (OfferFileSink t (FileMetadata fn fs) i p) = + "DCC SEND " + <> encodeFileName fn + <> " " <> encodeSocket (i, p) + <> appendSpacedIfJust (encodeFileOffset <$> fs) + <> " " <> encodeToken t + +parseSocket :: Parser (IPv4, PortNumber) +parseSocket = + do i <- parseIpBigEndian + space + p <- parseTcpPort + return (i, p) + +encodeSocket :: (IPv4, PortNumber) -> ByteString +encodeSocket (i, p) = encodeIpBigEndian i <> " " <> encodeTcpPort p + +parseFileName :: Parser (Path Rel File) +parseFileName = do name <- "\"" *> takeWhile1 (/= '"') <* "\"" + <|> takeWhile1 (/= ' ') + case parseRelOrAbs (UTF8.toString name) of + Nothing -> fail "Could not parse file name." + Just path -> return path + where parseRelOrAbs n = parseRelFile n + <|> filename <$> parseAbsFile n + +encodeFileName :: Path Rel File -> ByteString +encodeFileName = pack . fromRelFile + +parseIpBigEndian :: Parser IPv4 +parseIpBigEndian = fromBigEndianIp <$> parseBoundedInteger 0 4294967295 + +encodeIpBigEndian :: IPv4 -> ByteString +encodeIpBigEndian = pack . show . toBigEndianIp + +parseTcpPort :: Parser PortNumber +parseTcpPort = fromInteger <$> parseBoundedInteger 1 65535 + +encodeTcpPort :: PortNumber -> ByteString +encodeTcpPort = pack . show + +parseFileOffset :: Parser FileOffset +parseFileOffset = decimal + +encodeFileOffset :: FileOffset -> ByteString +encodeFileOffset = pack . show + +parseToken :: Parser Token +parseToken = Token <$> takeByteString + +encodeToken :: Token -> ByteString +encodeToken (Token t) = t + +parseBoundedInteger :: Integer -> Integer -> Parser Integer +parseBoundedInteger lower upper = do + num <- decimal + when (num < lower || num > upper) $ + fail ("Failed to parse " ++ show num ++ ", not in range [" ++ + show lower ++ ", " ++ show upper ++ "].") + return num + +appendSpacedIfJust :: Maybe ByteString -> ByteString +appendSpacedIfJust (Just x) = " " <> x +appendSpacedIfJust Nothing = mempty + +fromBigEndianIp :: Integer -> IPv4 +fromBigEndianIp = fromHostAddress . byteSwap32 . fromIntegral + +toBigEndianIp :: IPv4 -> Integer +toBigEndianIp = fromIntegral . byteSwap32 . toHostAddress diff --git a/src/Network/Socket/ByteString/Extended.hs b/src/Network/Socket/ByteString/Extended.hs new file mode 100644 --- /dev/null +++ b/src/Network/Socket/ByteString/Extended.hs @@ -0,0 +1,70 @@ +-- | Common functions simplyfing the use of "Network.Socket.ByteString" +module Network.Socket.ByteString.Extended + ( module Network.Socket + , module Network.Socket.ByteString + , withActiveSocket + , withPassiveSocket + , toNetworkByteOrder + ) where + +import Control.Error +import Control.Monad.IO.Class (liftIO) +import Data.Binary.Put (putWord32be, runPut) +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Lazy.Char8 as Lazy (toStrict) +import Data.IP (IPv4, fromHostAddress, + toHostAddress) +import Network.Socket hiding (recv, recvFrom, send, + sendTo) +import Network.Socket.ByteString +import System.Timeout + +-- | Run functions on socket when connected and close socket afterwards +withActiveSocket :: IPv4 + -> PortNumber + -> (PortNumber -> ExceptT String IO ()) + -- ^ Callback when socket is ready + -> (Socket -> IO ()) + -- ^ Callback when socket is connected to server + -> ExceptT String IO () +withActiveSocket i p onListen onConnected = do + liftIO $ return withSocketsDo + sock <- liftIO $ socket AF_INET Stream defaultProtocol + onListen p + liftIO $ connect sock (SockAddrInet p (toHostAddress i)) + liftIO $ onConnected sock + liftIO $ sClose sock + +{- | Run functions on passive socket when listening and when connected and close + socket afterwards. +-} +withPassiveSocket :: IPv4 + -> (PortNumber -> ExceptT String IO ()) + -- ^ Callback when socket is open and listening + -> (Socket -> IO ()) + -- ^ Callback when client connected to socket + -> ExceptT String IO () +withPassiveSocket i onListen onConnected = do + liftIO $ return withSocketsDo + sock <- liftIO $ socket AF_INET Stream defaultProtocol + liftIO $ bind sock (SockAddrInet aNY_PORT iNADDR_ANY) + liftIO $ listen sock 1 + p <- liftIO $ socketPort sock + onListen p + accepted <- liftIO $ timeout 10000000 $ accept sock + case accepted of + Just (con, SockAddrInet _ client) + | client == toHostAddress i -> liftIO $ do onConnected con + sClose con + | otherwise -> do liftIO $ sClose con + throwE ( "Expected connection from host " + ++ show (fromHostAddress client) + ++ ", not from " ++ show i ++". Aborting…\n" ) + + _ -> throwE ( "Timeout when waiting for other party to connect on port " + ++ show p ++ "…\n") + liftIO $ sClose sock + +-- | Converts numbers to a '32bit unsigned int' in network byte order. +toNetworkByteOrder :: Integral a => a -> ByteString +toNetworkByteOrder = Lazy.toStrict . runPut . putWord32be . fromIntegral diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,10 @@ +module Main where + +import qualified Network.IRC.DCCTest as DCC +import Test.Tasty +import Test.Tasty.Hspec + +main = tests + +tests :: IO () +tests = DCC.spec >>= defaultMain diff --git a/tests/Network/IRC/DCCTest.hs b/tests/Network/IRC/DCCTest.hs new file mode 100644 --- /dev/null +++ b/tests/Network/IRC/DCCTest.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Network.IRC.DCCTest where + +import Network.IRC.DCC.Internal + +import Data.Attoparsec.ByteString.Char8 (IResult (Done, Fail), Parser, + endOfInput, maybeResult, + parse) +import Data.ByteString.Char8 (pack) +import qualified Data.ByteString.UTF8 as UTF8 (fromString) +import Data.IP (IPv4, toIPv4) +import Path (mkRelFile) +import Test.Hspec.Attoparsec +import Test.Tasty (testGroup) +import Test.Tasty.Hspec (SpecWith, describe, it, + testSpec) + +spec = testSpec "DCC message serialization" $ + + describe "Parsing single elements" $ do + + describe "Network byte order IP" $ do + + describe "[SUCCESS]" $ do + + it "Min IPv4" $ + pack "0" ~> parseIpBigEndian + `shouldParse` toIPv4 [0, 0, 0, 0] + + it "Max IPv4" $ + pack "4294967295" ~> parseIpBigEndian + `shouldParse` toIPv4 [255, 255, 255, 255] + + it "Local IPv4" $ + pack "3232235521" ~> parseIpBigEndian + `shouldParse` toIPv4 [192, 168, 0, 1] + + it "Public IPv4" $ + pack "134743044" ~> parseIpBigEndian + `shouldParse` toIPv4 [8, 8, 4, 4] + + it "IPv4 at beginning of stream" $ + pack "0abcd" ~?> parseIpBigEndian + `leavesUnconsumed` pack "abcd" + + describe "[FAILURE]" $ do + + it "Negative IPv4" $ + parseIpBigEndian `shouldFailOn` pack "-1" + + it "Bigger than max IPv4" $ + parseIpBigEndian `shouldFailOn` pack "4294967296" + + it "Max IPv4 with additional digit" $ + parseIpBigEndian `shouldFailOn` pack "42949672950" + + it "Non-digits" $ + parseIpBigEndian `shouldFailOn` pack "abcd" + + it "When not at beginning of stream" $ + parseIpBigEndian `shouldFailOn` pack " 0" + + describe "File name" $ do + + describe "[SUCCESS]" $ do + + it "Without extension" $ + pack "filename" ~> parseFileName + `shouldParse` $(mkRelFile "filename") + + it "With extension" $ + pack "filename.txt" ~> parseFileName + `shouldParse` $(mkRelFile "filename.txt") + + it "Quoted with extension" $ + pack "\"filename.txt\"" ~> parseFileName + `shouldParse` $(mkRelFile "filename.txt") + + it "Quoted with space" $ + pack "\"file name.txt\"" ~> parseFileName + `shouldParse` $(mkRelFile "file name.txt") + + it "UTF8 with em space" $ + UTF8.fromString "file\8195name.txt" ~> parseFileName + `shouldParse` $(mkRelFile "file\8195name.txt") + + it "UTF8 with skin tone modifier" $ + UTF8.fromString "\128110\127997" ~> parseFileName + `shouldParse` $(mkRelFile "\128110\127997") + + it "Quoted UTF8 with space" $ + UTF8.fromString "\"file\8195 name.txt\"" ~> parseFileName + `shouldParse` $(mkRelFile "file\8195 name.txt") + + it "From absolute unix path" $ + pack "/home/user/filename.txt" ~> parseFileName + `shouldParse` $(mkRelFile "filename.txt") + + it "From quoted absolute unix path" $ + pack "\"/home/user/filename.txt\"" ~> parseFileName + `shouldParse` $(mkRelFile "filename.txt") + + it "At beginning of stream" $ + pack "filename 122350" ~?> parseFileName + `leavesUnconsumed` pack " 122350" + +-- TODO Not sure exactly what to do with this yet. On Unix the whole thing +-- could be a file name, while on windows it is obviously an absolute path +-- it "File name from absoulte unix path" $ +-- ("c:\\Users\\user\\filename.txt" ~> parseFileName +-- `shouldParse` $(mkRelFile "filename.txt") + + describe "[FAILURE]" $ do + + it "ASCII filename with space" $ + pack "file name.txt" ~?> parseFileName + `leavesUnconsumed` pack " name.txt" + + it "Not at beginning of stream" $ + parseFileName `shouldFailOn` pack " filename"