irc-dcc 1.2.1 → 2.0.0

raw patch · 11 files changed

+756/−660 lines, 11 filesdep +irc-dccdep +mtldep +safe-exceptionsdep ~basedep ~binarydep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: irc-dcc, mtl, safe-exceptions, tasty-quickcheck

Dependency ranges changed: base, binary, transformers

API changes (from Hackage documentation)

Files

• irc-dcc.cabal +60/−58
• src/Network/IRC/DCC.hs +41/−27
• src/Network/IRC/DCC/Client/FileTransfer.hs +136/−0
• src/Network/IRC/DCC/FileTransfer.hs +0/−85
• src/Network/IRC/DCC/Internal.hs +249/−306
• src/Network/Socket/ByteString/Extended.hs +67/−59
• src/System/IO/Streams/Lifted.hs +32/−0
• test/Network/IRC/DCCTest.hs +166/−0
• test/Spec.hs +5/−0
• tests/Main.hs +0/−7
• tests/Network/IRC/DCCTest.hs +0/−118

@@ -1,65 +1,67 @@-name:                 irc-dcc-version:              1.2.1-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 <http://www.irchelp.org/irchelp/rfc/ctcpspec.html> 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+name:                irc-dcc+version:             2.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 <http://www.irchelp.org/irchelp/rfc/ctcpspec.html> 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:           2016 Jan Gerlinger+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+  hs-source-dirs:      src+  exposed-modules:     Network.IRC.DCC+                     , Network.IRC.DCC.Internal+                     , Network.IRC.DCC.Client.FileTransfer+  other-modules:       Network.Socket.ByteString.Extended+                     , System.IO.Streams.Lifted   -- other-extensions:-  build-depends:        base         >= 4.7      && < 5-                      , attoparsec   >= 0.13.0.1 && < 0.14-                      , binary       >= 0.7.5.0-                      , bytestring   >= 0.10.6.0 && < 0.11-                      , errors       >= 2.1.2    && < 2.2-                      , io-streams   >= 1.3.5.0  && < 1.4-                      , iproute      >= 1.7.0    && < 1.8-                      , irc-ctcp     >= 0.1.3.0  && < 0.2-                      , network      >= 2.6.2.1  && < 2.7-                      , path         >= 0.5.7    && < 0.6-                      , transformers >= 0.4.2.0-                      , utf8-string  >= 1.0.1.1  && < 1.1-  default-language:     Haskell2010-  ghc-options:          -Wall -fno-warn-unused-do-bind+  build-depends:       base            >= 4.8      && < 5+                     , attoparsec      >= 0.13.0.1 && < 0.14+                     , binary          >= 0.7.5.0  && < 0.9+                     , bytestring      >= 0.10.6.0 && < 0.11+                     , errors          >= 2.1.2    && < 2.2+                     , io-streams      >= 1.3.5.0  && < 1.4+                     , iproute         >= 1.7.0    && < 1.8+                     , irc-ctcp        >= 0.1.3.0  && < 0.2+                     , mtl             >= 2.2.1    && < 2.3+                     , network         >= 2.6.2.1  && < 2.7+                     , path            >= 0.5.7    && < 0.6+                     , safe-exceptions >= 0.1.2.0  && < 0.2+                     , transformers    >= 0.4.2.0  && < 0.6+                     , utf8-string     >= 1.0.1.1  && < 1.1+  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            >= 0.11.0.2 && < 0.12-                      , tasty-hspec      >= 1.1.2    && < 1.2-                      , hspec-attoparsec >= 0.1.0.2  && < 0.2-                      , attoparsec       >= 0.13.0.1 && < 0.14-                      , binary           >= 0.7.5.0-                      , bytestring       >= 0.10.6.0 && < 0.11-                      , iproute          >= 1.7.0    && < 1.8-                      , irc-ctcp         >= 0.1.3.0  && < 0.2-                      , network          >= 2.6.2.1  && < 2.7-                      , path             >= 0.5.7    && < 0.6-                      , utf8-string      >= 1.0.1.1  && < 1.1-  default-language:     Haskell2010+test-suite irc-dcc-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Network.IRC.DCCTest+  build-depends:       base             >= 4.8      && < 5+                     , bytestring       >= 0.10.6.0 && < 0.11+                     , hspec-attoparsec >= 0.1.0.2  && < 0.2+                     , iproute          >= 1.7.0    && < 1.8+                     , irc-dcc+                     , network          >= 2.6.2.1  && < 2.7+                     , path             >= 0.5.7    && < 0.6+                     , utf8-string      >= 1.0.1.1  && < 1.1+                     , tasty            >= 0.11.0.2 && < 0.12+                     , tasty-hspec      >= 1.1.2    && < 1.2+                     , tasty-quickcheck >= 0.8.4    && < 0.9+  ghc-options:         -Wall -fno-warn-orphans+                       -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010  source-repository head   type:     git

@@ -1,40 +1,54 @@ {-| DCC command parsing and encoding module. -    Example of parsing an offer file command:+    Use the 'CtcpCommand' type class to convert between 'CTCPByteString's+    and typed values. -    > runParser parseOfferFile ctcpMessage+    Try converting a 'CTCPByteString' to a 'DccSend' value: -    Example of encoding an offer file command:+    > fromCtcp ctcpMessage :: Either String DccSend -    > encodeCtcp offerFile+    Encoding a 'DccSend' value to a 'CTCPByteString':++    > toCtcp (Send fileName ip port (Just fileSize)) -} module Network.IRC.DCC (-  -- * Types-  -- ** DCC service+  -- * DCC command parsing and encoding     CtcpCommand(..)-  , Service(..)+  -- * DCC command types   -- ** Messaging commands (DCC CHAT)-  , OpenChat(..)-  , CloseChat(..)+  , DccChat(..)+  , DccClose(..)   -- ** File Transfer commands (DCC SEND)-  , OfferFile(..)-  , TryResumeFile(..)-  , AcceptResumeFile(..)-  , OfferFileSink(..)-  -- *** Helper Types-  , TransferType(..)-  , FileMetadata(..)-  , Token(..)+  , DccSend(..)+  , DccResume(..)+  , DccAccept(..)+  , acceptedPosition+  , DccSendReverseClient(..)+  -- *** Constructors from other commands+  , resumeFromSend+  -- *** Protocol variant checks+  , matchesSend+  -- ** Helper Types+  , Path(..)+  , fromPath+  , PathType(..)   , FileOffset-  -- * DCC command parsing-  , runParser-  , parseService-  , parseOpenChat-  , parseCloseChat-  , parseOfferFile-  , parseTryResumeFile-  , parseAcceptResumeFile-  , parseOfferFileSink+  , Token(..)   ) where -import Network.IRC.DCC.Internal+import           Network.IRC.DCC.Internal++-- | Try resuming a file offer+resumeFromSend :: DccSend -> FileOffset -> DccResume+resumeFromSend (Send path' _ port _) pos =+    Resume path' port pos+resumeFromSend (SendReverseServer path' _ _ token') pos =+    ResumeReverse path' pos token'++-- | Check if a 'DccSend' and a 'DccAccept' command are part of the same negotiation.+matchesSend :: DccAccept -> DccSend -> Bool+matchesSend (Accept pathA portA _) (Send pathS _ portS _) =+    pathS == pathA && portS == portA+matchesSend (AcceptReverse pathA _ tokenA) (SendReverseServer pathS _ _ tokenS) =+    pathS == pathA && tokenS == tokenA+matchesSend _ _ = False

@@ -0,0 +1,136 @@+{-# LANGUAGE RecordWildCards #-}++{-| Functions for receiving files.++    Each chunk is acknowledged by sending the total sum of bytes received for a+    file. See the+    <http://www.irchelp.org/irchelp/rfc/ctcpspec.html CTCP specification>.+-}+module Network.IRC.DCC.Client.FileTransfer (+    -- * Start/resume DCC file transfer+      acceptFile+    , resumeFile+    -- * Custom DCC file transfer+    , FileTransfer(..)+    , ConnectionType(..)+    , TransferType(..)+    , transfer+    ) where++import           Network.IRC.DCC++import           Control.Exception.Safe+import           Control.Monad                      (unless)+import           Control.Monad.IO.Class             (MonadIO, liftIO)+import           Control.Monad.Trans.Class          (lift)+import           Control.Monad.Trans.Reader         (ReaderT, ask)+import           Data.ByteString.Char8              (ByteString, length, null)+import           Network.Socket.ByteString.Extended (ConnectionType (..),+                                                     PortNumber, Socket, close,+                                                     connect, recv, sendAll,+                                                     toNetworkByteOrder)+import qualified Path                               as P (File, Path, Rel,+                                                          fromRelFile)+import           Prelude                            hiding (length, null)+import           System.IO                          (BufferMode (NoBuffering), IOMode (AppendMode, WriteMode))+import           System.IO.Streams                  (OutputStream, write)+import           System.IO.Streams.Lifted           (withFileAsOutputExt)++data TransferType = FromStart+                  | ResumeFrom !FileOffset++-- | A description of a file transfer.+--   You can specify a callback that will be called with the number of bytes+--   transfered for each chunk.+data FileTransfer m = Download { _fileName       :: !(P.Path P.Rel P.File)+                               , _connectionType :: !(ConnectionType m)+                               , _transferType   :: !TransferType+                               , _onChunk        :: FileOffset -> m ()+                               }++-- | Accept a DCC file offer+acceptFile :: DccSend+           -> (PortNumber -> IO ())+           -- ^ Callback when socket is ready+           -> (FileOffset -> IO ())+           -- ^ Callback when a chunk of data was transfered+           -> ReaderT (Maybe PortNumber) IO ()+acceptFile = download FromStart++-- | Accept a DCC file offer for a partially downloaded file+resumeFile :: DccSend+           -> DccAccept+           -> (PortNumber -> IO ())+           -- ^ Callback when socket is ready+           -> (FileOffset -> IO ())+           -- ^ Callback when a chunk of data was transferred+           -> ReaderT (Maybe PortNumber) IO ()+resumeFile offer accept+    | accept `matchesSend` offer =+          download (ResumeFrom pos) offer+    | otherwise = fail "You mixed the DCC and Reverse DCC workflow when calling 'resumeFile'."+  where+    pos = acceptedPosition accept++download :: TransferType+         -> DccSend+         -> (PortNumber -> IO ())+         -> (FileOffset -> IO ())+         -> ReaderT (Maybe PortNumber) IO ()+download tt (Send path ip port _) onListen onChunk =+    lift $ transfer Download { _fileName       = fromPath path+                             , _connectionType = Active ip port (onListen port)+                             , _transferType   = tt+                             , _onChunk        = onChunk+                             }+download tt (SendReverseServer path ip _ _) onListen onChunk = do+    port <- ask+    lift $ transfer Download { _fileName       = fromPath path+                             , _connectionType = Passive ip port onListen+                             , _transferType   = tt+                             , _onChunk        = onChunk+                             }++transfer :: (MonadMask m, MonadIO m) => FileTransfer m -> m ()+transfer Download {..} =+    bracket (connect _connectionType)+            (liftIO . close)+            (streamToFile _fileName _transferType _onChunk)++streamToFile :: (MonadMask m, MonadIO m)+             => P.Path P.Rel P.File+             -> TransferType+             -> (FileOffset -> m ())+              -- ^ Callback when a chunk of data was transfered+             -> Socket+             -> m ()+streamToFile name tt onChunk =+    withFileAsOutputExt (P.fromRelFile name) (mode tt) NoBuffering .+        stream (pos tt) onChunk+  where+    mode FromStart      = WriteMode+    mode (ResumeFrom _) = AppendMode+    pos FromStart       = 0+    pos (ResumeFrom p)  = p++stream :: (MonadMask m, MonadIO m)+       => FileOffset+       -> (FileOffset -> m ())+       -> Socket+       -> OutputStream ByteString+       -> m ()+stream pos onChunk sock h = do+    buf <- liftIO $ recv sock (4096 * 1024)+    unless (null buf) $ do+        let len = fromIntegral $ length buf+        onChunk len+        let pos' = pos + len+        sendPosition sock pos'+        liftIO $ Just buf `write` h+        stream pos' onChunk sock h++sendPosition :: (MonadMask m, MonadIO m)+             => Socket+             -> FileOffset+             -> m ()+sendPosition sock = liftIO . sendAll sock . toNetworkByteOrder

@@ -1,85 +0,0 @@-{-| Functions for receiving files.--    Each chunk is acknowledged by sending the total sum of bytes received for a-    file. See the-    <http://www.irchelp.org/irchelp/rfc/ctcpspec.html CTCP specification>.--}-module Network.IRC.DCC.FileTransfer-  ( acceptFile-  , resumeFile-  ) where--import           Network.IRC.DCC.Internal--import           Control.Error-import           Control.Monad                      (unless)-import           Control.Monad.Trans.Class          (lift)-import           Control.Monad.Trans.Reader         (ReaderT, ask)-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 (AppendMode, WriteMode))-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-           -> ReaderT (Maybe PortNumber) (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-           -> ReaderT (Maybe PortNumber) (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 ())-           -- ^ Callback when socket is ready-         -> (a -> IO ())-           -- ^ Callback when a chunk of data was transfered-         -> ReaderT (Maybe PortNumber) (ExceptT String IO) ()-download fn mode pos tt onListen onChunk = do-    localPort <- ask-    lift $-        withSocket tt localPort onListen $-            withFileAsOutputExt (fromRelFile fn) mode NoBuffering .-                stream pos onChunk-  where withSocket (Active i p) _ = withActiveSocket (Sink i p)-        withSocket (Passive i _) p = withPassiveSocket (Source i p)--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

@@ -3,376 +3,319 @@  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)+import           Control.Applicative                ((<|>))+import           Control.Monad                      (when)+import           Data.Attoparsec.ByteString.Char8   (Parser, choice, decimal,+                                                     endOfInput, parseOnly,+                                                     space, takeByteString,+                                                     takeWhile1)+import           Data.Binary                        (byteSwap32)+import           Data.ByteString.Char8              (ByteString, pack, unwords)+import qualified Data.ByteString.UTF8               as UTF8 (fromString,+                                                             toString)+import           Data.IP                            (IPv4, fromHostAddress,+                                                     toHostAddress)+import           Data.Monoid                        ((<>))+import           Data.Word                          (Word64)+import           Network.IRC.CTCP                   (CTCPByteString, decodeCTCP,+                                                     encodeCTCP)+import           Network.Socket.ByteString.Extended (PortNumber)+import qualified Path                               as P (Abs, File, Path, Rel,+                                                          filename, fromAbsFile,+                                                          fromRelFile,+                                                          parseAbsFile,+                                                          parseRelFile)+import           Prelude                            hiding (abs, unwords) --- | Type of DCC service offered-data Service-  -- | Offer chat session-  = Messaging OpenChat-  -- | Offer file transfer-  | FileTransfer OfferFile-  deriving (Eq, Show)+-- | CTCP commands that can be parsed and encoded+class CtcpCommand a where+    toCtcp :: a -> CTCPByteString+    fromCtcp :: CTCPByteString -> Either String a --- | Type of DCC chat to open-data OpenChat+parseCtcp :: Parser a -> CTCPByteString -> Either String a+parseCtcp p = parseOnly (p <* endOfInput) . decodeCTCP++-- | Offer DCC chat session+data DccChat   {-| Text messages exchange        > DCC CHAT chat <ip> <port>   -}-  = Chat IPv4 PortNumber+  = Chat !IPv4 !PortNumber   {-| Drawing commands exchange        > DCC CHAT wboard <ip> <port>   -}-  | Whiteboard IPv4 PortNumber+  | ChatWhiteboard !IPv4 !PortNumber   deriving (Eq, Show) +instance CtcpCommand DccChat where+    toCtcp (Chat ip port) = encodeCTCP $ unwords+        [ "DCC CHAT chat"+        , socketToBS (ip, port)+        ]+    toCtcp (ChatWhiteboard ip port) = encodeCTCP $ unwords+        [ "DCC CHAT wboard"+        , socketToBS (ip, port)+        ]++    fromCtcp = parseCtcp $+      Chat+          <$> ("DCC CHAT chat" *> spaced ipBigEndian)+          <*> spaced tcpPort+      <|> ChatWhiteboard+          <$> ("DCC CHAT wboard" *> spaced ipBigEndian)+          <*> spaced tcpPort+ -- | Signal intent to close DCC chat connection-data CloseChat+data DccClose   -- | > DCC CLOSE-  = CloseChat+  = Close   deriving (Eq, Show) --- | DCC file transfer instructions-data OfferFile-  {-| DCC:--      > DCC SEND <fileName> <ip> <port> (<fileSize>)+instance CtcpCommand DccClose where+    toCtcp Close = encodeCTCP "DCC CLOSE"+    fromCtcp = parseCtcp $ Close <$ "DCC CLOSE" -      Reverse DCC:+-- | Offer DCC file transfer+data DccSend+  {-| As part of the standard DCC protocol, sent by the server -      > DCC SEND <fileName> <ip> 0 <fileSize> <token>+      > DCC SEND <path> <ip> <port> (<fileSize>)   -}-  = OfferFile TransferType FileMetadata-  deriving (Eq, Show)---- | Signal intent to resume DCC file transfer at specific position-data TryResumeFile-  {-| DCC:--      > DCC RESUME <fileName> <port> <position>--      Reverse DCC:+  = Send !Path !IPv4 !PortNumber !(Maybe FileOffset)+  {-| As part of the Reverse DCC protocol, sent by the server -      > DCC RESUME <fileName> 0 <position> <token>-    -}-  = TryResumeFile TransferType FileMetadata FileOffset+      > DCC SEND <path> <ip> 0 <fileSize> <token>+  -}+  | SendReverseServer !Path !IPv4 !FileOffset !Token   deriving (Eq, Show) --- | Signal acceptance to resume DCC file transfer at specific position-data AcceptResumeFile-  {-| DCC:+instance CtcpCommand DccSend where+    toCtcp (Send name ip port size) = encodeCTCP $ unwords+        [ "DCC SEND"+        , pathToBS name+        , ipToBigEndianBS ip+        , tcpPortToBS port ]+        <> maybe "" ((" " <>) . fileOffsetToBS) size+    toCtcp (SendReverseServer name ip size t) = encodeCTCP $ unwords+        [ "DCC SEND"+        , pathToBS name+        , ipToBigEndianBS ip+        , "0"+        , fileOffsetToBS size+        , tokenToBS t+        ] -      > DCC ACCEPT <fileName> <port> <position>+    fromCtcp = parseCtcp $+        Send+            <$> ("DCC SEND" *> spaced path)+            <*> spaced ipBigEndian+            <*> spaced tcpPort+            <*> (Just <$> spaced fileOffset+                <|> return Nothing)+        <|> SendReverseServer+            <$> ("DCC SEND" *> spaced path)+            <*> spaced ipBigEndian+            <*> (spaced "0" *> spaced fileOffset)+            <*> spaced token -      Reverse DCC:+-- | Signal intent to resume DCC file transfer at specific position+data DccResume+  {-| As part of the standard DCC protocol, sent by the client -      > DCC ACCEPT <fileName> 0 <position> <token>+      > DCC RESUME <path> <port> <position>   -}-  = AcceptResumeFile TransferType FileMetadata FileOffset-  deriving (Eq, Show)---- | Signal readiness to accept a connection (only Reverse DCC)-data OfferFileSink-  {-| Reverse DCC:+  = Resume !Path !PortNumber !FileOffset+  {-| As part of the Reverse DCC protocol, sent by the client -      > DCC SEND <fileName> <ip> <port> <fileSize> <token>+      > DCC RESUME <path> 0 <position> <token>   -}-  = 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-newtype Token = Token ByteString+  | ResumeReverse !Path !FileOffset !Token   deriving (Eq, Show) -newtype FileOffset = FileOffset { toWord :: Word64 }-  deriving (Eq, Ord, Num, Integral, Enum, Real, Bounded)--instance Show FileOffset where-  show = show . toWord---- | 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 DccResume where+    toCtcp (Resume name port pos) = encodeCTCP $ unwords+        [ "DCC RESUME"+        , pathToBS name+        , tcpPortToBS port+        , fileOffsetToBS pos+        ]+    toCtcp (ResumeReverse name pos t) = encodeCTCP $ unwords+        [ "DCC RESUME"+        , pathToBS name+        , "0"+        , fileOffsetToBS pos+        , tokenToBS t+        ] -instance CtcpCommand OfferFile where-    encodeCtcp = encodeCtcp . encodeOfferFile+    fromCtcp = parseCtcp $+        Resume+            <$> ("DCC RESUME" *> spaced path)+            <*> spaced tcpPort+            <*> spaced fileOffset+        <|> ResumeReverse+            <$> ("DCC RESUME" *> spaced path)+            <*> (spaced "0" *> spaced fileOffset)+            <*> spaced token -instance CtcpCommand TryResumeFile where-    encodeCtcp = encodeCtcp . encodeTryResumeFile+-- | Signal acceptance to resume DCC file transfer at specific position+data DccAccept+  {-| As part of the standard DCC protocol, sent by the server -instance CtcpCommand AcceptResumeFile where-    encodeCtcp = encodeCtcp . encodeAcceptResume+      > DCC ACCEPT <path> <port> <position>+  -}+  = Accept !Path !PortNumber !FileOffset+  {-| As part of the Reverse DCC protocol, sent by the server -instance CtcpCommand OfferFileSink where-    encodeCtcp = encodeCtcp . encodeOfferFileSink+      > DCC ACCEPT <path> 0 <position> <token>+  -}+  | AcceptReverse !Path !FileOffset !Token+  deriving (Eq, Show) -runParser :: Parser a -> CTCPByteString -> Either String a-runParser p = parseOnly p . decodeCTCP+acceptedPosition :: DccAccept -> FileOffset+acceptedPosition (Accept _ _ pos)        = pos+acceptedPosition (AcceptReverse _ pos _) = pos -parseService :: Parser Service-parseService = Messaging <$> parseOpenChat-           <|> FileTransfer <$> parseOfferFile+instance CtcpCommand DccAccept where+    toCtcp (Accept name port pos) = encodeCTCP $ unwords+        [ "DCC ACCEPT"+        , pathToBS name+        , tcpPortToBS port+        , fileOffsetToBS pos+        ]+    toCtcp (AcceptReverse name pos t) = encodeCTCP $ unwords+        [ "DCC ACCEPT"+        , pathToBS name+        , "0"+        , fileOffsetToBS pos+        , tokenToBS t+        ] -encodeService :: Service -> ByteString-encodeService (Messaging m) = encodeOpenChat m-encodeService (FileTransfer o) = encodeOfferFile o+    fromCtcp = parseCtcp $+        Accept+            <$> ("DCC ACCEPT" *> spaced path)+            <*> spaced tcpPort+            <*> spaced fileOffset+        <|> AcceptReverse+            <$> ("DCC ACCEPT" *> spaced path)+            <*> (spaced "0" *> spaced fileOffset)+            <*> spaced token -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-                       ]+-- | Tell the server to start a DCC file transfer and where it should send the data to.+data DccSendReverseClient+  {-| As part of the Reverse DCC protocol, sent by the client -encodeOpenChat :: OpenChat -> ByteString-encodeOpenChat (Chat i p) = "DCC CHAT chat " <> encodeSocket (i, p)-encodeOpenChat (Whiteboard i p) = "DCC CHAT wboard " <> encodeSocket (i, p)+      > DCC SEND <path> <ip> <port> <fileSize> <token>+  -}+  = SendReverseClient !Path !IPv4 !PortNumber !FileOffset !Token+  deriving (Eq, Show) -parseCloseChat :: Parser CloseChat-parseCloseChat = do "DCC CLOSE"-                    endOfInput-                    return CloseChat+instance CtcpCommand DccSendReverseClient where+  toCtcp (SendReverseClient name ip port size t) = encodeCTCP $ unwords+      [ "DCC SEND"+      , pathToBS name+      , ipToBigEndianBS ip+      , tcpPortToBS port+      , fileOffsetToBS size+      , tokenToBS t+      ] -encodeChatClose :: CloseChat -> ByteString-encodeChatClose _ = "DCC CLOSE"+  fromCtcp = parseCtcp $+      SendReverseClient+          <$> ("DCC SEND" *> spaced path)+          <*> spaced ipBigEndian+          <*> spaced tcpPort+          <*> spaced fileOffset+          <*> spaced token -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)))-              ]+data PathType+  = Simple+  -- ^ A file path without spaces+  | Quoted+  -- ^ A file path that can include spaces and will be quoted when serialized+  deriving (Eq, Show) -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+data Path = Rel PathType (P.Path P.Rel P.File)+          | Abs PathType (P.Path P.Abs P.File)+  deriving (Eq, Show) -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)+fromPath :: Path -> P.Path P.Rel P.File+fromPath (Rel _ name) = name+fromPath (Abs _ name) = P.filename name +path :: Parser Path+path = choice [ quoted >>= parseRelOrAbs Quoted+              , simple >>= parseRelOrAbs Simple ]+  where+    quoted = UTF8.toString <$> ("\"" *> takeWhile1 (/= '"') <* "\"")+    simple = UTF8.toString <$> takeWhile1 (/= ' ')+    parseRelOrAbs ty n =+            maybe (fail "Could not parse file name.") return+                ( Rel ty <$> P.parseRelFile n+              <|> Abs ty <$> P.parseAbsFile n ) -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+pathToBS :: Path -> ByteString+pathToBS (Rel ty name) = wrap ty . UTF8.fromString . P.fromRelFile $ name+pathToBS (Abs ty name) = wrap ty . UTF8.fromString . P.fromAbsFile $ name -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)+wrap :: PathType -> ByteString -> ByteString+wrap Simple p = p+wrap Quoted p = "\"" <> p <> "\"" -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+newtype FileOffset = FileOffset { toWord :: Word64 }+  deriving (Eq, Ord, Num, Integral, Enum, Real, Bounded) -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+instance Show FileOffset where+  show = show . toWord -encodeOfferFileSink :: OfferFileSink -> ByteString-encodeOfferFileSink (OfferFileSink t (FileMetadata fn fs) i p) =-    "DCC SEND "- <> encodeFileName fn- <> " " <> encodeSocket (i, p)- <> appendSpacedIfJust (encodeFileOffset <$> fs)- <> " " <> encodeToken t+fileOffset :: Parser FileOffset+fileOffset = FileOffset <$> decimal -parseSocket :: Parser (IPv4, PortNumber)-parseSocket =-    do i <- parseIpBigEndian-       space-       p <- parseTcpPort-       return (i, p)+fileOffsetToBS :: FileOffset -> ByteString+fileOffsetToBS = pack . show . toWord -encodeSocket :: (IPv4, PortNumber) -> ByteString-encodeSocket (i, p) = encodeIpBigEndian i <> " " <> encodeTcpPort p+-- | An identifier for knowing which negotiation a request belongs to+newtype Token = Token ByteString+  deriving (Eq, Show) -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+token :: Parser Token+token = Token <$> takeByteString -encodeFileName :: Path Rel File -> ByteString-encodeFileName = pack . fromRelFile+tokenToBS :: Token -> ByteString+tokenToBS (Token t) = t -parseIpBigEndian :: Parser IPv4-parseIpBigEndian = fromBigEndianIp <$> parseBoundedInteger 0 4294967295+socket :: Parser (IPv4, PortNumber)+socket = (,) <$> ipBigEndian <* space <*> tcpPort -encodeIpBigEndian :: IPv4 -> ByteString-encodeIpBigEndian = pack . show . toBigEndianIp+socketToBS :: (IPv4, PortNumber) -> ByteString+socketToBS (i, p) = ipToBigEndianBS i <> " " <> tcpPortToBS p -parseTcpPort :: Parser PortNumber-parseTcpPort = fromInteger <$> parseBoundedInteger 1 65535+ipBigEndian :: Parser IPv4+ipBigEndian = fromBigEndianIp <$> decimalInRange (0, 4294967295) -encodeTcpPort :: PortNumber -> ByteString-encodeTcpPort = pack . show+ipToBigEndianBS :: IPv4 -> ByteString+ipToBigEndianBS = pack . show . toBigEndianIp -parseFileOffset :: Parser FileOffset-parseFileOffset = FileOffset <$> decimal+fromBigEndianIp :: Integer -> IPv4+fromBigEndianIp = fromHostAddress . byteSwap32 . fromIntegral -encodeFileOffset :: FileOffset -> ByteString-encodeFileOffset = pack . show . toWord+toBigEndianIp :: IPv4 -> Integer+toBigEndianIp = fromIntegral . byteSwap32 . toHostAddress -parseToken :: Parser Token-parseToken = Token <$> takeByteString+tcpPort :: Parser PortNumber+tcpPort = fromInteger <$> decimalInRange (1, 65535) -encodeToken :: Token -> ByteString-encodeToken (Token t) = t+tcpPortToBS :: PortNumber -> ByteString+tcpPortToBS = pack . show -parseBoundedInteger :: Integer -> Integer -> Parser Integer-parseBoundedInteger lower upper = do+decimalInRange :: (Integer, Integer) -> Parser Integer+decimalInRange (lower, upper) = do     num <- decimal     when (num < lower || num > upper) $-         fail ("Failed to parse " ++ show num ++ ", not in range [" ++-               show lower ++ ", " ++ show 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+spaced :: Parser a -> Parser a+spaced = (space *>)

@@ -1,77 +1,85 @@ -- | Common functions simplyfing the use of "Network.Socket.ByteString" module Network.Socket.ByteString.Extended-  ( module Network.Socket-  , module Network.Socket.ByteString-  , Sink(..)-  , Source(..)-  , withActiveSocket-  , withPassiveSocket+  ( ConnectionType(..)+  , Socket(..)+  , S.PortNumber+  , connect+  , close+  , recv+  , sendAll   , toNetworkByteOrder   ) where -import           Control.Error-import           Control.Monad.IO.Class     (liftIO)+import           Control.Monad.IO.Class     (MonadIO, 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+import           Data.IP                    (IPv4, toHostAddress)+import           Data.Maybe                 (fromMaybe)+import qualified Network.Socket             as S hiding (recv, recvFrom, send,+                                                  sendTo)+import qualified Network.Socket.ByteString  as S -data Sink = Sink IPv4 PortNumber+data ConnectionType m+  = Active !IPv4 !S.PortNumber (m ())+  -- ^ Connects to other party on specified port. With callback when socket is ready.+  | Passive !IPv4 !(Maybe S.PortNumber) (S.PortNumber -> m ())+  -- ^ Binds to local port and waits for connection by other party. If no port number+  -- is provided, one will be provided by the OS. With callback when socket is ready. -data Source = Source IPv4 (Maybe PortNumber)+data Socket+  = ActiveSocket !S.Socket+  | PassiveSocket !S.Socket !S.PortNumber --- | Run functions on socket when connected and close socket afterwards-withActiveSocket :: Sink-                 -> (PortNumber -> ExceptT String IO ())-                 -- ^ Callback when socket is ready-                 -> (Socket -> IO ())-                 -- ^ Callback when socket is connected to server-                 -> ExceptT String IO ()-withActiveSocket (Sink 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+socket :: Socket -> S.Socket+socket (ActiveSocket sock)    = sock+socket (PassiveSocket sock _) = sock -{- | Run functions on passive socket when listening and when connected and close-     socket afterwards.--}-withPassiveSocket :: Source-                  -> (PortNumber -> ExceptT String IO ())-                  -- ^ Callback when socket is open and listening-                  -> (Socket -> IO ())-                  -- ^ Callback when client connected to socket-                  -> ExceptT String IO ()-withPassiveSocket (Source i maybeP) onListen onConnected = do-    liftIO $ return withSocketsDo-    sock <- liftIO $ openListenSocket (fromMaybe aNY_PORT maybeP)-    p <- liftIO $ socketPort sock-    onListen p-    accepted <- liftIO $ timeout 10000000 $ accept sock+connect :: MonadIO m => ConnectionType m -> m Socket+connect (Active ip port onListen) = do+    sock <- liftIO $ connectTo ip port+    onListen+    liftIO $ waitForConnection ip sock+connect (Passive ip maybePort onListen) = do+    sock@(PassiveSocket _ port) <- liftIO $ listenOn maybePort+    onListen port+    liftIO $ waitForConnection ip sock++close :: Socket -> IO ()+close = S.close . socket++recv :: Socket -> Int -> IO ByteString+recv = S.recv . socket++sendAll :: Socket -> ByteString -> IO ()+sendAll = S.sendAll . socket++connectTo :: IPv4 -> S.PortNumber -> IO Socket+connectTo ip port = S.withSocketsDo $ do+    sock <- S.socket S.AF_INET S.Stream S.defaultProtocol+    S.connect sock (S.SockAddrInet port (toHostAddress ip))+    return $ ActiveSocket sock++listenOn :: Maybe S.PortNumber -> IO Socket+listenOn port = S.withSocketsDo $ do+    sock  <- openListenSocket (fromMaybe S.aNY_PORT port)+    port' <- S.socketPort sock+    return $ PassiveSocket sock port'++waitForConnection :: IPv4 -> Socket -> IO Socket+waitForConnection _  sock@(ActiveSocket _)     = return sock -- Already connected+waitForConnection ip (PassiveSocket sock port) = do+    accepted <- S.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+      (con, S.SockAddrInet _ client)+        | client == toHostAddress ip -> return $ PassiveSocket con port+      _ -> fail ( "Connection did not come from " ++ show ip ++ " as expected." ) -openListenSocket :: PortNumber -> IO Socket+openListenSocket :: S.PortNumber -> IO S.Socket openListenSocket p = do-    sock <- socket AF_INET Stream defaultProtocol-    bind sock (SockAddrInet p iNADDR_ANY)-    listen sock 1+    sock <- S.socket S.AF_INET S.Stream S.defaultProtocol+    S.bind sock (S.SockAddrInet p S.iNADDR_ANY)+    S.listen sock 1     return sock  -- | Converts numbers to a '32bit unsigned int' in network byte order.

@@ -0,0 +1,32 @@+-- | Some functions generalized from "System.IO.Streams"+module System.IO.Streams.Lifted+  ( withBinaryFile+  , withFileAsOutputExt+  ) where++import           Control.Exception.Safe (MonadMask, bracket)+import           Control.Monad.IO.Class (MonadIO, liftIO)+import           Data.ByteString.Char8  (ByteString)+import           System.IO              (BufferMode, Handle, IOMode, hClose,+                                         hSetBuffering, openBinaryFile)+import           System.IO.Streams      (OutputStream, handleToOutputStream)++withBinaryFile :: (MonadMask m, MonadIO m)+                => FilePath+                -> IOMode+                -> (Handle -> m a)+                -> m a+withBinaryFile name mode =+    bracket (liftIO $ openBinaryFile name mode)+            (liftIO . hClose)++withFileAsOutputExt :: (MonadMask m, MonadIO m)+                     => FilePath+                     -> IOMode+                     -> BufferMode+                     -> (OutputStream ByteString -> m a)+                     -> m a+withFileAsOutputExt name mode buffermode f =+    withBinaryFile name mode $ \h -> do+        liftIO $ hSetBuffering h buffermode+        liftIO (handleToOutputStream h) >>= f

@@ -0,0 +1,166 @@+{-# LANGUAGE TemplateHaskell #-}++module Network.IRC.DCCTest where++import           Network.IRC.DCC.Internal++import           Control.Monad            (replicateM)+import           Data.ByteString.Char8    (pack)+import           Data.IP                  (IPv4, toIPv4)+import           Network.Socket           (PortNumber)+import           Path                     (mkAbsFile, mkRelFile)+import           Test.Hspec.Attoparsec+import           Test.Tasty               (TestTree)+import           Test.Tasty.Hspec         (describe, it, testSpec)+import           Test.Tasty.QuickCheck    (Arbitrary (..), Gen, choose,+                                           elements, forAll, oneof, property)++instance Arbitrary Token where+  arbitrary = Token . pack <$> arbitrary++instance Arbitrary PortNumber where+  arbitrary = fromIntegral <$> (choose (1, 65535) :: Gen Int)++instance Arbitrary IPv4 where+  arbitrary = toIPv4 <$> replicateM 4 (choose (0, 255))++instance Arbitrary Path where+  arbitrary = elements [ Rel Simple $(mkRelFile "filename")+                       , Rel Simple $(mkRelFile "filename.txt")+                       , Rel Simple $(mkRelFile "file\8195name.txt")+                       , Rel Simple $(mkRelFile "\128110\127997")+                       , Abs Simple $(mkAbsFile "/home/user/dirname/filename.txt")+                       , Rel Quoted $(mkRelFile "filename.txt")+                       , Rel Quoted $(mkRelFile "file name.txt")+                       , Rel Quoted $(mkRelFile "file\8195 name.txt")+                       , Rel Quoted $(mkRelFile "\128110\127997")+                       , Abs Quoted $(mkAbsFile "/home/user/dir name/filename.txt")+                       ]++instance Arbitrary FileOffset where+  arbitrary = FileOffset <$> arbitrary++instance Arbitrary DccChat where+  arbitrary = oneof [ Chat <$> arbitrary <*> arbitrary+                    , ChatWhiteboard <$> arbitrary <*> arbitrary+                    ]++instance Arbitrary DccSend where+  arbitrary = oneof [ Send <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+                    , SendReverseServer <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+                    ]++instance Arbitrary DccResume where+  arbitrary = oneof [ Resume <$> arbitrary <*> arbitrary <*> arbitrary+                    , ResumeReverse <$> arbitrary <*> arbitrary <*> arbitrary+                    ]++instance Arbitrary DccAccept where+  arbitrary = oneof [ Accept <$> arbitrary <*> arbitrary <*> arbitrary+                    , AcceptReverse <$> arbitrary <*> arbitrary <*> arbitrary+                    ]++instance Arbitrary DccSendReverseClient where+  arbitrary = SendReverseClient+      <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++spec :: IO TestTree+spec = testSpec "DCC message serialization" $ do++  describe "Parsing single elements" $ do++    describe "Network byte order IP" $ do+      describe "[SUCCESS]" $ do+        it "parse . encode == id" $ property $ \ip ->+          ipToBigEndianBS ip ~> ipBigEndian `parseSatisfies` (== ip)+        it "At beginning of stream" $+          pack "0abcd" ~?> ipBigEndian+              `leavesUnconsumed` pack "abcd"+      describe "[FAILURE]" $ do+        it "Parse < 0.0.0.0" $+          forAll (choose (minBound, -1 :: Int)) $ \ip ->+             ipBigEndian `shouldFailOn` pack (show ip)+        it "Parse > 255.255.255.255" $+          forAll (choose (4294967296, maxBound :: Int)) $ \ip ->+             ipBigEndian `shouldFailOn` pack (show ip)+        it "Non-digits" $+          ipBigEndian `shouldFailOn` pack "abcd"+        it "When not at beginning of stream" $+          ipBigEndian `shouldFailOn` pack " 0"++    describe "File name" $ do+      describe "[SUCCESS]" $ do+        it "parse . encode == id" $ property $ \name ->+          pathToBS name ~> path `parseSatisfies` (== name)+        it "At beginning of stream" $+          pack "filename 122350" ~?> path+            `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 absolute unix path" $+--                     ("c:\\Users\\user\\filename.txt" ~> path+--                         `shouldParse` $(mkRelFile "filename.txt")+      describe "[FAILURE]" $ do+        it "ASCII filename with space" $+          pack "file name.txt" ~?> path+            `leavesUnconsumed` pack " name.txt"+        it "Not at beginning of stream" $+          path `shouldFailOn` pack " filename"++    describe "Token" $+      describe "[SUCCESS]" $+        it "parse . encode == id" $ property $ \t ->+          tokenToBS t ~> token `parseSatisfies` (== t)++    describe "TCP port" $ do+      describe "[SUCCESS]" $+        it "parse . encode == id" $ property $ \p ->+          tcpPortToBS p ~> tcpPort `parseSatisfies` (== p)+      describe "[FAILURE]" $ do+        it "Parse <= 0" $+          forAll (choose (minBound, 0 :: Int)) $ \p ->+             tcpPort `shouldFailOn` pack (show p)+        it "Parse > 65535" $+          forAll (choose (65535, maxBound :: Int)) $ \p ->+             tcpPort `shouldFailOn` pack (show p)++    describe "File offset" $ do+      describe "[SUCCESS]" $+        it "parse . encode == id" $ property $ \o ->+          fileOffsetToBS o ~> fileOffset `parseSatisfies` (== o)+      describe "[FAILURE]" $+        it "Parse < 0" $+          forAll (choose (minBound, -1 :: Int)) $ \o ->+             fileOffset `shouldFailOn` pack (show o)++  describe "DCC commands" $ do++    describe "DCC CHAT" $+      describe "[SUCCESS]" $+        it "fromCtcp . toCtcp == id" $ property $ \cmd ->+          fromCtcp (toCtcp cmd) == Right (cmd :: DccChat)++    describe "DCC CLOSE" $+      describe "[SUCCESS]" $+        it "fromCtcp . toCtcp == id" $+          fromCtcp (toCtcp Close) == Right Close++    describe "DCC SEND" $+      describe "[SUCCESS]" $+        it "fromCtcp . toCtcp == id" $ property $ \cmd ->+          fromCtcp (toCtcp cmd) == Right (cmd :: DccSend)++    describe "DCC RESUME" $+      describe "[SUCCESS]" $+        it "fromCtcp . toCtcp == id" $ property $ \cmd ->+          fromCtcp (toCtcp cmd) == Right (cmd :: DccResume)++    describe "DCC ACCEPT" $+      describe "[SUCCESS]" $+        it "fromCtcp . toCtcp == id" $ property $ \cmd ->+          fromCtcp (toCtcp cmd) == Right (cmd :: DccAccept)++    describe "DCC SEND (reverse client)" $+      describe "[SUCCESS]" $+        it "fromCtcp . toCtcp == id" $ property $ \cmd ->+          fromCtcp (toCtcp cmd) == Right (cmd :: DccSendReverseClient)

@@ -0,0 +1,5 @@+import qualified Network.IRC.DCCTest as DCC+import           Test.Tasty++main :: IO ()+main = DCC.spec >>= defaultMain

@@ -1,7 +0,0 @@-module Main where--import qualified Network.IRC.DCCTest as DCC-import           Test.Tasty--main :: IO ()-main = DCC.spec >>= defaultMain

@@ -1,118 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Network.IRC.DCCTest where--import           Network.IRC.DCC.Internal--import           Data.ByteString.Char8    (pack)-import qualified Data.ByteString.UTF8     as UTF8 (fromString)-import           Data.IP                  (toIPv4)-import           Path                     (mkRelFile)-import           Test.Hspec.Attoparsec-import           Test.Tasty               (TestTree)-import           Test.Tasty.Hspec         (describe, it, testSpec)--spec :: IO TestTree-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"