From ecde95b20167e02092f6a359eac865ba9155614c Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 9 Jun 2017 01:03:02 -0400 Subject: Started migration away from KRPC class. --- src/Network/BitTorrent/DHT/Message.hs | 2 +- src/Network/BitTorrent/DHT/Routing.hs | 13 --------- src/Network/DatagramServer.hs | 34 +++++------------------- src/Network/DatagramServer/Mainline.hs | 48 ---------------------------------- 4 files changed, 8 insertions(+), 89 deletions(-) (limited to 'src/Network') 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 import Network.DatagramServer.Tox (NodeId) import Data.Word import Control.Monad -import Network.KRPC.Method #endif +import Network.KRPC.Method import Network.BitTorrent.Address hiding (NodeId) import Data.ByteString (ByteString) 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) import qualified Data.ByteString as BS import Data.Bits -import Data.Torrent import Network.BitTorrent.Address -#ifdef VERSION_bencoding -import Network.DHT.Mainline () -import Network.DatagramServer.Mainline (KMessageOf) -#else -import Network.DatagramServer.Tox as Tox -type KMessageOf = Tox.Message -#endif {----------------------------------------------------------------------- @@ -495,11 +487,6 @@ class TableKey dht k where instance TableKey dht (NodeId dht) where toNodeId = id -instance TableKey KMessageOf InfoHash where - toNodeId = either (error msg) id . S.decode . S.encode - where -- TODO unsafe coerse? - msg = "tableKey: impossible" - -- | Get a list of /K/ closest nodes using XOR metric. Used in -- 'find_node' and 'get_peers' queries. 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 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE KindSignatures #-} module Network.DatagramServer - ( -- * Methods - Method - , KRPC (..) - - -- * RPC + ( -- ** Query - , QueryFailure (..) + QueryFailure (..) , query , query' , queryRaw @@ -97,7 +93,6 @@ module Network.DatagramServer ) where import Data.Default.Class -import Network.DatagramServer.Mainline import Network.Socket (SockAddr (..)) import Control.Applicative @@ -115,11 +110,8 @@ import Control.Monad.Logger import Control.Monad.Reader import Control.Monad.Trans.Control #ifdef VERSION_bencoding -import Data.BEncode as BE -import Data.BEncode.Internal as BE -import Data.BEncode.Pretty (showBEncode) #else -import qualified Network.DatagramServer.Tox as Tox +-- import qualified Network.DatagramServer.Tox as Tox #endif import qualified Data.ByteString.Base16 as Base16 import Data.ByteString as BS @@ -136,16 +128,10 @@ import Data.Text.Encoding as T import Data.Tuple import Data.Typeable import Network.DatagramServer.Types -import Network.DatagramServer.Mainline -import Network.KRPC.Method hiding (Envelope) -import qualified Network.KRPC.Method as KRPC (Envelope) import Network.Socket hiding (listen) import Network.Socket.ByteString as BS import System.IO.Error import System.Timeout -#ifdef VERSION_bencoding -import Network.DHT.Mainline -#endif {----------------------------------------------------------------------- @@ -356,20 +342,20 @@ sendQuery sock addr q = handle sockError $ sendMessage sock addr q -- This function should throw 'QueryFailure' exception if quered node -- respond with @error@ message or the query timeout expires. -- -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 +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 query meth addr params = queryK meth addr params (\_ x _ -> x) -- | Like 'query' but possibly returns your externally routable IP address. -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) +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) query' meth addr params = queryK meth addr params (const (,)) -- | Enqueue a query, but give us the complete BEncoded content sent by the -- remote Node. This is useful for handling extensions that this library does -- not otherwise support. -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) +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) queryRaw meth addr params = queryK meth addr params (\raw x _ -> (x,raw)) -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) => +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) => QueryMethod msg -> SockAddr -> a -> (raw -> b -> Maybe ReflectedIP -> x) -> m x queryK meth addr params kont = do Manager {..} <- getManager @@ -537,7 +523,6 @@ handleQuery meth raw q addr = void $ fork $ do myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery" Manager {..} <- getManager res <- dispatchHandler meth q addr -#ifdef VERSION_bencoding let res' = either buildError Just res ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline" resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString @@ -549,11 +534,6 @@ handleQuery meth raw q addr = void $ fork $ do -- , either (const "") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe) -- ] maybe (return ()) (sendMessage sock addr) resbs -#else - -- Errors not sent for Tox. - let ctx = error "TODO TOX ToxCipherContext 2" - either (const $ return ()) (sendMessage sock addr . encodeHeaders ctx) res -#endif handleResponse :: ( MonadKRPC h m raw msg , 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 , unknownMessage -- * Query -#ifdef VERSION_bencoding , KQueryOf(..) -#endif , KQuery -#ifndef VERSION_bencoding - , queryArgs - , queryMethod - , queryId -#endif , MethodName -- * Response -#ifdef VERSION_bencoding , KResponseOf(..) -#endif , KResponse , ReflectedIP(..) @@ -67,11 +58,7 @@ module Network.DatagramServer.Mainline import Control.Applicative import Control.Arrow import Control.Exception.Lifted as Lifted -#ifdef VERSION_bencoding import Data.BEncode as BE -#else -import qualified Network.DatagramServer.Tox as Tox -#endif import Network.DatagramServer.Types import Data.Bits import Data.ByteString.Base16 as Base16 @@ -91,37 +78,20 @@ import Text.PrettyPrint as PP hiding ((<>)) import Text.PrettyPrint.HughesPJClass hiding (($$), (<>)) -#ifdef VERSION_bencoding -- | This transaction ID is generated by the querying node and is -- echoed in the response, so responses may be correlated with -- multiple queries to the same node. The transaction ID should be -- encoded as a short string of binary numbers, typically 2 characters -- are enough as they cover 2^16 outstanding queries. type TransactionId = TransactionID KMessageOf -#else -type TransactionId = Tox.Nonce24 -- msgNonce -#endif - -unknownTransaction :: TransactionId -#ifdef VERSION_bencoding -unknownTransaction = "" -#else -unknownTransaction = 0 -#endif {----------------------------------------------------------------------- -- Query messages -----------------------------------------------------------------------} -#ifdef VERSION_bencoding type MethodName = ByteString type KQueryArgs = BValue -#else -type MethodName = Tox.MessageType -- msgType -type KQueryArgs = ByteString -- msgPayload -#endif -#ifdef VERSION_bencoding -- | Query used to signal that caller want to make procedure call to -- callee and pass arguments in. Therefore query may be only sent from -- client to server but not in the opposite direction. @@ -161,12 +131,6 @@ instance BEncode ReflectedIP where toBEncode (ReflectedIP addr) = BString (encodeAddr addr) fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs fromBEncode _ = Left "ReflectedIP should be a bencoded string" -#else -type KQuery = Tox.Message KQueryArgs -queryArgs = Tox.msgPayload -queryMethod = Tox.msgType -queryId = Tox.msgNonce -#endif port16 :: Word16 -> PortNumber port16 = fromIntegral @@ -204,7 +168,6 @@ encodeAddr _ = BS.empty -- -- * KResponse can be only sent from server to client. -- -#ifdef VERSION_bencoding data KResponseOf a = KResponse { respVals :: a -- ^ 'BDict' containing return values; , respId :: TransactionId -- ^ match to the corresponding 'queryId'. @@ -235,18 +198,11 @@ instance (Typeable a, BEncode a) => BEncode (KResponseOf a) where addr <- optional (field (req "ip")) (\r t -> KResponse r t addr) <$>! "r" <*>! "t" {-# INLINE fromBEncode #-} -#else -type KResponse = Tox.Message KQueryArgs -respVals = Tox.msgPayload -respId = Tox.msgNonce -respIP = Nothing :: Maybe ReflectedIP -#endif {----------------------------------------------------------------------- -- Summed messages -----------------------------------------------------------------------} -#ifdef VERSION_bencoding -- | Generic KRPC message. data KMessageOf a = Q (KQueryOf a) @@ -266,10 +222,6 @@ instance BEncode KMessage where <|> R <$> fromBEncode b <|> E <$> fromBEncode b <|> decodingError "KMessage: unknown message or message tag" -#else -type KMessageOf = Tox.Message -type KMessage = KMessageOf B.ByteString -#endif nodeIdSize :: Int nodeIdSize = finiteBitSize (undefined :: NodeId KMessageOf) `div` 8 -- cgit v1.2.3