diff options
Diffstat (limited to 'src/Data/Tox/Relay.hs')
-rw-r--r-- | src/Data/Tox/Relay.hs | 56 |
1 files changed, 38 insertions, 18 deletions
diff --git a/src/Data/Tox/Relay.hs b/src/Data/Tox/Relay.hs index bd0e5968..f801d1cd 100644 --- a/src/Data/Tox/Relay.hs +++ b/src/Data/Tox/Relay.hs | |||
@@ -1,8 +1,9 @@ | |||
1 | {-# LANGUAGE DeriveDataTypeable #-} | 1 | {-# LANGUAGE ConstraintKinds #-} |
2 | {-# LANGUAGE FlexibleInstances #-} | 2 | {-# LANGUAGE DeriveDataTypeable #-} |
3 | {-# LANGUAGE KindSignatures #-} | 3 | {-# LANGUAGE FlexibleInstances #-} |
4 | {-# LANGUAGE MultiParamTypeClasses #-} | 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
5 | {-# LANGUAGE ConstraintKinds #-} | 5 | {-# LANGUAGE KindSignatures #-} |
6 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
6 | module Data.Tox.Relay where | 7 | module Data.Tox.Relay where |
7 | 8 | ||
8 | import Data.ByteString as B | 9 | import Data.ByteString as B |
@@ -16,11 +17,30 @@ import qualified Rank2 | |||
16 | import Crypto.Tox | 17 | import Crypto.Tox |
17 | import Network.Tox.Onion.Transport | 18 | import Network.Tox.Onion.Transport |
18 | 19 | ||
20 | newtype ConId = ConId Word8 | ||
21 | deriving (Eq,Show,Ord,Data,Serialize) | ||
22 | |||
23 | badcon :: ConId | ||
24 | badcon = ConId 0 | ||
25 | |||
26 | -- Maps to a range -120 .. 119 | ||
27 | c2key :: ConId -> Maybe Int | ||
28 | c2key (ConId x) | x < 16 = Nothing | ||
29 | | otherwise = Just $ case divMod (x - 15) 2 of | ||
30 | (q,0) -> negate $ fromIntegral q | ||
31 | (q,1) -> fromIntegral q | ||
32 | |||
33 | -- Maps to range 16 .. 255 | ||
34 | -- negatives become odds | ||
35 | key2c :: Int -> ConId | ||
36 | key2c y = ConId $ if y < 0 then 15 + fromIntegral (negate y * 2) | ||
37 | else 16 + fromIntegral (y * 2) | ||
38 | |||
19 | data RelayPacket | 39 | data RelayPacket |
20 | = RoutingRequest PublicKey | 40 | = RoutingRequest PublicKey |
21 | | RoutingResponse Word8 PublicKey | 41 | | RoutingResponse ConId PublicKey -- 0 for refusal, 16-255 for success. |
22 | | ConnectNotification Word8 | 42 | | ConnectNotification ConId |
23 | | DisconnectNotification Word8 | 43 | | DisconnectNotification ConId |
24 | | RelayPing Word64 | 44 | | RelayPing Word64 |
25 | | RelayPong Word64 | 45 | | RelayPong Word64 |
26 | | OOBSend PublicKey ByteString | 46 | | OOBSend PublicKey ByteString |
@@ -28,12 +48,12 @@ data RelayPacket | |||
28 | | OnionPacket (OnionRequest N0) | 48 | | OnionPacket (OnionRequest N0) |
29 | | OnionPacketResponse (OnionResponse N1) | 49 | | OnionPacketResponse (OnionResponse N1) |
30 | -- 0x0A through 0x0F reserved for future use. | 50 | -- 0x0A through 0x0F reserved for future use. |
31 | | RelayData Word8 ByteString -- Word8 is a connection id. Encoded as number 16 to 255. | 51 | | RelayData ConId ByteString -- Word8 is a connection id. Encoded as number 16 to 255. |
32 | deriving (Eq,Ord,Show,Data) | 52 | deriving (Eq,Ord,Show,Data) |
33 | 53 | ||
34 | packetNumber :: RelayPacket -> Word8 | 54 | packetNumber :: RelayPacket -> Word8 |
35 | packetNumber (RelayData conid _) = conid -- 0 to 15 not allowed. | 55 | packetNumber (RelayData (ConId conid) _) = conid -- 0 to 15 not allowed. |
36 | packetNumber rp = fromIntegral $ pred $ constrIndex $ toConstr rp | 56 | packetNumber rp = fromIntegral $ pred $ constrIndex $ toConstr rp |
37 | 57 | ||
38 | instance Sized RelayPacket where | 58 | instance Sized RelayPacket where |
39 | size = mappend (ConstSize 1) $ VarSize $ \x -> case x of | 59 | size = mappend (ConstSize 1) $ VarSize $ \x -> case x of |
@@ -59,24 +79,24 @@ instance Serialize RelayPacket where | |||
59 | pktid <- getWord8 | 79 | pktid <- getWord8 |
60 | case pktid of | 80 | case pktid of |
61 | 0 -> RoutingRequest <$> getPublicKey | 81 | 0 -> RoutingRequest <$> getPublicKey |
62 | 1 -> RoutingResponse <$> getWord8 <*> getPublicKey | 82 | 1 -> RoutingResponse <$> get <*> getPublicKey |
63 | 2 -> ConnectNotification <$> getWord8 | 83 | 2 -> ConnectNotification <$> get |
64 | 3 -> DisconnectNotification <$> getWord8 | 84 | 3 -> DisconnectNotification <$> get |
65 | 4 -> RelayPing <$> getWord64be | 85 | 4 -> RelayPing <$> getWord64be |
66 | 5 -> RelayPong <$> getWord64be | 86 | 5 -> RelayPong <$> getWord64be |
67 | 6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes) | 87 | 6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes) |
68 | 7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes) | 88 | 7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes) |
69 | 8 -> OnionPacket <$> get | 89 | 8 -> OnionPacket <$> get |
70 | 9 -> OnionPacketResponse <$> get | 90 | 9 -> OnionPacketResponse <$> get |
71 | conid -> RelayData conid <$> (remaining >>= getBytes) | 91 | conid -> RelayData (ConId conid) <$> (remaining >>= getBytes) |
72 | 92 | ||
73 | put rp = do | 93 | put rp = do |
74 | putWord8 $ packetNumber rp | 94 | putWord8 $ packetNumber rp |
75 | case rp of | 95 | case rp of |
76 | RoutingRequest k -> putPublicKey k | 96 | RoutingRequest k -> putPublicKey k |
77 | RoutingResponse rpid k -> putWord8 rpid >> putPublicKey k | 97 | RoutingResponse rpid k -> put rpid >> putPublicKey k |
78 | ConnectNotification conid -> putWord8 conid | 98 | ConnectNotification conid -> put conid |
79 | DisconnectNotification conid -> putWord8 conid | 99 | DisconnectNotification conid -> put conid |
80 | RelayPing pingid -> putWord64be pingid | 100 | RelayPing pingid -> putWord64be pingid |
81 | RelayPong pingid -> putWord64be pingid | 101 | RelayPong pingid -> putWord64be pingid |
82 | OOBSend k bs -> putPublicKey k >> putByteString bs | 102 | OOBSend k bs -> putPublicKey k >> putByteString bs |