summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-06-18 04:21:08 -0400
committerjoe <joe@jerkface.net>2017-06-18 04:21:08 -0400
commitb525f62e07f3372b00673c01a618a1f64037590b (patch)
treec25918ee6446123ebcce823b1a30add32cab414e
parenta79e92856c5fcb87ec4e0ecaee32110c99959a4e (diff)
Removed tox-only customizatino from Network.DatagramServer(.Error).
-rw-r--r--src/Network/DatagramServer.hs12
-rw-r--r--src/Network/DatagramServer/Error.hs42
-rw-r--r--src/Network/DatagramServer/Mainline.hs38
3 files changed, 38 insertions, 54 deletions
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs
index cd74f589..eed2ced1 100644
--- a/src/Network/DatagramServer.hs
+++ b/src/Network/DatagramServer.hs
@@ -109,10 +109,6 @@ import Control.Monad
109import Control.Monad.Logger 109import Control.Monad.Logger
110import Control.Monad.Reader 110import Control.Monad.Reader
111import Control.Monad.Trans.Control 111import Control.Monad.Trans.Control
112#ifdef VERSION_bencoding
113#else
114-- import qualified Network.DatagramServer.Tox as Tox
115#endif
116import qualified Data.ByteString.Base16 as Base16 112import qualified Data.ByteString.Base16 as Base16
117import Data.ByteString as BS 113import Data.ByteString as BS
118import Data.ByteString.Char8 as BC 114import Data.ByteString.Char8 as BC
@@ -372,14 +368,6 @@ queryK meth addr params kont = do
372 q <- buildQuery cli addr meth tid params 368 q <- buildQuery cli addr meth tid params
373 let qb = encodePayload (q :: msg a) :: msg raw 369 let qb = encodePayload (q :: msg a) :: msg raw
374 qbs = encodeHeaders ctx qb 370 qbs = encodeHeaders ctx qb
375#ifdef VERSION_bencoding
376#else
377 let q = Tox.Message (methodName queryMethod) cli tid params
378 cli = error "TODO TOX client node id"
379 ctx = error "TODO TOX ToxCipherContext"
380 qb = encodePayload q :: Tox.Message BC.ByteString
381 qbs = encodeHeaders ctx qb :: BC.ByteString
382#endif
383 sendQuery sock addr qbs 371 sendQuery sock addr qbs
384 `onException` unregisterQuery (tid, addr) pendingCalls 372 `onException` unregisterQuery (tid, addr) pendingCalls
385 373
diff --git a/src/Network/DatagramServer/Error.hs b/src/Network/DatagramServer/Error.hs
index 2cbb76c3..77b132a7 100644
--- a/src/Network/DatagramServer/Error.hs
+++ b/src/Network/DatagramServer/Error.hs
@@ -3,9 +3,6 @@
3module Network.DatagramServer.Error where 3module Network.DatagramServer.Error where
4 4
5import Control.Exception.Lifted as Lifted 5import Control.Exception.Lifted as Lifted
6#ifdef VERSION_bencoding
7import Data.BEncode as BE
8#endif
9import Data.ByteString (ByteString) 6import Data.ByteString (ByteString)
10import Data.ByteString.Char8 as Char8 7import Data.ByteString.Char8 as Char8
11import Data.Data 8import Data.Data
@@ -47,15 +44,6 @@ instance Enum ErrorCode where
47 toEnum _ = GenericError 44 toEnum _ = GenericError
48 {-# INLINE toEnum #-} 45 {-# INLINE toEnum #-}
49 46
50#ifdef VERSION_bencoding
51instance BEncode ErrorCode where
52 toBEncode = toBEncode . fromEnum
53 {-# INLINE toBEncode #-}
54
55 fromBEncode b = toEnum <$> fromBEncode b
56 {-# INLINE fromBEncode #-}
57#endif
58
59-- | Errors are sent when a query cannot be fulfilled. Error message 47-- | Errors are sent when a query cannot be fulfilled. Error message
60-- can be send only from server to client but not in the opposite 48-- can be send only from server to client but not in the opposite
61-- direction. 49-- direction.
@@ -66,36 +54,6 @@ data KError tid = KError
66 , errorId :: !tid -- ^ match to the corresponding 'queryId'. 54 , errorId :: !tid -- ^ match to the corresponding 'queryId'.
67 } deriving ( Show, Eq, Ord, Typeable, Data, Read ) 55 } deriving ( Show, Eq, Ord, Typeable, Data, Read )
68 56
69-- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\",
70-- contain one additional key \"e\". The value of \"e\" is a
71-- list. The first element is an integer representing the error
72-- code. The second element is a string containing the error
73-- message.
74--
75-- Example Error Packet:
76--
77-- > { "t": "aa", "y":"e", "e":[201, "A Generic Error Ocurred"]}
78--
79-- or bencoded:
80--
81-- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee
82--
83#ifdef VERSION_bencoding
84instance (Typeable tid, BEncode tid) => BEncode (KError tid) where
85 toBEncode KError {..} = toDict $
86 "e" .=! (errorCode, errorMessage)
87 .: "t" .=! errorId
88 .: "y" .=! ("e" :: ByteString)
89 .: endDict
90 {-# INLINE toBEncode #-}
91
92 fromBEncode = fromDict $ do
93 lookAhead $ match "y" (BString "e")
94 (code, msg) <- field (req "e")
95 KError code msg <$>! "t"
96 {-# INLINE fromBEncode #-}
97#endif
98
99instance (Typeable tid, Show tid) => Exception (KError tid) 57instance (Typeable tid, Show tid) => Exception (KError tid)
100 58
101-- | Received 'queryArgs' or 'respVals' can not be decoded. 59-- | Received 'queryArgs' or 'respVals' can not be decoded.
diff --git a/src/Network/DatagramServer/Mainline.hs b/src/Network/DatagramServer/Mainline.hs
index dd3c8bcd..e9e2798c 100644
--- a/src/Network/DatagramServer/Mainline.hs
+++ b/src/Network/DatagramServer/Mainline.hs
@@ -331,4 +331,42 @@ instance Pretty ip => Pretty [NodeInfo KMessageOf ip ()] where
331 pPrint = PP.vcat . PP.punctuate "," . map pPrint 331 pPrint = PP.vcat . PP.punctuate "," . map pPrint
332 332
333 333
334#ifdef VERSION_bencoding
335instance BEncode ErrorCode where
336 toBEncode = toBEncode . fromEnum
337 {-# INLINE toBEncode #-}
338
339 fromBEncode b = toEnum <$> fromBEncode b
340 {-# INLINE fromBEncode #-}
341#endif
342
343-- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\",
344-- contain one additional key \"e\". The value of \"e\" is a
345-- list. The first element is an integer representing the error
346-- code. The second element is a string containing the error
347-- message.
348--
349-- Example Error Packet:
350--
351-- > { "t": "aa", "y":"e", "e":[201, "A Generic Error Ocurred"]}
352--
353-- or bencoded:
354--
355-- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee
356--
357#ifdef VERSION_bencoding
358instance (Typeable tid, BEncode tid) => BEncode (KError tid) where
359 toBEncode KError {..} = toDict $
360 "e" .=! (errorCode, errorMessage)
361 .: "t" .=! errorId
362 .: "y" .=! ("e" :: ByteString)
363 .: endDict
364 {-# INLINE toBEncode #-}
365
366 fromBEncode = fromDict $ do
367 lookAhead $ match "y" (BString "e")
368 (code, msg) <- field (req "e")
369 KError code msg <$>! "t"
370 {-# INLINE fromBEncode #-}
371#endif
334 372