blob: bd0e596826939c4262c93649dc3cb2b126dafefd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
module Data.Tox.Relay where
import Data.ByteString as B
import Data.Data
import Data.Functor.Contravariant
import Data.Monoid
import Data.Serialize
import Data.Word
import qualified Rank2
import Crypto.Tox
import Network.Tox.Onion.Transport
data RelayPacket
= RoutingRequest PublicKey
| RoutingResponse Word8 PublicKey
| ConnectNotification Word8
| DisconnectNotification Word8
| RelayPing Word64
| RelayPong Word64
| OOBSend PublicKey ByteString
| OOBRecv PublicKey ByteString
| OnionPacket (OnionRequest N0)
| OnionPacketResponse (OnionResponse N1)
-- 0x0A through 0x0F reserved for future use.
| RelayData Word8 ByteString -- Word8 is a connection id. Encoded as number 16 to 255.
deriving (Eq,Ord,Show,Data)
packetNumber :: RelayPacket -> Word8
packetNumber (RelayData conid _) = conid -- 0 to 15 not allowed.
packetNumber rp = fromIntegral $ pred $ constrIndex $ toConstr rp
instance Sized RelayPacket where
size = mappend (ConstSize 1) $ VarSize $ \x -> case x of
RoutingRequest k -> 32
RoutingResponse rpid k -> 33
ConnectNotification conid -> 1
DisconnectNotification conid -> 1
RelayPing pingid -> 8
RelayPong pingid -> 8
OOBSend k bs -> 32 + B.length bs
OOBRecv k bs -> 32 + B.length bs
OnionPacket query -> case contramap (`asTypeOf` query) size of
ConstSize n -> n
VarSize f -> f query
OnionPacketResponse answer -> case contramap (`asTypeOf` answer) size of
ConstSize n -> n
VarSize f -> f answer
RelayData _ bs -> B.length bs
instance Serialize RelayPacket where
get = do
pktid <- getWord8
case pktid of
0 -> RoutingRequest <$> getPublicKey
1 -> RoutingResponse <$> getWord8 <*> getPublicKey
2 -> ConnectNotification <$> getWord8
3 -> DisconnectNotification <$> getWord8
4 -> RelayPing <$> getWord64be
5 -> RelayPong <$> getWord64be
6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes)
7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes)
8 -> OnionPacket <$> get
9 -> OnionPacketResponse <$> get
conid -> RelayData conid <$> (remaining >>= getBytes)
put rp = do
putWord8 $ packetNumber rp
case rp of
RoutingRequest k -> putPublicKey k
RoutingResponse rpid k -> putWord8 rpid >> putPublicKey k
ConnectNotification conid -> putWord8 conid
DisconnectNotification conid -> putWord8 conid
RelayPing pingid -> putWord64be pingid
RelayPong pingid -> putWord64be pingid
OOBSend k bs -> putPublicKey k >> putByteString bs
OOBRecv k bs -> putPublicKey k >> putByteString bs
OnionPacket query -> put query
OnionPacketResponse answer -> put answer
RelayData _ bs -> putByteString bs
-- | Initial client-to-server handshake message.
newtype Hello (f :: * -> *) = Hello (Asymm (f HelloData))
helloFrom :: Hello f -> PublicKey
helloFrom (Hello x) = senderKey x
helloNonce :: Hello f -> Nonce24
helloNonce (Hello x) = asymmNonce x
helloData :: Hello f -> f HelloData
helloData (Hello x) = asymmData x
instance Rank2.Functor Hello where
f <$> Hello (Asymm k n dta) = Hello $ Asymm k n (f dta)
instance Payload Serialize Hello where
mapPayload _ f (Hello (Asymm k n dta)) = Hello $ Asymm k n (f dta)
instance Rank2.Foldable Hello where
foldMap f (Hello (Asymm k n dta)) = f dta
instance Rank2.Traversable Hello where
traverse f (Hello (Asymm k n dta)) = Hello . Asymm k n <$> f dta
instance Sized (Hello Encrypted) where
size = ConstSize 56 <> contramap helloData size
instance Serialize (Hello Encrypted) where
get = Hello <$> getAsymm
put (Hello asym) = putAsymm asym
data HelloData = HelloData
{ sessionPublicKey :: PublicKey
, sessionBaseNonce :: Nonce24
}
instance Sized HelloData where size = ConstSize 56
instance Serialize HelloData where
get = HelloData <$> getPublicKey <*> get
put (HelloData k n) = putPublicKey k >> put n
-- | Handshake server-to-client response packet.
data Welcome (f :: * -> *) = Welcome
{ welcomeNonce :: Nonce24
, welcomeData :: f HelloData
}
instance Rank2.Functor Welcome where
f <$> Welcome n dta = Welcome n (f dta)
instance Payload Serialize Welcome where
mapPayload _ f (Welcome n dta) = Welcome n (f dta)
instance Rank2.Foldable Welcome where
foldMap f (Welcome _ dta) = f dta
instance Rank2.Traversable Welcome where
traverse f (Welcome n dta) = Welcome n <$> f dta
instance Sized (Welcome Encrypted) where
size = ConstSize 24 <> contramap welcomeData size
instance Serialize (Welcome Encrypted) where
get = Welcome <$> get <*> get
put (Welcome n dta) = put n >> put dta
|
