summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Message.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Message.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Message.hs25
1 files changed, 18 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index 17ec7da6..8fcf582f 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -97,20 +97,23 @@ import Network.BitTorrent.Exchange.Block
97-- Extensions 97-- Extensions
98-----------------------------------------------------------------------} 98-----------------------------------------------------------------------}
99 99
100-- | See <http://www.bittorrent.org/beps/bep_0004.html> for more 100-- | Enumeration of message extension protocols.
101-- information. 101--
102-- For more info see: <http://www.bittorrent.org/beps/bep_0004.html>
102-- 103--
103data Extension 104data Extension
104 = ExtDHT -- ^ BEP 5 105 = ExtDHT -- ^ BEP 5: allow to send PORT messages.
105 | ExtFast -- ^ BEP 6 106 | ExtFast -- ^ BEP 6: allow to send FAST messages.
106 | ExtExtended -- ^ BEP 10 107 | ExtExtended -- ^ BEP 10: allow to send extension protocol messages.
107 deriving (Show, Eq, Ord, Enum, Bounded) 108 deriving (Show, Eq, Ord, Enum, Bounded)
108 109
110-- | Full extension names, suitable for logging.
109instance Pretty Extension where 111instance Pretty Extension where
110 pretty ExtDHT = "DHT" 112 pretty ExtDHT = "Distributed Hash Table Protocol"
111 pretty ExtFast = "Fast Extension" 113 pretty ExtFast = "Fast Extension"
112 pretty ExtExtended = "Extension Protocol" 114 pretty ExtExtended = "Extension Protocol"
113 115
116-- | Extension bitmask as specified by BEP 4.
114capMask :: Extension -> Caps 117capMask :: Extension -> Caps
115capMask ExtDHT = Caps 0x01 118capMask ExtDHT = Caps 0x01
116capMask ExtFast = Caps 0x04 119capMask ExtFast = Caps 0x04
@@ -120,17 +123,21 @@ capMask ExtExtended = Caps 0x100000
120-- Capabilities 123-- Capabilities
121-----------------------------------------------------------------------} 124-----------------------------------------------------------------------}
122 125
123-- | A set of 'Extension's. 126-- | Capabilities is a set of 'Extension's usually sent in 'Handshake'
127-- messages.
124newtype Caps = Caps { unCaps :: Word64 } 128newtype Caps = Caps { unCaps :: Word64 }
125 deriving (Show, Eq) 129 deriving (Show, Eq)
126 130
131-- | Render set of extensions as comma separated list.
127instance Pretty Caps where 132instance Pretty Caps where
128 pretty = hcat . punctuate ", " . L.map pretty . fromCaps 133 pretty = hcat . punctuate ", " . L.map pretty . fromCaps
129 134
135-- | The empty set.
130instance Default Caps where 136instance Default Caps where
131 def = Caps 0 137 def = Caps 0
132 {-# INLINE def #-} 138 {-# INLINE def #-}
133 139
140-- | Monoid under intersection.
134instance Monoid Caps where 141instance Monoid Caps where
135 mempty = Caps (-1) 142 mempty = Caps (-1)
136 {-# INLINE mempty #-} 143 {-# INLINE mempty #-}
@@ -138,6 +145,7 @@ instance Monoid Caps where
138 mappend (Caps a) (Caps b) = Caps (a .&. b) 145 mappend (Caps a) (Caps b) = Caps (a .&. b)
139 {-# INLINE mappend #-} 146 {-# INLINE mappend #-}
140 147
148-- | 'Handshake' compatible encoding.
141instance Serialize Caps where 149instance Serialize Caps where
142 put (Caps caps) = S.putWord64be caps 150 put (Caps caps) = S.putWord64be caps
143 {-# INLINE put #-} 151 {-# INLINE put #-}
@@ -145,14 +153,17 @@ instance Serialize Caps where
145 get = Caps <$> S.getWord64be 153 get = Caps <$> S.getWord64be
146 {-# INLINE get #-} 154 {-# INLINE get #-}
147 155
156-- | Check if an extension is a member of the specified set.
148allowed :: Caps -> Extension -> Bool 157allowed :: Caps -> Extension -> Bool
149allowed (Caps caps) = testMask . capMask 158allowed (Caps caps) = testMask . capMask
150 where 159 where
151 testMask (Caps bits) = (bits .&. caps) == bits 160 testMask (Caps bits) = (bits .&. caps) == bits
152 161
162-- | Pack extensions to caps.
153toCaps :: [Extension] -> Caps 163toCaps :: [Extension] -> Caps
154toCaps = Caps . L.foldr (.|.) 0 . L.map (unCaps . capMask) 164toCaps = Caps . L.foldr (.|.) 0 . L.map (unCaps . capMask)
155 165
166-- | Unpack extensions from caps.
156fromCaps :: Caps -> [Extension] 167fromCaps :: Caps -> [Extension]
157fromCaps caps = L.filter (allowed caps) [minBound..maxBound] 168fromCaps caps = L.filter (allowed caps) [minBound..maxBound]
158 169