diff --git a/irc-dcc.cabal b/irc-dcc.cabal --- a/irc-dcc.cabal +++ b/irc-dcc.cabal @@ -1,5 +1,5 @@ name: irc-dcc -version: 1.1.0 +version: 1.2.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 diff --git a/src/Network/IRC/DCC/FileTransfer.hs b/src/Network/IRC/DCC/FileTransfer.hs --- a/src/Network/IRC/DCC/FileTransfer.hs +++ b/src/Network/IRC/DCC/FileTransfer.hs @@ -13,6 +13,8 @@ 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, @@ -29,7 +31,7 @@ -- ^ Callback when socket is ready -> (a -> IO ()) -- ^ Callback when a chunk of data was transfered - -> ExceptT String IO () + -> ReaderT (Maybe PortNumber) (ExceptT String IO) () acceptFile (OfferFile tt f) = download (fileName f) WriteMode 0 tt @@ -40,7 +42,7 @@ -- ^ Callback when socket is ready -> (a -> IO ()) -- ^ Callback when a chunk of data was transfered - -> ExceptT String IO () + -> ReaderT (Maybe PortNumber) (ExceptT String IO) () resumeFile (AcceptResumeFile tt f pos) = download (fileName f) AppendMode (fromIntegral pos) tt @@ -50,14 +52,18 @@ -> a -> TransferType -> (PortNumber -> ExceptT String IO ()) + -- ^ Callback when socket is ready -> (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 + -- ^ 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 diff --git a/src/Network/Socket/ByteString/Extended.hs b/src/Network/Socket/ByteString/Extended.hs --- a/src/Network/Socket/ByteString/Extended.hs +++ b/src/Network/Socket/ByteString/Extended.hs @@ -2,6 +2,8 @@ module Network.Socket.ByteString.Extended ( module Network.Socket , module Network.Socket.ByteString + , Sink(..) + , Source(..) , withActiveSocket , withPassiveSocket , toNetworkByteOrder @@ -19,15 +21,18 @@ import Network.Socket.ByteString import System.Timeout +data Sink = Sink IPv4 PortNumber + +data Source = Source IPv4 (Maybe PortNumber) + -- | Run functions on socket when connected and close socket afterwards -withActiveSocket :: IPv4 - -> PortNumber +withActiveSocket :: Sink -> (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 +withActiveSocket (Sink i p) onListen onConnected = do liftIO $ return withSocketsDo sock <- liftIO $ socket AF_INET Stream defaultProtocol onListen p @@ -38,17 +43,15 @@ {- | Run functions on passive socket when listening and when connected and close socket afterwards. -} -withPassiveSocket :: IPv4 +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 i onListen onConnected = do +withPassiveSocket (Source i maybeP) 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 + sock <- liftIO $ openListenSocket (fromMaybe aNY_PORT maybeP) p <- liftIO $ socketPort sock onListen p accepted <- liftIO $ timeout 10000000 $ accept sock @@ -60,10 +63,16 @@ 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 + +openListenSocket :: PortNumber -> IO Socket +openListenSocket p = do + sock <- socket AF_INET Stream defaultProtocol + bind sock (SockAddrInet p iNADDR_ANY) + listen sock 1 + return sock -- | Converts numbers to a '32bit unsigned int' in network byte order. toNetworkByteOrder :: Integral a => a -> ByteString diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -2,9 +2,6 @@ import qualified Network.IRC.DCCTest as DCC import Test.Tasty -import Test.Tasty.Hspec -main = tests - -tests :: IO () -tests = DCC.spec >>= defaultMain +main :: IO () +main = DCC.spec >>= defaultMain diff --git a/tests/Network/IRC/DCCTest.hs b/tests/Network/IRC/DCCTest.hs --- a/tests/Network/IRC/DCCTest.hs +++ b/tests/Network/IRC/DCCTest.hs @@ -4,18 +4,15 @@ 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 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 (testGroup) -import Test.Tasty.Hspec (SpecWith, describe, it, - testSpec) +import Test.Tasty (TestTree) +import Test.Tasty.Hspec (describe, it, testSpec) +spec :: IO TestTree spec = testSpec "DCC message serialization" $ describe "Parsing single elements" $ do