diff options
-rw-r--r-- | Tox.hs | 41 | ||||
-rw-r--r-- | src/Network/QueryResponse.hs | 8 |
2 files changed, 42 insertions, 7 deletions
@@ -10,6 +10,7 @@ | |||
10 | module Tox where | 10 | module Tox where |
11 | 11 | ||
12 | import Control.Arrow | 12 | import Control.Arrow |
13 | import Control.Concurrent.STM | ||
13 | import qualified Crypto.Cipher.Salsa as Salsa | 14 | import qualified Crypto.Cipher.Salsa as Salsa |
14 | import qualified Crypto.Cipher.XSalsa as XSalsa | 15 | import qualified Crypto.Cipher.XSalsa as XSalsa |
15 | import Crypto.ECC.Class | 16 | import Crypto.ECC.Class |
@@ -28,6 +29,7 @@ import qualified Data.ByteString.Char8 as C8 | |||
28 | import Data.ByteString.Lazy (toStrict) | 29 | import Data.ByteString.Lazy (toStrict) |
29 | import Data.Data | 30 | import Data.Data |
30 | import Data.IP | 31 | import Data.IP |
32 | import Data.Maybe | ||
31 | import Data.Monoid | 33 | import Data.Monoid |
32 | import qualified Data.Serialize as S | 34 | import qualified Data.Serialize as S |
33 | import Data.Typeable | 35 | import Data.Typeable |
@@ -158,6 +160,12 @@ id2key recipient = case publicKey recipient of | |||
158 | -- This should never happen because a NodeId is 32 bytes. | 160 | -- This should never happen because a NodeId is 32 bytes. |
159 | CryptoFailed e -> error ("Unexpected pattern fail: "++show e) | 161 | CryptoFailed e -> error ("Unexpected pattern fail: "++show e) |
160 | 162 | ||
163 | key2id :: PublicKey -> NodeId | ||
164 | key2id pk = case S.decode (BA.convert pk) of | ||
165 | Left _ -> error "key2id" | ||
166 | Right nid -> nid | ||
167 | |||
168 | |||
161 | zeros32 :: Bytes | 169 | zeros32 :: Bytes |
162 | zeros32 = BA.replicate 32 0 | 170 | zeros32 = BA.replicate 32 0 |
163 | 171 | ||
@@ -232,21 +240,40 @@ encodePacket :: SecretKey -> SecretsCache -> Message ByteString -> NodeInfo -> ( | |||
232 | encodePacket sk cache msg ni = ( S.runPut . putMessage $ encryptMessage sk cache (nodeId ni) msg | 240 | encodePacket sk cache msg ni = ( S.runPut . putMessage $ encryptMessage sk cache (nodeId ni) msg |
233 | , nodeAddr ni ) | 241 | , nodeAddr ni ) |
234 | 242 | ||
243 | newClient :: SockAddr -> IO (Client String Method TransactionId NodeInfo (Message ByteString) ()) | ||
235 | newClient addr = do | 244 | newClient addr = do |
236 | udp <- udpTransport addr | 245 | udp <- udpTransport addr |
237 | secret <- generateSecretKey | 246 | secret <- generateSecretKey |
247 | let pubkey = key2id $ toPublic secret | ||
238 | cache <- newEmptyCache | 248 | cache <- newEmptyCache |
239 | drg <- getSystemDRG | 249 | drg <- getSystemDRG |
240 | let net = layerTransport (parsePacket secret cache) (encodePacket secret cache) udp | 250 | let me = NodeInfo pubkey (fromMaybe (toEnum 0) $ fromSockAddr addr) |
241 | intmapT = transactionMethods (contramapT intKey intMapMethods) gen | 251 | (fromMaybe 0 $ sockAddrPort addr) |
242 | mapT = transactionMethods (contramapT nonceKey mapMethods) gen | 252 | tox <- atomically $ newTVar (me,()) |
243 | dispatch = DispatchMethods | 253 | let net = layerTransport (parsePacket secret cache) |
254 | (encodePacket secret cache) | ||
255 | udp | ||
256 | dispatch tbl = DispatchMethods | ||
244 | { classifyInbound = classify | 257 | { classifyInbound = classify |
245 | , lookupHandler = handlers | 258 | , lookupHandler = handlers |
246 | , tableMethods = intmapT | 259 | , tableMethods = tbl |
247 | } | 260 | } |
248 | 261 | client tbl var = Client | |
249 | return net | 262 | { clientNet = net |
263 | , clientDispatcher = dispatch tbl | ||
264 | , clientErrorReporter = ignoreErrors -- TODO | ||
265 | , clientPending = var | ||
266 | , clientContext = atomically (readTVar tox) | ||
267 | } | ||
268 | if fitsInInt (Proxy :: Proxy Word64) | ||
269 | then do | ||
270 | let intmapT = transactionMethods (contramapT intKey intMapMethods) gen | ||
271 | intmap_var <- atomically $ newTVar (drg, mempty) | ||
272 | return (client intmapT intmap_var) | ||
273 | else do | ||
274 | let mapT = transactionMethods (contramapT nonceKey mapMethods) gen | ||
275 | map_var <- atomically $ newTVar (drg, mempty) | ||
276 | return (client mapT map_var) | ||
250 | 277 | ||
251 | last8 :: ByteString -> Nonce8 | 278 | last8 :: ByteString -> Nonce8 |
252 | last8 bs | 279 | last8 bs |
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs index 4fc9438c..221c2284 100644 --- a/src/Network/QueryResponse.hs +++ b/src/Network/QueryResponse.hs | |||
@@ -306,6 +306,14 @@ data ErrorReporter addr x meth tid err = ErrorReporter | |||
306 | , reportTimeout :: meth -> tid -> addr -> IO () | 306 | , reportTimeout :: meth -> tid -> addr -> IO () |
307 | } | 307 | } |
308 | 308 | ||
309 | ignoreErrors :: ErrorReporter addr x meth tid err | ||
310 | ignoreErrors = ErrorReporter | ||
311 | { reportParseError = \_ -> return () | ||
312 | , reportMissingHandler = \_ _ _ -> return () | ||
313 | , reportUnknown = \_ _ _ -> return () | ||
314 | , reportTimeout = \_ _ _ -> return () | ||
315 | } | ||
316 | |||
309 | -- Change the /err/ type for an 'ErrorReporter'. | 317 | -- Change the /err/ type for an 'ErrorReporter'. |
310 | contramapE f (ErrorReporter pe mh unk tim) | 318 | contramapE f (ErrorReporter pe mh unk tim) |
311 | = ErrorReporter (\e -> pe (f e)) | 319 | = ErrorReporter (\e -> pe (f e)) |