diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Message.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Message.hs | 25 |
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 | -- |
103 | data Extension | 104 | data 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. | ||
109 | instance Pretty Extension where | 111 | instance 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. | ||
114 | capMask :: Extension -> Caps | 117 | capMask :: Extension -> Caps |
115 | capMask ExtDHT = Caps 0x01 | 118 | capMask ExtDHT = Caps 0x01 |
116 | capMask ExtFast = Caps 0x04 | 119 | capMask 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. | ||
124 | newtype Caps = Caps { unCaps :: Word64 } | 128 | newtype Caps = Caps { unCaps :: Word64 } |
125 | deriving (Show, Eq) | 129 | deriving (Show, Eq) |
126 | 130 | ||
131 | -- | Render set of extensions as comma separated list. | ||
127 | instance Pretty Caps where | 132 | instance 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. | ||
130 | instance Default Caps where | 136 | instance Default Caps where |
131 | def = Caps 0 | 137 | def = Caps 0 |
132 | {-# INLINE def #-} | 138 | {-# INLINE def #-} |
133 | 139 | ||
140 | -- | Monoid under intersection. | ||
134 | instance Monoid Caps where | 141 | instance 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. | ||
141 | instance Serialize Caps where | 149 | instance 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. | ||
148 | allowed :: Caps -> Extension -> Bool | 157 | allowed :: Caps -> Extension -> Bool |
149 | allowed (Caps caps) = testMask . capMask | 158 | allowed (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. | ||
153 | toCaps :: [Extension] -> Caps | 163 | toCaps :: [Extension] -> Caps |
154 | toCaps = Caps . L.foldr (.|.) 0 . L.map (unCaps . capMask) | 164 | toCaps = Caps . L.foldr (.|.) 0 . L.map (unCaps . capMask) |
155 | 165 | ||
166 | -- | Unpack extensions from caps. | ||
156 | fromCaps :: Caps -> [Extension] | 167 | fromCaps :: Caps -> [Extension] |
157 | fromCaps caps = L.filter (allowed caps) [minBound..maxBound] | 168 | fromCaps caps = L.filter (allowed caps) [minBound..maxBound] |
158 | 169 | ||