Permalink
Browse files

Merge pull request #45 from erikd/master

Bunch of minor fixes.
  • Loading branch information...
2 parents e43d8c4 + 0f84649 commit a8660bc29507f3774d79bd364b8b509cf5146282 @jlouis committed on GitHub Jan 18, 2017
View
@@ -0,0 +1,25 @@
+# language: haskell
+
+# See http://www.reddit.com/r/haskell/comments/1os3f6/how_to_use_travisci_with_multiple_ghc_versions/
+
+env:
+ - GHCVER=7.6.3
+ - GHCVER=7.8.4
+ - GHCVER=7.10.3
+ - GHCVER=8.0.1
+
+before_install:
+ - sudo add-apt-repository -y ppa:hvr/ghc
+ - sudo apt-get update
+ - sudo apt-get install cabal-install-1.24 ghc-$GHCVER
+ - export PATH=/opt/cabal/bin:/opt/ghc/$GHCVER/bin:$PATH
+
+install:
+ - cabal-1.24 update
+ - cabal-1.24 install --only-dependencies
+
+script:
+ - cabal-1.24 configure
+ - cabal-1.24 build
+ - cabal-1.24 haddock
+ - cabal-1.24 sdist
View
@@ -37,10 +37,6 @@ flag threadscope
description: Enable the eventlog necessary for ThreadScope
default: False
-flag viac
- description: Build executable over GCC compilation
- default: False
-
executable Combinatorrent
hs-source-dirs: src
main-is: Combinatorrent.hs
@@ -56,8 +52,6 @@ executable Combinatorrent
Process.Peer.SenderQ,
Process.Peer.Receiver
- extensions: CPP
-
build-depends:
array >= 0.3,
attoparsec >= 0.8,
@@ -76,7 +70,6 @@ executable Combinatorrent
mtl,
network,
network-uri,
- parsec < 4,
pretty,
PSQueue,
QuickCheck >= 2.4 && < 2.9,
@@ -89,16 +82,12 @@ executable Combinatorrent
text,
time
- ghc-options: -Wall -fno-warn-orphans -funbox-strict-fields
+ extensions: CPP
+ ghc-options: -Wall -fwarn-tabs -fno-warn-orphans -funbox-strict-fields -threaded -O2
+
if impl(ghc >= 6.13.0)
ghc-options: -rtsopts
- if flag(viac)
- ghc-options: -fvia-C -optc-O3
-
- if flag(threaded)
- ghc-options: -threaded
-
if !flag(debug)
cpp-options: "-DNDEBUG"
View
@@ -11,9 +11,6 @@ test: build
conf:
runghc Setup.lhs configure --user --enable-library-profiling --enable-executable-profiling --enable-optimization=2
-conf-viac:
- runghc Setup.lhs configure --flags="viac" --user --enable-library-profiling --enable-executable-profiling --enable-optimization=2
-
conf-debug:
runghc Setup.lhs configure --flags="debug" --user --enable-library-profiling --enable-executable-profiling --enable-optimization
View
@@ -1,6 +1,8 @@
Combinatorrent - a bittorrent client.
=====================================
+[![Build Status](https://secure.travis-ci.org/jlouis/combinatorrent.svg?branch=master)](http://travis-ci.org/jlouis/combinatorrent)
+
Introduction
----------
View
@@ -0,0 +1,9 @@
+{-# LANGUAGE CPP #-}
+module AdaptGhcVersion
+ (
+ Monoid (..), (<$>), (<*>), pure
+ ) where
+
+import Control.Applicative ((<$>), (<*>), pure)
+import Data.Monoid (Monoid (..))
+
View
@@ -7,8 +7,6 @@ module Digest
)
where
-import Control.DeepSeq
-
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
View
@@ -34,7 +34,7 @@ import Control.Monad.State.Strict
import Data.Typeable
-import Prelude hiding (catch, log)
+import Prelude hiding (log)
import System.Log.Logger
View
@@ -24,7 +24,7 @@ import qualified Data.Set as S
import Data.Traversable as T
import GHC.Generics
-import Prelude hiding (catch, log)
+import Prelude hiding (log)
import System.Random
@@ -246,7 +246,7 @@ compareInv x y =
EQ -> EQ
GT -> LT
-comparingWith :: Ord a => (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
+comparingWith :: (a -> a -> Ordering) -> (b -> a) -> b -> b -> Ordering
comparingWith comp project x y =
comp (project x) (project y)
View
@@ -11,7 +11,7 @@ import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.Reader
-import Prelude hiding (catch)
+import Prelude
import Process
View
@@ -10,7 +10,7 @@ import Control.Monad.Reader
import Data.Word
-import Network hiding (accept, sClose)
+import Network hiding (accept)
import Network.Socket
import Network.BSD
@@ -33,10 +33,10 @@ openListen port = liftIO $ do
proto <- getProtocolNumber "tcp"
bracketOnError
(socket AF_INET Stream proto)
- (sClose)
+ (close)
(\sock -> do
setSocketOption sock ReuseAddr 1
- bindSocket sock (SockAddrInet (toEnum $ fromIntegral port) iNADDR_ANY)
+ bind sock (SockAddrInet (toEnum $ fromIntegral port) iNADDR_ANY)
listen sock maxListenQueue
return sock
)
View
@@ -8,7 +8,8 @@ module Process.Peer (
)
where
-import Control.Applicative
+import AdaptGhcVersion
+
import Control.Concurrent
import Control.Concurrent.STM
import Control.DeepSeq
@@ -18,7 +19,7 @@ import Control.Exception
import Control.Monad.State
import Control.Monad.Reader
-import Prelude hiding (catch, log)
+import Prelude hiding (log)
import Data.Array
import Data.Bits
@@ -27,7 +28,7 @@ import Data.Function (on)
import qualified Data.PieceSet as PS
import Data.Maybe
-import Data.Monoid(Monoid(..), Last(..))
+import Data.Monoid(Last(..))
import Data.Set as S hiding (map, foldl)
import Data.Time.Clock
@@ -790,8 +791,8 @@ allowedFast ip ihash sz n = generate n [] x []
bytes :: [Word32]
bytes = [fromIntegral z `shiftL` s |
(z, s) <- zip (B.unpack h) [24,16,8,0]]
- ntohl = fromIntegral . sum
- in ((ntohl bytes) `mod` fromIntegral sz) : genPieces rest
+ fntohl = fromIntegral . sum
+ in ((fntohl bytes) `mod` fromIntegral sz) : genPieces rest
-- To prevent a Peer to reconnect, obtain a new IP and thus new FAST-set pieces, we mask out
-- the lower bits
ipBytes = B.pack $ map fromIntegral
@@ -10,7 +10,7 @@ import Control.Monad.Reader
import Control.Monad.State
import qualified Data.ByteString as B
-import Prelude hiding (catch, log)
+import Prelude hiding (log)
import Data.Serialize.Get
@@ -27,7 +27,7 @@ start :: Socket -> TMVar L.ByteString -> SupervisorChannel -> IO ThreadId
start s ch supC = spawnP (CF ch s) () ({-# SCC "Sender" #-}
(cleanupP pgm
(defaultStopHandler supC)
- (liftIO $ sClose s)))
+ (liftIO $ close s)))
pgm :: Process CF () ()
pgm = do
ch <- asks chan
@@ -10,7 +10,7 @@ import Control.Concurrent.STM
import Control.Monad.Reader
import Control.Monad.State
-import Prelude hiding (catch, log)
+import Prelude hiding (log)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP, TupleSections #-}
module Process.PeerMgr (
-- * Types
Peer(..)
@@ -10,7 +10,9 @@ module Process.PeerMgr (
)
where
-import Control.Applicative
+#if __GLASGOW_HASKELL__ <= 708
+import AdaptGhcVersion
+#endif
import Control.Concurrent
import Control.Concurrent.STM
@@ -112,7 +114,7 @@ incomingPeers msg =
_ <- addIncoming conn
return ()
else do debugP "Already too many peers, closing!"
- liftIO $ Sock.sClose s
+ liftIO $ Sock.close s
NewTorrent ih tl -> do
modify (\s -> s { cmMap = M.insert ih tl (cmMap s)})
StopTorrent _ih -> do
View
@@ -8,13 +8,16 @@
-- about the torrent in question. It may also respond with an error in which
-- case we should present it to the user.
--
+{-# LANGUAGE CPP #-}
module Process.Tracker
( start
)
where
-import Prelude hiding (catch)
-import Control.Applicative
+#if __GLASGOW_HASKELL__ <= 708
+import AdaptGhcVersion
+#endif
+
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.Reader
@@ -206,7 +209,7 @@ decodeIps4 bs | B.null bs = []
let (ip, r1) = B.splitAt 4 bs
(port, r2) = B.splitAt 2 r1
i' = cW32 ip
- p' = PortNum $ cW16 port
+ p' = fromIntegral $ cW16 port
in PeerMgr.Peer (S.SockAddrInet p' i') : decodeIps4 r2
| otherwise = [] -- Some trackers fail spectacularly
@@ -216,7 +219,7 @@ decodeIps6 bs | B.null bs = []
let (ip6, r1) = B.splitAt 16 bs
(port, r2) = B.splitAt 2 r1
i' = cW128 ip6
- p' = PortNum $ cW16 port
+ p' = fromIntegral $ cW16 port
in PeerMgr.Peer (S.SockAddrInet6 p' 0 i' 0) : decodeIps6 r2
| otherwise = [] -- Some trackers fail spectacularly
@@ -241,12 +244,12 @@ cW128 bs =
bubbleUpURL :: AnnounceURL -> [AnnounceURL] -> Process CF ST ()
bubbleUpURL _ (_:[]) = return ()
bubbleUpURL _ [] = return ()
-bubbleUpURL url tier@(x:_) = if url == x
+bubbleUpURL url tier@(x:_) = if url == x
then return ()
else do
alist <- gets announceList
- let newTier = url : filter (/=url) tier
- newAnnounceList = map (\a -> if a /= tier then a else newTier) alist
+ let newTier = url : filter (/=url) tier
+ newAnnounceList = map (\a -> if a /= tier then a else newTier) alist
_ <- modify (\s -> s { announceList = newAnnounceList })
return ()
@@ -258,9 +261,9 @@ tryThisTier' s (x:xs) = do url <- buildRequestURL s x
Just u -> return u
resp <- trackerRequest uri
case resp of
- Left m -> if null xs
+ Left m -> if null xs
then return $ Left m
- else tryThisTier' s xs
+ else tryThisTier' s xs
Right r -> return $ Right (x, r)
@@ -277,22 +280,22 @@ tryThisTier params tier = do resp <- tryThisTier' params tier
queryTrackers' :: Status.StatusState -> [[AnnounceURL]] -> Process CF ST (Either String TrackerResponse)
queryTrackers' _ [] = return $ Left "Empty announce-list"
-queryTrackers' p (x:[]) = tryThisTier p x --last element, so return whatever it gives us
+queryTrackers' p (x:[]) = tryThisTier p x --last element, so return whatever it gives us
queryTrackers' p (x:xs) = do resp <- tryThisTier p x
- case resp of
- Left _ -> queryTrackers' p xs -- in case of error, move to the next tier
+ case resp of
+ Left _ -> queryTrackers' p xs -- in case of error, move to the next tier
Right _ -> return $ resp -- if success just return result
queryTrackers :: Status.StatusState -> Process CF ST (Either String TrackerResponse)
-queryTrackers ss = do alist <- gets announceList
+queryTrackers ss = do alist <- gets announceList
queryTrackers' ss alist
-
+
-- TODO: Do not recurse infinitely here.
trackerRequest :: URI -> Process CF ST (Either String TrackerResponse)
trackerRequest uri =
- do debugP $ "Querying URI: " ++ (show uri)
+ do debugP $ "Querying URI: " ++ (show uri)
resp <- liftIO $ catch (simpleHTTP request) (\e -> let err = show (e :: IOException)
in return . Left . ErrorMisc $ err)
case resp of
@@ -341,7 +344,7 @@ urlEncode (h:t) = let str = if reserved (ord h) then escape h else [h]
| x >= ord 'A' && x <= ord 'Z' = False
| x >= ord '0' && x <= ord '9' = False
| x <= 0x20 || x >= 0x7F = True
- | otherwise = x `elem` map ord
+ | otherwise = x `elem` map ord
[';','/','?',':','@','&'
,'=','+',',','$','{','}'
,'|','\\','^','[',']','`'
View
@@ -28,7 +28,7 @@ import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
-import Data.Attoparsec as A
+import Data.Attoparsec.ByteString as A
import Data.Bits (testBit, setBit)
import Data.Serialize
View
@@ -23,7 +23,7 @@ import Control.Concurrent.STM
import Control.Monad.State
import Control.Monad.Reader
-import Prelude hiding (catch)
+import Prelude
import Process
Oops, something went wrong.

0 comments on commit a8660bc

Please sign in to comment.