diff options
author | joe <joe@jerkface.net> | 2017-06-09 01:03:02 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-06-09 01:03:02 -0400 |
commit | ecde95b20167e02092f6a359eac865ba9155614c (patch) | |
tree | 897c37bdf3562a950557b537e4491e99079c00d5 | |
parent | 84798bfef62a001ded1bd628d846612f0b0ade80 (diff) |
Started migration away from KRPC class.
-rw-r--r-- | src/Data/Torrent.hs | 8 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Message.hs | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Routing.hs | 13 | ||||
-rw-r--r-- | src/Network/DatagramServer.hs | 34 | ||||
-rw-r--r-- | src/Network/DatagramServer/Mainline.hs | 48 |
5 files changed, 16 insertions, 89 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 1f70aea2..0ce2efd7 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -195,6 +195,8 @@ import System.FilePath | |||
195 | import System.Posix.Types | 195 | import System.Posix.Types |
196 | 196 | ||
197 | import Network.BitTorrent.Address | 197 | import Network.BitTorrent.Address |
198 | import Network.BitTorrent.DHT.Routing | ||
199 | import Network.DatagramServer.Mainline | ||
198 | 200 | ||
199 | 201 | ||
200 | {----------------------------------------------------------------------- | 202 | {----------------------------------------------------------------------- |
@@ -237,6 +239,12 @@ instance BEncode InfoHash where | |||
237 | fromBEncode be = InfoHash <$> fromBEncode be | 239 | fromBEncode be = InfoHash <$> fromBEncode be |
238 | #endif | 240 | #endif |
239 | 241 | ||
242 | instance TableKey KMessageOf InfoHash where | ||
243 | toNodeId = either (error msg) id . S.decode . S.encode | ||
244 | where -- TODO unsafe coerse? | ||
245 | msg = "tableKey: impossible" | ||
246 | |||
247 | |||
240 | -- | Convert to\/from raw bytestring. (no encoding) | 248 | -- | Convert to\/from raw bytestring. (no encoding) |
241 | instance Serialize InfoHash where | 249 | instance Serialize InfoHash where |
242 | put (InfoHash ih) = putByteString ih | 250 | put (InfoHash ih) = putByteString ih |
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs index 4410a296..d7fb5e66 100644 --- a/src/Network/BitTorrent/DHT/Message.hs +++ b/src/Network/BitTorrent/DHT/Message.hs | |||
@@ -98,8 +98,8 @@ import qualified Network.DatagramServer.Tox as Tox | |||
98 | import Network.DatagramServer.Tox (NodeId) | 98 | import Network.DatagramServer.Tox (NodeId) |
99 | import Data.Word | 99 | import Data.Word |
100 | import Control.Monad | 100 | import Control.Monad |
101 | import Network.KRPC.Method | ||
102 | #endif | 101 | #endif |
102 | import Network.KRPC.Method | ||
103 | import Network.BitTorrent.Address hiding (NodeId) | 103 | import Network.BitTorrent.Address hiding (NodeId) |
104 | import Data.ByteString (ByteString) | 104 | import Data.ByteString (ByteString) |
105 | import Data.List as L | 105 | import Data.List as L |
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs index fc7c76b0..54c0f7c5 100644 --- a/src/Network/BitTorrent/DHT/Routing.hs +++ b/src/Network/BitTorrent/DHT/Routing.hs | |||
@@ -83,15 +83,7 @@ import Text.PrettyPrint.HughesPJClass (pPrint,Pretty) | |||
83 | import qualified Data.ByteString as BS | 83 | import qualified Data.ByteString as BS |
84 | import Data.Bits | 84 | import Data.Bits |
85 | 85 | ||
86 | import Data.Torrent | ||
87 | import Network.BitTorrent.Address | 86 | import Network.BitTorrent.Address |
88 | #ifdef VERSION_bencoding | ||
89 | import Network.DHT.Mainline () | ||
90 | import Network.DatagramServer.Mainline (KMessageOf) | ||
91 | #else | ||
92 | import Network.DatagramServer.Tox as Tox | ||
93 | type KMessageOf = Tox.Message | ||
94 | #endif | ||
95 | 87 | ||
96 | 88 | ||
97 | {----------------------------------------------------------------------- | 89 | {----------------------------------------------------------------------- |
@@ -495,11 +487,6 @@ class TableKey dht k where | |||
495 | instance TableKey dht (NodeId dht) where | 487 | instance TableKey dht (NodeId dht) where |
496 | toNodeId = id | 488 | toNodeId = id |
497 | 489 | ||
498 | instance TableKey KMessageOf InfoHash where | ||
499 | toNodeId = either (error msg) id . S.decode . S.encode | ||
500 | where -- TODO unsafe coerse? | ||
501 | msg = "tableKey: impossible" | ||
502 | |||
503 | -- | Get a list of /K/ closest nodes using XOR metric. Used in | 490 | -- | Get a list of /K/ closest nodes using XOR metric. Used in |
504 | -- 'find_node' and 'get_peers' queries. | 491 | -- 'find_node' and 'get_peers' queries. |
505 | kclosest :: ( Eq ip | 492 | kclosest :: ( Eq ip |
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs index e1bf91c5..5c77fb86 100644 --- a/src/Network/DatagramServer.hs +++ b/src/Network/DatagramServer.hs | |||
@@ -62,13 +62,9 @@ | |||
62 | {-# LANGUAGE TemplateHaskell #-} | 62 | {-# LANGUAGE TemplateHaskell #-} |
63 | {-# LANGUAGE KindSignatures #-} | 63 | {-# LANGUAGE KindSignatures #-} |
64 | module Network.DatagramServer | 64 | module Network.DatagramServer |
65 | ( -- * Methods | 65 | ( |
66 | Method | ||
67 | , KRPC (..) | ||
68 | |||
69 | -- * RPC | ||
70 | -- ** Query | 66 | -- ** Query |
71 | , QueryFailure (..) | 67 | QueryFailure (..) |
72 | , query | 68 | , query |
73 | , query' | 69 | , query' |
74 | , queryRaw | 70 | , queryRaw |
@@ -97,7 +93,6 @@ module Network.DatagramServer | |||
97 | ) where | 93 | ) where |
98 | 94 | ||
99 | import Data.Default.Class | 95 | import Data.Default.Class |
100 | import Network.DatagramServer.Mainline | ||
101 | import Network.Socket (SockAddr (..)) | 96 | import Network.Socket (SockAddr (..)) |
102 | 97 | ||
103 | import Control.Applicative | 98 | import Control.Applicative |
@@ -115,11 +110,8 @@ import Control.Monad.Logger | |||
115 | import Control.Monad.Reader | 110 | import Control.Monad.Reader |
116 | import Control.Monad.Trans.Control | 111 | import Control.Monad.Trans.Control |
117 | #ifdef VERSION_bencoding | 112 | #ifdef VERSION_bencoding |
118 | import Data.BEncode as BE | ||
119 | import Data.BEncode.Internal as BE | ||
120 | import Data.BEncode.Pretty (showBEncode) | ||
121 | #else | 113 | #else |
122 | import qualified Network.DatagramServer.Tox as Tox | 114 | -- import qualified Network.DatagramServer.Tox as Tox |
123 | #endif | 115 | #endif |
124 | import qualified Data.ByteString.Base16 as Base16 | 116 | import qualified Data.ByteString.Base16 as Base16 |
125 | import Data.ByteString as BS | 117 | import Data.ByteString as BS |
@@ -136,16 +128,10 @@ import Data.Text.Encoding as T | |||
136 | import Data.Tuple | 128 | import Data.Tuple |
137 | import Data.Typeable | 129 | import Data.Typeable |
138 | import Network.DatagramServer.Types | 130 | import Network.DatagramServer.Types |
139 | import Network.DatagramServer.Mainline | ||
140 | import Network.KRPC.Method hiding (Envelope) | ||
141 | import qualified Network.KRPC.Method as KRPC (Envelope) | ||
142 | import Network.Socket hiding (listen) | 131 | import Network.Socket hiding (listen) |
143 | import Network.Socket.ByteString as BS | 132 | import Network.Socket.ByteString as BS |
144 | import System.IO.Error | 133 | import System.IO.Error |
145 | import System.Timeout | 134 | import System.Timeout |
146 | #ifdef VERSION_bencoding | ||
147 | import Network.DHT.Mainline | ||
148 | #endif | ||
149 | 135 | ||
150 | 136 | ||
151 | {----------------------------------------------------------------------- | 137 | {----------------------------------------------------------------------- |
@@ -356,20 +342,20 @@ sendQuery sock addr q = handle sockError $ sendMessage sock addr q | |||
356 | -- This function should throw 'QueryFailure' exception if quered node | 342 | -- This function should throw 'QueryFailure' exception if quered node |
357 | -- respond with @error@ message or the query timeout expires. | 343 | -- respond with @error@ message or the query timeout expires. |
358 | -- | 344 | -- |
359 | query :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => QueryMethod msg -> SockAddr -> a -> m b | 345 | query :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg) => QueryMethod msg -> SockAddr -> a -> m b |
360 | query meth addr params = queryK meth addr params (\_ x _ -> x) | 346 | query meth addr params = queryK meth addr params (\_ x _ -> x) |
361 | 347 | ||
362 | -- | Like 'query' but possibly returns your externally routable IP address. | 348 | -- | Like 'query' but possibly returns your externally routable IP address. |
363 | query' :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => QueryMethod msg -> SockAddr -> a -> m (b, Maybe ReflectedIP) | 349 | query' :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg) => QueryMethod msg -> SockAddr -> a -> m (b, Maybe ReflectedIP) |
364 | query' meth addr params = queryK meth addr params (const (,)) | 350 | query' meth addr params = queryK meth addr params (const (,)) |
365 | 351 | ||
366 | -- | Enqueue a query, but give us the complete BEncoded content sent by the | 352 | -- | Enqueue a query, but give us the complete BEncoded content sent by the |
367 | -- remote Node. This is useful for handling extensions that this library does | 353 | -- remote Node. This is useful for handling extensions that this library does |
368 | -- not otherwise support. | 354 | -- not otherwise support. |
369 | queryRaw :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => QueryMethod msg -> SockAddr -> a -> m (b, raw) | 355 | queryRaw :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg) => QueryMethod msg -> SockAddr -> a -> m (b, raw) |
370 | queryRaw meth addr params = queryK meth addr params (\raw x _ -> (x,raw)) | 356 | queryRaw meth addr params = queryK meth addr params (\raw x _ -> (x,raw)) |
371 | 357 | ||
372 | queryK :: forall h m a b x raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => | 358 | queryK :: forall h m a b x raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg) => |
373 | QueryMethod msg -> SockAddr -> a -> (raw -> b -> Maybe ReflectedIP -> x) -> m x | 359 | QueryMethod msg -> SockAddr -> a -> (raw -> b -> Maybe ReflectedIP -> x) -> m x |
374 | queryK meth addr params kont = do | 360 | queryK meth addr params kont = do |
375 | Manager {..} <- getManager | 361 | Manager {..} <- getManager |
@@ -537,7 +523,6 @@ handleQuery meth raw q addr = void $ fork $ do | |||
537 | myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" | 523 | myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" |
538 | Manager {..} <- getManager | 524 | Manager {..} <- getManager |
539 | res <- dispatchHandler meth q addr | 525 | res <- dispatchHandler meth q addr |
540 | #ifdef VERSION_bencoding | ||
541 | let res' = either buildError Just res | 526 | let res' = either buildError Just res |
542 | ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" | 527 | ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" |
543 | resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString | 528 | resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString |
@@ -549,11 +534,6 @@ handleQuery meth raw q addr = void $ fork $ do | |||
549 | -- , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) | 534 | -- , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) |
550 | -- ] | 535 | -- ] |
551 | maybe (return ()) (sendMessage sock addr) resbs | 536 | maybe (return ()) (sendMessage sock addr) resbs |
552 | #else | ||
553 | -- Errors not sent for Tox. | ||
554 | let ctx = error "TODO TOX ToxCipherContext 2" | ||
555 | either (const $ return ()) (sendMessage sock addr . encodeHeaders ctx) res | ||
556 | #endif | ||
557 | 537 | ||
558 | handleResponse :: ( MonadKRPC h m raw msg | 538 | handleResponse :: ( MonadKRPC h m raw msg |
559 | , Ord (TransactionID msg) | 539 | , Ord (TransactionID msg) |
diff --git a/src/Network/DatagramServer/Mainline.hs b/src/Network/DatagramServer/Mainline.hs index 17f9dd60..7f97739c 100644 --- a/src/Network/DatagramServer/Mainline.hs +++ b/src/Network/DatagramServer/Mainline.hs | |||
@@ -36,21 +36,12 @@ module Network.DatagramServer.Mainline | |||
36 | , unknownMessage | 36 | , unknownMessage |
37 | 37 | ||
38 | -- * Query | 38 | -- * Query |
39 | #ifdef VERSION_bencoding | ||
40 | , KQueryOf(..) | 39 | , KQueryOf(..) |
41 | #endif | ||
42 | , KQuery | 40 | , KQuery |
43 | #ifndef VERSION_bencoding | ||
44 | , queryArgs | ||
45 | , queryMethod | ||
46 | , queryId | ||
47 | #endif | ||
48 | , MethodName | 41 | , MethodName |
49 | 42 | ||
50 | -- * Response | 43 | -- * Response |
51 | #ifdef VERSION_bencoding | ||
52 | , KResponseOf(..) | 44 | , KResponseOf(..) |
53 | #endif | ||
54 | , KResponse | 45 | , KResponse |
55 | , ReflectedIP(..) | 46 | , ReflectedIP(..) |
56 | 47 | ||
@@ -67,11 +58,7 @@ module Network.DatagramServer.Mainline | |||
67 | import Control.Applicative | 58 | import Control.Applicative |
68 | import Control.Arrow | 59 | import Control.Arrow |
69 | import Control.Exception.Lifted as Lifted | 60 | import Control.Exception.Lifted as Lifted |
70 | #ifdef VERSION_bencoding | ||
71 | import Data.BEncode as BE | 61 | import Data.BEncode as BE |
72 | #else | ||
73 | import qualified Network.DatagramServer.Tox as Tox | ||
74 | #endif | ||
75 | import Network.DatagramServer.Types | 62 | import Network.DatagramServer.Types |
76 | import Data.Bits | 63 | import Data.Bits |
77 | import Data.ByteString.Base16 as Base16 | 64 | import Data.ByteString.Base16 as Base16 |
@@ -91,37 +78,20 @@ import Text.PrettyPrint as PP hiding ((<>)) | |||
91 | import Text.PrettyPrint.HughesPJClass hiding (($$), (<>)) | 78 | import Text.PrettyPrint.HughesPJClass hiding (($$), (<>)) |
92 | 79 | ||
93 | 80 | ||
94 | #ifdef VERSION_bencoding | ||
95 | -- | This transaction ID is generated by the querying node and is | 81 | -- | This transaction ID is generated by the querying node and is |
96 | -- echoed in the response, so responses may be correlated with | 82 | -- echoed in the response, so responses may be correlated with |
97 | -- multiple queries to the same node. The transaction ID should be | 83 | -- multiple queries to the same node. The transaction ID should be |
98 | -- encoded as a short string of binary numbers, typically 2 characters | 84 | -- encoded as a short string of binary numbers, typically 2 characters |
99 | -- are enough as they cover 2^16 outstanding queries. | 85 | -- are enough as they cover 2^16 outstanding queries. |
100 | type TransactionId = TransactionID KMessageOf | 86 | type TransactionId = TransactionID KMessageOf |
101 | #else | ||
102 | type TransactionId = Tox.Nonce24 -- msgNonce | ||
103 | #endif | ||
104 | |||
105 | unknownTransaction :: TransactionId | ||
106 | #ifdef VERSION_bencoding | ||
107 | unknownTransaction = "" | ||
108 | #else | ||
109 | unknownTransaction = 0 | ||
110 | #endif | ||
111 | 87 | ||
112 | {----------------------------------------------------------------------- | 88 | {----------------------------------------------------------------------- |
113 | -- Query messages | 89 | -- Query messages |
114 | -----------------------------------------------------------------------} | 90 | -----------------------------------------------------------------------} |
115 | 91 | ||
116 | #ifdef VERSION_bencoding | ||
117 | type MethodName = ByteString | 92 | type MethodName = ByteString |
118 | type KQueryArgs = BValue | 93 | type KQueryArgs = BValue |
119 | #else | ||
120 | type MethodName = Tox.MessageType -- msgType | ||
121 | type KQueryArgs = ByteString -- msgPayload | ||
122 | #endif | ||
123 | 94 | ||
124 | #ifdef VERSION_bencoding | ||
125 | -- | Query used to signal that caller want to make procedure call to | 95 | -- | Query used to signal that caller want to make procedure call to |
126 | -- callee and pass arguments in. Therefore query may be only sent from | 96 | -- callee and pass arguments in. Therefore query may be only sent from |
127 | -- client to server but not in the opposite direction. | 97 | -- client to server but not in the opposite direction. |
@@ -161,12 +131,6 @@ instance BEncode ReflectedIP where | |||
161 | toBEncode (ReflectedIP addr) = BString (encodeAddr addr) | 131 | toBEncode (ReflectedIP addr) = BString (encodeAddr addr) |
162 | fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs | 132 | fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs |
163 | fromBEncode _ = Left "ReflectedIP should be a bencoded string" | 133 | fromBEncode _ = Left "ReflectedIP should be a bencoded string" |
164 | #else | ||
165 | type KQuery = Tox.Message KQueryArgs | ||
166 | queryArgs = Tox.msgPayload | ||
167 | queryMethod = Tox.msgType | ||
168 | queryId = Tox.msgNonce | ||
169 | #endif | ||
170 | 134 | ||
171 | port16 :: Word16 -> PortNumber | 135 | port16 :: Word16 -> PortNumber |
172 | port16 = fromIntegral | 136 | port16 = fromIntegral |
@@ -204,7 +168,6 @@ encodeAddr _ = BS.empty | |||
204 | -- | 168 | -- |
205 | -- * KResponse can be only sent from server to client. | 169 | -- * KResponse can be only sent from server to client. |
206 | -- | 170 | -- |
207 | #ifdef VERSION_bencoding | ||
208 | data KResponseOf a = KResponse | 171 | data KResponseOf a = KResponse |
209 | { respVals :: a -- ^ 'BDict' containing return values; | 172 | { respVals :: a -- ^ 'BDict' containing return values; |
210 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. | 173 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. |
@@ -235,18 +198,11 @@ instance (Typeable a, BEncode a) => BEncode (KResponseOf a) where | |||
235 | addr <- optional (field (req "ip")) | 198 | addr <- optional (field (req "ip")) |
236 | (\r t -> KResponse r t addr) <$>! "r" <*>! "t" | 199 | (\r t -> KResponse r t addr) <$>! "r" <*>! "t" |
237 | {-# INLINE fromBEncode #-} | 200 | {-# INLINE fromBEncode #-} |
238 | #else | ||
239 | type KResponse = Tox.Message KQueryArgs | ||
240 | respVals = Tox.msgPayload | ||
241 | respId = Tox.msgNonce | ||
242 | respIP = Nothing :: Maybe ReflectedIP | ||
243 | #endif | ||
244 | 201 | ||
245 | {----------------------------------------------------------------------- | 202 | {----------------------------------------------------------------------- |
246 | -- Summed messages | 203 | -- Summed messages |
247 | -----------------------------------------------------------------------} | 204 | -----------------------------------------------------------------------} |
248 | 205 | ||
249 | #ifdef VERSION_bencoding | ||
250 | -- | Generic KRPC message. | 206 | -- | Generic KRPC message. |
251 | data KMessageOf a | 207 | data KMessageOf a |
252 | = Q (KQueryOf a) | 208 | = Q (KQueryOf a) |
@@ -266,10 +222,6 @@ instance BEncode KMessage where | |||
266 | <|> R <$> fromBEncode b | 222 | <|> R <$> fromBEncode b |
267 | <|> E <$> fromBEncode b | 223 | <|> E <$> fromBEncode b |
268 | <|> decodingError "KMessage: unknown message or message tag" | 224 | <|> decodingError "KMessage: unknown message or message tag" |
269 | #else | ||
270 | type KMessageOf = Tox.Message | ||
271 | type KMessage = KMessageOf B.ByteString | ||
272 | #endif | ||
273 | 225 | ||
274 | nodeIdSize :: Int | 226 | nodeIdSize :: Int |
275 | nodeIdSize = finiteBitSize (undefined :: NodeId KMessageOf) `div` 8 | 227 | nodeIdSize = finiteBitSize (undefined :: NodeId KMessageOf) `div` 8 |