diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 4 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Transport.hs | 10 | ||||
-rw-r--r-- | src/Network/Tox/DHT/Handlers.hs | 12 | ||||
-rw-r--r-- | src/Network/Tox/DHT/Transport.hs | 25 |
4 files changed, 28 insertions, 23 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index f650a815..56fb4dcf 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -222,7 +222,7 @@ data NetCryptoSession = NCrypto | |||
222 | , ncTheirBaseNonce :: TVar (UponHandshake Nonce24) -- base nonce + packet number | 222 | , ncTheirBaseNonce :: TVar (UponHandshake Nonce24) -- base nonce + packet number |
223 | , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number | 223 | , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number |
224 | , ncHandShake :: TVar (UponHandshake (Handshake Encrypted)) | 224 | , ncHandShake :: TVar (UponHandshake (Handshake Encrypted)) |
225 | , ncCookie :: TVar (UponCookie Cookie) -- ^ Cookie issued by remote peer | 225 | , ncCookie :: TVar (UponCookie (Cookie Encrypted)) -- ^ Cookie issued by remote peer |
226 | , ncTheirDHTKey :: UponDHTKey PublicKey | 226 | , ncTheirDHTKey :: UponDHTKey PublicKey |
227 | , ncTheirSessionPublic :: TVar (UponHandshake PublicKey) | 227 | , ncTheirSessionPublic :: TVar (UponHandshake PublicKey) |
228 | , ncSessionSecret :: SecretKey | 228 | , ncSessionSecret :: SecretKey |
@@ -387,7 +387,7 @@ newSessionsState crypto unrechook hooks = do | |||
387 | data HandshakeParams | 387 | data HandshakeParams |
388 | = HParam | 388 | = HParam |
389 | { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own | 389 | { hpTheirBaseNonce :: Maybe Nonce24 -- ignore and generate your own |
390 | , hpOtherCookie :: Cookie | 390 | , hpOtherCookie :: Cookie Encrypted |
391 | , hpTheirSessionKeyPublic :: Maybe PublicKey | 391 | , hpTheirSessionKeyPublic :: Maybe PublicKey |
392 | , hpMySecretKey :: SecretKey | 392 | , hpMySecretKey :: SecretKey |
393 | , hpCookieRemotePubkey :: PublicKey | 393 | , hpCookieRemotePubkey :: PublicKey |
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs index 0588da4b..e23d1865 100644 --- a/src/Network/Tox/Crypto/Transport.hs +++ b/src/Network/Tox/Crypto/Transport.hs | |||
@@ -99,7 +99,7 @@ data Handshake (f :: * -> *) = Handshake | |||
99 | -- response packet with a cookie in it. It may also be obtained in the | 99 | -- response packet with a cookie in it. It may also be obtained in the |
100 | -- handshake packet by a peer receiving a handshake packet (Other | 100 | -- handshake packet by a peer receiving a handshake packet (Other |
101 | -- Cookie). | 101 | -- Cookie). |
102 | handshakeCookie :: Cookie | 102 | handshakeCookie :: Cookie f |
103 | -- The nonce is a nonce used to encrypt the encrypted part of the handshake | 103 | -- The nonce is a nonce used to encrypt the encrypted part of the handshake |
104 | -- packet. | 104 | -- packet. |
105 | , handshakeNonce :: Nonce24 | 105 | , handshakeNonce :: Nonce24 |
@@ -113,10 +113,10 @@ instance Serialize (Handshake Encrypted) where | |||
113 | put (Handshake cookie n24 dta) = put cookie >> put n24 >> put dta | 113 | put (Handshake cookie n24 dta) = put cookie >> put n24 >> put dta |
114 | 114 | ||
115 | data HandshakeData = HandshakeData | 115 | data HandshakeData = HandshakeData |
116 | { baseNonce :: Nonce24 | 116 | { baseNonce :: Nonce24 -- ^ [24 bytes base nonce] |
117 | , sessionKey :: PublicKey | 117 | , sessionKey :: PublicKey -- ^ [session public key of the peer (32 bytes)] |
118 | , cookieHash :: Digest SHA512 | 118 | , cookieHash :: Digest SHA512 -- ^ [sha512 hash of the entire Cookie sitting outside the encrypted part] |
119 | , otherCookie :: Cookie | 119 | , otherCookie :: Cookie Encrypted -- ^ [Other Cookie (used by the other to respond to the handshake packet)] |
120 | } | 120 | } |
121 | 121 | ||
122 | instance Sized HandshakeData where | 122 | instance Sized HandshakeData where |
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs index af6eda8c..238fb0d0 100644 --- a/src/Network/Tox/DHT/Handlers.hs +++ b/src/Network/Tox/DHT/Handlers.hs | |||
@@ -92,7 +92,7 @@ instance Show PacketKind where | |||
92 | showsPrec d (PacketKind x) = mappend "PacketKind " . showsPrec (d+1) x | 92 | showsPrec d (PacketKind x) = mappend "PacketKind " . showsPrec (d+1) x |
93 | 93 | ||
94 | msgType :: ( Serialize (f DHTRequest) | 94 | msgType :: ( Serialize (f DHTRequest) |
95 | , Serialize (f Cookie), Serialize (f CookieRequest) | 95 | , Serialize (f (Cookie Encrypted)), Serialize (f CookieRequest) |
96 | , Serialize (f SendNodes), Serialize (f GetNodes) | 96 | , Serialize (f SendNodes), Serialize (f GetNodes) |
97 | , Serialize (f Pong), Serialize (f Ping) | 97 | , Serialize (f Pong), Serialize (f Ping) |
98 | ) => DHTMessage f -> PacketKind | 98 | ) => DHTMessage f -> PacketKind |
@@ -218,7 +218,7 @@ getNodesH routing addr (GetNodes nid) = do | |||
218 | 218 | ||
219 | k = 4 | 219 | k = 4 |
220 | 220 | ||
221 | createCookie :: TransportCrypto -> NodeInfo -> PublicKey -> IO Cookie | 221 | createCookie :: TransportCrypto -> NodeInfo -> PublicKey -> IO (Cookie Encrypted) |
222 | createCookie crypto ni remoteUserKey = do | 222 | createCookie crypto ni remoteUserKey = do |
223 | (n24,sym) <- atomically $ do | 223 | (n24,sym) <- atomically $ do |
224 | n24 <- transportNewNonce crypto | 224 | n24 <- transportNewNonce crypto |
@@ -234,7 +234,7 @@ createCookie crypto ni remoteUserKey = do | |||
234 | dput XNetCrypto $ "Created cookie with n24 = 0x" ++ show n24 ++ "\n sym=" ++ show sym | 234 | dput XNetCrypto $ "Created cookie with n24 = 0x" ++ show n24 ++ "\n sym=" ++ show sym |
235 | return $ Cookie n24 edta | 235 | return $ Cookie n24 edta |
236 | 236 | ||
237 | cookieRequestH :: TransportCrypto -> NodeInfo -> CookieRequest -> IO Cookie | 237 | cookieRequestH :: TransportCrypto -> NodeInfo -> CookieRequest -> IO (Cookie Encrypted) |
238 | cookieRequestH crypto ni (CookieRequest remoteUserKey) = do | 238 | cookieRequestH crypto ni (CookieRequest remoteUserKey) = do |
239 | dput XNetCrypto $ unlines | 239 | dput XNetCrypto $ unlines |
240 | [ "CookieRequest! remoteUserKey=" ++ show (key2id remoteUserKey) | 240 | [ "CookieRequest! remoteUserKey=" ++ show (key2id remoteUserKey) |
@@ -311,7 +311,7 @@ loseCookieKey var saddr pk = do | |||
311 | _ -> return () -- unreachable? | 311 | _ -> return () -- unreachable? |
312 | 312 | ||
313 | 313 | ||
314 | cookieRequest :: TransportCrypto -> Client -> PublicKey -> NodeInfo -> IO (Maybe Cookie) | 314 | cookieRequest :: TransportCrypto -> Client -> PublicKey -> NodeInfo -> IO (Maybe (Cookie Encrypted)) |
315 | cookieRequest crypto client localUserKey addr = do | 315 | cookieRequest crypto client localUserKey addr = do |
316 | let sockAddr = nodeAddr addr | 316 | let sockAddr = nodeAddr addr |
317 | nid = id2key $ nodeId addr | 317 | nid = id2key $ nodeId addr |
@@ -330,7 +330,7 @@ cookieRequest crypto client localUserKey addr = do | |||
330 | dput XNetCrypto $ show addr ++ " -cookieResponse-> " ++ show reply | 330 | dput XNetCrypto $ show addr ++ " -cookieResponse-> " ++ show reply |
331 | return $ join reply | 331 | return $ join reply |
332 | 332 | ||
333 | unCookie :: DHTMessage t -> Maybe (t Cookie) | 333 | unCookie :: DHTMessage t -> Maybe (t (Cookie Encrypted)) |
334 | unCookie (DHTCookie n24 fcookie) = Just fcookie | 334 | unCookie (DHTCookie n24 fcookie) = Just fcookie |
335 | unCookie _ = Nothing | 335 | unCookie _ = Nothing |
336 | 336 | ||
@@ -416,7 +416,7 @@ isCookieRequest :: (f CookieRequest -> CookieRequest) -> DHTMessage f -> Either | |||
416 | isCookieRequest unpack (DHTCookieRequest a) = Right $ unpack $ asymmData a | 416 | isCookieRequest unpack (DHTCookieRequest a) = Right $ unpack $ asymmData a |
417 | isCookieRequest _ _ = Left "Bad cookie request" | 417 | isCookieRequest _ _ = Left "Bad cookie request" |
418 | 418 | ||
419 | mkCookie :: TransactionId -> NodeInfo -> NodeInfo -> Cookie -> DHTMessage ((,) Nonce8) | 419 | mkCookie :: TransactionId -> NodeInfo -> NodeInfo -> Cookie Encrypted -> DHTMessage ((,) Nonce8) |
420 | mkCookie (TransactionId n8 n24) src dst cookie = DHTCookie n24 (n8,cookie) | 420 | mkCookie (TransactionId n8 n24) src dst cookie = DHTCookie n24 (n8,cookie) |
421 | 421 | ||
422 | isDHTRequest :: (f DHTRequest -> DHTRequest) -> DHTMessage f -> Either String DHTRequest | 422 | isDHTRequest :: (f DHTRequest -> DHTRequest) -> DHTMessage f -> Either String DHTRequest |
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 59b22673..5fdcd252 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | {-# LANGUAGE FlexibleInstances #-} | ||
1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
2 | {-# LANGUAGE KindSignatures #-} | 4 | {-# LANGUAGE KindSignatures #-} |
3 | {-# LANGUAGE LambdaCase #-} | 5 | {-# LANGUAGE LambdaCase #-} |
@@ -5,7 +7,7 @@ | |||
5 | {-# LANGUAGE StandaloneDeriving #-} | 7 | {-# LANGUAGE StandaloneDeriving #-} |
6 | {-# LANGUAGE TupleSections #-} | 8 | {-# LANGUAGE TupleSections #-} |
7 | {-# LANGUAGE TypeOperators #-} | 9 | {-# LANGUAGE TypeOperators #-} |
8 | {-# LANGUAGE UndecidableInstances #-} | 10 | {-# LANGUAGE UndecidableInstances #-} |
9 | module Network.Tox.DHT.Transport | 11 | module Network.Tox.DHT.Transport |
10 | ( parseDHTAddr | 12 | ( parseDHTAddr |
11 | , encodeDHTAddr | 13 | , encodeDHTAddr |
@@ -68,11 +70,11 @@ data DHTMessage (f :: * -> *) | |||
68 | | DHTGetNodes (Asymm (f GetNodes)) | 70 | | DHTGetNodes (Asymm (f GetNodes)) |
69 | | DHTSendNodes (Asymm (f SendNodes)) | 71 | | DHTSendNodes (Asymm (f SendNodes)) |
70 | | DHTCookieRequest (Asymm (f CookieRequest)) | 72 | | DHTCookieRequest (Asymm (f CookieRequest)) |
71 | | DHTCookie Nonce24 (f Cookie) | 73 | | DHTCookie Nonce24 (f (Cookie Encrypted)) |
72 | | DHTDHTRequest PublicKey (Asymm (f DHTRequest)) | 74 | | DHTDHTRequest PublicKey (Asymm (f DHTRequest)) |
73 | | DHTLanDiscovery NodeId | 75 | | DHTLanDiscovery NodeId |
74 | 76 | ||
75 | deriving instance ( Show (f Cookie) | 77 | deriving instance ( Show (f (Cookie Encrypted)) |
76 | , Show (Asymm (f Ping)) | 78 | , Show (Asymm (f Ping)) |
77 | , Show (Asymm (f Pong)) | 79 | , Show (Asymm (f Pong)) |
78 | , Show (Asymm (f GetNodes)) | 80 | , Show (Asymm (f GetNodes)) |
@@ -123,7 +125,7 @@ encodeDHTAddr :: (DHTMessage Encrypted8,NodeInfo) -> IO (ByteString, SockAddr) | |||
123 | encodeDHTAddr (msg,ni) = return (runPut $ putMessage msg, nodeAddr ni) | 125 | encodeDHTAddr (msg,ni) = return (runPut $ putMessage msg, nodeAddr ni) |
124 | 126 | ||
125 | dhtMessageType :: ( Serialize (f DHTRequest) | 127 | dhtMessageType :: ( Serialize (f DHTRequest) |
126 | , Serialize (f Cookie), Serialize (f CookieRequest) | 128 | , Serialize (f (Cookie Encrypted)), Serialize (f CookieRequest) |
127 | , Serialize (f SendNodes), Serialize (f GetNodes) | 129 | , Serialize (f SendNodes), Serialize (f GetNodes) |
128 | , Serialize (f Pong), Serialize (f Ping) | 130 | , Serialize (f Pong), Serialize (f Ping) |
129 | ) => DHTMessage f -> (Word8, Put) | 131 | ) => DHTMessage f -> (Word8, Put) |
@@ -139,7 +141,7 @@ dhtMessageType (DHTLanDiscovery nid) = (0x21, put nid) | |||
139 | putMessage :: DHTMessage Encrypted8 -> Put | 141 | putMessage :: DHTMessage Encrypted8 -> Put |
140 | putMessage msg = case dhtMessageType msg of (typ,p) -> put typ >> p | 142 | putMessage msg = case dhtMessageType msg of (typ,p) -> put typ >> p |
141 | 143 | ||
142 | getCookie :: Get (Nonce24, Encrypted8 Cookie) | 144 | getCookie :: Get (Nonce24, Encrypted8 (Cookie Encrypted)) |
143 | getCookie = get | 145 | getCookie = get |
144 | 146 | ||
145 | getDHTReqest :: Get (PublicKey, Asymm (Encrypted8 DHTRequest)) | 147 | getDHTReqest :: Get (PublicKey, Asymm (Encrypted8 DHTRequest)) |
@@ -354,15 +356,18 @@ instance S.Serialize Pong where | |||
354 | 356 | ||
355 | newtype CookieRequest = CookieRequest PublicKey | 357 | newtype CookieRequest = CookieRequest PublicKey |
356 | deriving (Eq, Show) | 358 | deriving (Eq, Show) |
357 | newtype CookieResponse = CookieResponse Cookie | 359 | newtype CookieResponse = CookieResponse (Cookie Encrypted) |
358 | deriving (Eq, Show) | 360 | deriving (Eq, Show) |
359 | 361 | ||
360 | data Cookie = Cookie Nonce24 (Encrypted CookieData) | 362 | data Cookie (f :: * -> *) = Cookie Nonce24 (f CookieData) |
361 | deriving (Eq, Ord, Show) | ||
362 | 363 | ||
363 | instance Sized Cookie where size = ConstSize 112 -- 24 byte nonce + 88 byte cookie data | 364 | deriving instance Eq (f CookieData) => Eq (Cookie f) |
365 | deriving instance Ord (f CookieData) => Ord (Cookie f) | ||
366 | deriving instance Show (f CookieData) => Show (Cookie f) | ||
364 | 367 | ||
365 | instance Serialize Cookie where | 368 | instance Sized (Cookie Encrypted) where size = ConstSize 112 -- 24 byte nonce + 88 byte cookie data |
369 | |||
370 | instance Serialize (Cookie Encrypted) where | ||
366 | get = Cookie <$> get <*> get | 371 | get = Cookie <$> get <*> get |
367 | put (Cookie nonce dta) = put nonce >> put dta | 372 | put (Cookie nonce dta) = put nonce >> put dta |
368 | 373 | ||