summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Tox.hs279
1 files changed, 0 insertions, 279 deletions
diff --git a/src/Data/Tox.hs b/src/Data/Tox.hs
deleted file mode 100644
index b79e0b9a..00000000
--- a/src/Data/Tox.hs
+++ /dev/null
@@ -1,279 +0,0 @@
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE StandaloneDeriving #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE DeriveDataTypeable #-}
5{-# LANGUAGE DeriveFunctor #-}
6{-# LANGUAGE DeriveGeneric #-}
7{-# LANGUAGE DeriveTraversable #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE PatternSynonyms #-}
10{-# LANGUAGE RecordWildCards #-}
11{-# LANGUAGE TupleSections #-}
12{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE UnboxedTuples #-}
14module Data.Tox where
15
16import Data.Bits
17import Data.ByteString (ByteString)
18import Data.Data (Data)
19import Data.Word
20import Data.LargeWord
21import Data.IP
22import Data.Serialize
23-- import Network.BitTorrent.Address (NodeInfo(..)) -- Serialize IP
24import GHC.Generics (Generic)
25import Network.Socket
26import Network.DatagramServer.Types
27import qualified Network.DatagramServer.Types as Envelope (NodeId)
28import Crypto.PubKey.ECC.Types
29
30type Key32 = Word256 -- 32 byte key
31type Nonce8 = Word64 -- 8 bytes
32type Nonce24 = Word192 -- 24 bytes
33
34
35data NodeFormat = NodeFormat
36 { nodePublicKey :: Key32 -- 32 byte public key
37 , nodeIsTCP :: Bool -- This has no analog in mainline NodeInfo structure
38 , nodeIP :: IP -- IPv4 or IPv6 address
39 , nodePort :: PortNumber
40 }
41 deriving (Eq, Ord, Show)
42
43encodeFamily :: (Family, SocketType) -> Word8
44encodeFamily (AF_INET , Datagram) = 2
45encodeFamily (AF_INET6 , Datagram) = 10
46encodeFamily (AF_INET , Stream ) = 130
47encodeFamily (AF_INET6 , Stream ) = 138
48encodeFamily _ = error "Unsupported protocol"
49
50newtype MessageType = MessageType Word8
51 deriving (Eq, Ord, Show, Read)
52
53instance Serialize MessageType where
54 put (MessageType b) = put b
55 get = MessageType <$> get
56
57pattern Ping = MessageType 0
58pattern Pong = MessageType 1
59pattern GetNodes = MessageType 2
60pattern SendNodes = MessageType 4
61{-
62 #define NET_PACKET_PING_REQUEST 0 /* Ping request packet ID. */
63 #define NET_PACKET_PING_RESPONSE 1 /* Ping response packet ID. */
64 #define NET_PACKET_GET_NODES 2 /* Get nodes request packet ID. */
65 #define NET_PACKET_SEND_NODES_IPV6 4 /* Send nodes response packet ID for other addresses. */
66 #define NET_PACKET_COOKIE_REQUEST 24 /* Cookie request packet */
67 #define NET_PACKET_COOKIE_RESPONSE 25 /* Cookie response packet */
68 #define NET_PACKET_CRYPTO_HS 26 /* Crypto handshake packet */
69 #define NET_PACKET_CRYPTO_DATA 27 /* Crypto data packet */
70 #define NET_PACKET_CRYPTO 32 /* Encrypted data packet ID. */
71 #define NET_PACKET_LAN_DISCOVERY 33 /* LAN discovery packet ID. */
72
73 /* See: docs/Prevent_Tracking.txt and onion.{c, h} */
74 #define NET_PACKET_ONION_SEND_INITIAL 128
75 #define NET_PACKET_ONION_SEND_1 129
76 #define NET_PACKET_ONION_SEND_2 130
77
78 #define NET_PACKET_ANNOUNCE_REQUEST 131
79 #define NET_PACKET_ANNOUNCE_RESPONSE 132
80 #define NET_PACKET_ONION_DATA_REQUEST 133
81 #define NET_PACKET_ONION_DATA_RESPONSE 134
82
83 #define NET_PACKET_ONION_RECV_3 140
84 #define NET_PACKET_ONION_RECV_2 141
85 #define NET_PACKET_ONION_RECV_1 142
86 -}
87
88
89-- FIXME Orphan Serialize intance for large words
90instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
91 put (LargeKey lo hi) = put hi >> put lo
92 get = flip LargeKey <$> get <*> get
93
94-- | Use with 'PingPayload', 'GetNodesPayload', or 'SendNodesPayload'
95data Message a = Message
96 { msgType :: MessageType
97 , msgClient :: NodeId Message
98 , msgNonce :: Nonce24
99 , msgPayload :: a
100 }
101 deriving (Show, Generic, Functor, Foldable, Traversable)
102
103deriving instance Show (NodeId Message) -- TODO: print as hex
104
105isQuery :: Message a -> Bool
106isQuery (Message { msgType = SendNodes }) = False
107isQuery (Message { msgType = MessageType typ }) | even typ = True
108isQuery _ = False
109
110isResponse :: Message a -> Bool
111isResponse m = not (isQuery m)
112
113isError :: Message a -> Bool
114isError _ = False
115
116data PingPayload = PingPayload
117 { isPong :: Bool
118 , pingId :: Nonce8
119 }
120
121data GetNodesPayload = GetNodesPayload
122 { nodesForWho :: NodeId Message
123 , nodesNonce :: Nonce8
124 }
125
126data SendNodesPayload = SendNodesPayload
127
128-- From: docs/updates/DHT.md
129--
130-- Node format:
131-- [uint8_t family (2 == IPv4, 10 == IPv6, 130 == TCP IPv4, 138 == TCP IPv6)]
132-- [ip (in network byte order), length=4 bytes if ipv4, 16 bytes if ipv6]
133-- [port (in network byte order), length=2 bytes]
134-- [char array (node_id), length=32 bytes]
135--
136-- see also: DHT.h (pack_nodes() and unpack_nodes())
137instance Serialize NodeFormat where
138
139 get = do
140 typ <- get :: Get Word8
141 (ip,istcp) <-
142 case typ :: Word8 of
143 2 -> (,False) . IPv4 <$> get
144 130 -> (,True) . IPv4 <$> get
145 10 -> (,False) . IPv6 <$> get
146 138 -> (,True) . IPv6 <$> get
147 _ -> fail "Unsupported type of Tox node_format structure"
148 port <- get
149 pubkey <- get
150 return $ NodeFormat { nodeIsTCP = istcp
151 , nodeIP = ip
152 , nodePort = port
153 , nodePublicKey = pubkey
154 }
155
156 put (NodeFormat{..}) = do
157 put $ case (# nodeIP, nodeIsTCP #) of
158 (# IPv4 _, False #) -> 2
159 (# IPv4 _, True #) -> 130
160 (# IPv6 _, False #) -> 10
161 (# IPv6 _, True #) -> 138 :: Word8
162 put nodeIP
163 put nodePort
164 put nodePublicKey
165
166-- Note: the char array is a public key, the 32-bytes is provided by libsodium-dev
167-- in /usr/include/sodium/crypto_box.h as the symbol crypto_box_PUBLICKEYBYTES
168-- but toxcore/crypto_core.c will fail to compile if it is not 32.
169
170
171-- Ping(Request and response):
172--
173-- [byte with value: 00 for request, 01 for response]
174-- [char array (client node_id), length=32 bytes]
175-- [random 24 byte nonce]
176-- [Encrypted with the nonce and private key of the sender:
177-- [1 byte type (0 for request, 1 for response)]
178-- [random 8 byte (ping_id)]
179-- ]
180--
181-- ping_id = a random integer, the response must contain the exact same number as the request
182
183
184-- Get nodes (Request):
185--
186-- [byte with value: 02]
187-- [char array (client node_id), length=32 bytes]
188-- [random 24 byte nonce]
189-- [Encrypted with the nonce and private key of the sender:
190-- [char array: requested_node_id (node_id of which we want the ip), length=32 bytes]
191-- [Sendback data (must be sent back unmodified by in the response), length=8 bytes]
192-- ]
193--
194-- Valid replies: a send_nodes packet
195
196-- Send_nodes (response (for all addresses)):
197--
198-- [byte with value: 04]
199-- [char array (client node_id), length=32 bytes]
200-- [random 24 byte nonce]
201-- [Encrypted with the nonce and private key of the sender:
202-- [uint8_t number of nodes in this packet]
203-- [Nodes in node format, length=?? * (number of nodes (maximum of 4 nodes)) bytes]
204-- [Sendback data, length=8 bytes]
205-- ]
206
207data ToxCipherContext = ToxCipherContext -- TODO
208
209newtype Ciphered = Ciphered { cipheredBytes :: ByteString }
210
211getMessage :: Get (Message Ciphered)
212getMessage = do
213 typ <- get
214 nid <- get
215 tid <- get
216 cnt <- remaining
217 bs <- getBytes cnt
218 return Message { msgType = typ
219 , msgClient = nid
220 , msgNonce = tid
221 , msgPayload = Ciphered bs }
222
223putMessage :: Message Ciphered -> Put
224putMessage (Message {..}) = do
225 put msgType
226 put msgClient
227 put msgNonce
228 let Ciphered bs = msgPayload
229 putByteString bs
230
231decipher :: ToxCipherContext -> Message Ciphered -> Either String (Message ByteString)
232decipher = error "TODO TOX: decipher"
233
234encipher :: ToxCipherContext -> Message ByteString -> Message Ciphered
235encipher = error "TODO TOX: encipher"
236
237-- see rfc7748
238curve25519 :: Curve
239curve25519 = CurveFP (CurvePrime prime curvecommon)
240 where
241 prime = 2^255 - 19 -- (≅ 1 modulo 4)
242
243 -- 1 * v^2 = u^3 + 486662*u^2 + u
244
245 curvecommon = CurveCommon
246 { ecc_a = 486662
247 , ecc_b = 1
248 , ecc_g = Point 9 14781619447589544791020593568409986887264606134616475288964881837755586237401 -- base point
249 , ecc_n = 2^252 + 0x14def9dea2f79cd65812631a5cf5d3ed -- order
250 , ecc_h = 8 -- cofactor
251 }
252
253
254
255instance Envelope Message where
256 type TransactionID Message = Nonce24
257 newtype NodeId Message = NodeId Word256
258 deriving (Serialize, Eq, Ord, Bits, FiniteBits)
259
260 envelopePayload = msgPayload
261
262 envelopeTransaction = msgNonce
263
264 envelopeClass Message { msgType = Ping } = Query
265 envelopeClass Message { msgType = Pong } = Response
266 envelopeClass Message { msgType = GetNodes } = Query
267 envelopeClass Message { msgType = SendNodes } = Response
268
269 buildReply self addr qry payload = (fmap (const payload) qry) { msgClient = self }
270
271instance WireFormat ByteString Message where
272 type SerializableTo ByteString = Serialize
273 type CipherContext ByteString Message = ToxCipherContext
274
275 decodePayload = mapM decode
276 encodePayload = fmap encode
277
278 decodeHeaders ctx bs = runGet getMessage bs >>= decipher ctx
279 encodeHeaders ctx msg = runPut $ putMessage $ encipher ctx msg
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 15:52:34 +0000