diff options
Diffstat (limited to 'src/Data')
-rw-r--r-- | src/Data/Tox.hs | 81 |
1 files changed, 78 insertions, 3 deletions
diff --git a/src/Data/Tox.hs b/src/Data/Tox.hs index 448b39eb..4449ce65 100644 --- a/src/Data/Tox.hs +++ b/src/Data/Tox.hs | |||
@@ -1,5 +1,7 @@ | |||
1 | {-# LANGUAGE DeriveDataTypeable #-} | 1 | {-# LANGUAGE DeriveDataTypeable #-} |
2 | {-# LANGUAGE DeriveGeneric #-} | 2 | {-# LANGUAGE DeriveGeneric #-} |
3 | {-# LANGUAGE DeriveTraversable #-} | ||
4 | {-# LANGUAGE DeriveFunctor #-} | ||
3 | {-# LANGUAGE PatternSynonyms #-} | 5 | {-# LANGUAGE PatternSynonyms #-} |
4 | {-# LANGUAGE RecordWildCards #-} | 6 | {-# LANGUAGE RecordWildCards #-} |
5 | {-# LANGUAGE TupleSections #-} | 7 | {-# LANGUAGE TupleSections #-} |
@@ -15,6 +17,9 @@ import Data.Serialize | |||
15 | import Network.BitTorrent.Address () -- Serialize IP | 17 | import Network.BitTorrent.Address () -- Serialize IP |
16 | import GHC.Generics (Generic) | 18 | import GHC.Generics (Generic) |
17 | import Network.Socket | 19 | import Network.Socket |
20 | import Network.RPC hiding (NodeId) | ||
21 | import qualified Network.RPC as Envelope (NodeId) | ||
22 | import Crypto.PubKey.ECC.Types | ||
18 | 23 | ||
19 | type Key32 = Word256 -- 32 byte key | 24 | type Key32 = Word256 -- 32 byte key |
20 | type Nonce8 = Word64 -- 8 bytes | 25 | type Nonce8 = Word64 -- 8 bytes |
@@ -88,7 +93,7 @@ data Message a = Message | |||
88 | , msgNonce :: Nonce24 | 93 | , msgNonce :: Nonce24 |
89 | , msgPayload :: a | 94 | , msgPayload :: a |
90 | } | 95 | } |
91 | deriving (Show, Generic) | 96 | deriving (Show, Generic, Functor, Foldable, Traversable) |
92 | 97 | ||
93 | isQuery :: Message a -> Bool | 98 | isQuery :: Message a -> Bool |
94 | isQuery (Message { msgType = SendNodes }) = False | 99 | isQuery (Message { msgType = SendNodes }) = False |
@@ -101,8 +106,6 @@ isResponse m = not (isQuery m) | |||
101 | isError :: Message a -> Bool | 106 | isError :: Message a -> Bool |
102 | isError _ = False | 107 | isError _ = False |
103 | 108 | ||
104 | instance Serialize a => Serialize (Message a) where -- TODO TOX | ||
105 | |||
106 | data PingPayload = PingPayload | 109 | data PingPayload = PingPayload |
107 | { isPong :: Bool | 110 | { isPong :: Bool |
108 | , pingId :: Nonce8 | 111 | , pingId :: Nonce8 |
@@ -194,3 +197,75 @@ instance Serialize NodeFormat where | |||
194 | -- [Sendback data, length=8 bytes] | 197 | -- [Sendback data, length=8 bytes] |
195 | -- ] | 198 | -- ] |
196 | 199 | ||
200 | data ToxCipherContext = ToxCipherContext -- TODO | ||
201 | |||
202 | newtype Ciphered = Ciphered { cipheredBytes :: ByteString } | ||
203 | |||
204 | getMessage :: Get (Message Ciphered) | ||
205 | getMessage = do | ||
206 | typ <- get | ||
207 | nid <- get | ||
208 | tid <- get | ||
209 | cnt <- remaining | ||
210 | bs <- getBytes cnt | ||
211 | return Message { msgType = typ | ||
212 | , msgClient = nid | ||
213 | , msgNonce = tid | ||
214 | , msgPayload = Ciphered bs } | ||
215 | |||
216 | putMessage :: Message Ciphered -> Put | ||
217 | putMessage (Message {..}) = do | ||
218 | put msgType | ||
219 | put msgClient | ||
220 | put msgNonce | ||
221 | let Ciphered bs = msgPayload | ||
222 | putByteString bs | ||
223 | |||
224 | decipher :: ToxCipherContext -> Message Ciphered -> Either String (Message ByteString) | ||
225 | decipher = error "TODO TOX: decipher" | ||
226 | |||
227 | encipher :: ToxCipherContext -> Message ByteString -> Message Ciphered | ||
228 | encipher = error "TODO TOX: encipher" | ||
229 | |||
230 | -- see rfc7748 | ||
231 | curve25519 :: Curve | ||
232 | curve25519 = CurveFP (CurvePrime prime curvecommon) | ||
233 | where | ||
234 | prime = 2^255 - 19 -- (≅ 1 modulo 4) | ||
235 | |||
236 | -- 1 * v^2 = u^3 + 486662*u^2 + u | ||
237 | |||
238 | curvecommon = CurveCommon | ||
239 | { ecc_a = 486662 | ||
240 | , ecc_b = 1 | ||
241 | , ecc_g = Point 9 14781619447589544791020593568409986887264606134616475288964881837755586237401 -- base point | ||
242 | , ecc_n = 2^252 + 0x14def9dea2f79cd65812631a5cf5d3ed -- order | ||
243 | , ecc_h = 8 -- cofactor | ||
244 | } | ||
245 | |||
246 | |||
247 | |||
248 | instance Envelope Message where | ||
249 | type TransactionID Message = Nonce24 | ||
250 | type NodeId Message = NodeId | ||
251 | |||
252 | envelopePayload = msgPayload | ||
253 | |||
254 | envelopeTransaction = msgNonce | ||
255 | |||
256 | envelopeClass Message { msgType = Ping } = Query | ||
257 | envelopeClass Message { msgType = Pong } = Response | ||
258 | envelopeClass Message { msgType = GetNodes } = Query | ||
259 | envelopeClass Message { msgType = SendNodes } = Response | ||
260 | |||
261 | buildReply self addr qry payload = (fmap (const payload) qry) { msgClient = self } | ||
262 | |||
263 | instance WireFormat ByteString Message where | ||
264 | type SerializableTo ByteString = Serialize | ||
265 | type CipherContext ByteString Message = ToxCipherContext | ||
266 | |||
267 | decodePayload = mapM decode | ||
268 | encodePayload = fmap encode | ||
269 | |||
270 | decodeHeaders ctx bs = runGet getMessage bs >>= decipher ctx | ||
271 | encodeHeaders ctx msg = runPut $ putMessage $ encipher ctx msg | ||