blob: e81cdb87d0a564a9296bd077e4d731babf556d7e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
-- |
-- Copyright : (c) Sam Truzjan 2013
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- This module provides peer capabilities detection.
--
-- See <http://www.bittorrent.org/beps/bep_0004.html> for more
-- information.
--
module Network.BitTorrent.Exchange.Extension
( -- * Capabilities
Caps
-- * Extensions
, Extension(..)
) where
import Data.Bits
import Data.Default
import Data.Monoid
import Data.Word
import Text.PrettyPrint
import Text.PrettyPrint.Class
class (Enum a, Bounded a) => Capability a where
capMask :: a -> Word64
capRequires :: a -> Word64
newtype Caps a = Caps Word64
instance (Pretty a, Capability a) => Pretty (Caps a) where
pretty = hcat . punctuate ", " . map pretty . toList
instance Default (Caps a) where
def = Caps 0
{-# INLINE def #-}
instance Monoid (Caps a) where
mempty = Caps (-1)
{-# INLINE mempty #-}
mappend (Caps a) (Caps b) = Caps (a .&. b)
{-# INLINE mappend #-}
allowed :: Capability a => a -> Caps a -> Bool
allowed = member
fromList :: Capability a => [a] -> Caps a
fromList = Caps . foldr (.&.) 0 . map capMask
toList :: Capability a => Caps a -> [a]
toList (Caps rb) = filter (testMask rb . capMask) [minBound..maxBound]
where
testMask bits x = bits .&. x > 0
data Extension
= ExtDHT -- ^ BEP 5
| ExtFast -- ^ BEP 6
deriving (Show, Eq, Ord, Enum, Bounded)
instance Pretty Extension where
pretty ExtDHT = "DHT"
pretty ExtFast = "Fast Extension"
instance Capability Extension where
capMask ExtDHT = 0x01
capMask ExtFast = 0x04
|
