From d8797823bb3cbf91eabad48c400632dcecfec245 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Wed, 28 Nov 2018 22:19:33 -0500 Subject: Use getPublicKey/putPublicKey more liberally. --- src/Data/Tox/Relay.hs | 55 ++++++++++++++++++------------------- src/Network/Tox/Crypto/Transport.hs | 12 ++++---- src/Network/Tox/DHT/Transport.hs | 8 ++---- 3 files changed, 35 insertions(+), 40 deletions(-) (limited to 'src') diff --git a/src/Data/Tox/Relay.hs b/src/Data/Tox/Relay.hs index a5366f85..bd0e5968 100644 --- a/src/Data/Tox/Relay.hs +++ b/src/Data/Tox/Relay.hs @@ -5,8 +5,6 @@ {-# LANGUAGE ConstraintKinds #-} module Data.Tox.Relay where -import Crypto.Error -import Data.ByteArray as BA import Data.ByteString as B import Data.Data import Data.Functor.Contravariant @@ -17,7 +15,6 @@ import qualified Rank2 import Crypto.Tox import Network.Tox.Onion.Transport -import Network.Tox.NodeId (key2id,id2key) data RelayPacket = RoutingRequest PublicKey @@ -61,14 +58,14 @@ instance Serialize RelayPacket where get = do pktid <- getWord8 case pktid of - 0 -> RoutingRequest <$> (id2key <$> get) - 1 -> RoutingResponse <$> getWord8 <*> (id2key <$> get) + 0 -> RoutingRequest <$> getPublicKey + 1 -> RoutingResponse <$> getWord8 <*> getPublicKey 2 -> ConnectNotification <$> getWord8 3 -> DisconnectNotification <$> getWord8 4 -> RelayPing <$> getWord64be 5 -> RelayPong <$> getWord64be - 6 -> OOBSend <$> (id2key <$> get) <*> (remaining >>= getBytes) - 7 -> OOBRecv <$> (id2key <$> get) <*> (remaining >>= getBytes) + 6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes) + 7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes) 8 -> OnionPacket <$> get 9 -> OnionPacketResponse <$> get conid -> RelayData conid <$> (remaining >>= getBytes) @@ -76,48 +73,48 @@ instance Serialize RelayPacket where put rp = do putWord8 $ packetNumber rp case rp of - RoutingRequest k -> put (key2id k) - RoutingResponse rpid k -> putWord8 rpid >> put (key2id k) + 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 -> put (key2id k) >> putByteString bs - OOBRecv k bs -> put (key2id k) >> putByteString bs + 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. -data Hello (f :: * -> *) = Hello - { helloFrom :: PublicKey - , helloNonce :: Nonce24 - , helloData :: f HelloData - } +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 k n dta = Hello k n (f dta) + f <$> Hello (Asymm k n dta) = Hello $ Asymm k n (f dta) instance Payload Serialize Hello where - mapPayload _ f (Hello k n dta) = Hello k n (f dta) + mapPayload _ f (Hello (Asymm k n dta)) = Hello $ Asymm k n (f dta) instance Rank2.Foldable Hello where - foldMap f (Hello k n dta) = f dta + foldMap f (Hello (Asymm k n dta)) = f dta instance Rank2.Traversable Hello where - traverse f (Hello k n dta) = Hello k n <$> f dta + 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 = do CryptoPassed k <- publicKey <$> getBytes 32 - n <- get - dta <- get - return $ Hello k n dta - put (Hello k n dta) = do mapM_ putWord8 $ BA.unpack k - put n - put dta + get = Hello <$> getAsymm + put (Hello asym) = putAsymm asym data HelloData = HelloData { sessionPublicKey :: PublicKey @@ -127,8 +124,8 @@ data HelloData = HelloData instance Sized HelloData where size = ConstSize 56 instance Serialize HelloData where - get = HelloData <$> (id2key <$> get) <*> get - put (HelloData k n) = put (key2id k) >> put n + get = HelloData <$> getPublicKey <*> get + put (HelloData k n) = putPublicKey k >> put n -- | Handshake server-to-client response packet. data Welcome (f :: * -> *) = Welcome diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs index 555164f2..1c641584 100644 --- a/src/Network/Tox/Crypto/Transport.hs +++ b/src/Network/Tox/Crypto/Transport.hs @@ -170,12 +170,12 @@ instance Sized HandshakeData where instance Serialize HandshakeData where get = HandshakeData <$> get - <*> (id2key <$> get) + <*> getPublicKey <*> (fromJust . digestFromByteString <$> getBytes 64) <*> get put (HandshakeData n k h c) = do put n - put $ key2id k + putPublicKey k putByteString (convert h) put c @@ -724,15 +724,15 @@ instance HasPeerNumber PeerInfo where instance Serialize PeerInfo where get = do w16 <- get - ukey <- id2key <$> get - dkey <- id2key <$> get + ukey <- getPublicKey + dkey <- getPublicKey w8 <- get :: Get Word8 PeerInfo w16 ukey dkey <$> getBytes (fromIntegral w8) put (PeerInfo w16 ukey dkey bs) = do put w16 - put $ key2id ukey - put $ key2id dkey + putPublicKey ukey + putPublicKey dkey let sz :: Word8 sz = case B.length bs of n | n <= 255 -> fromIntegral n diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index e784ec90..b9b63165 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs @@ -382,13 +382,11 @@ instance Sized CookieData where size = ConstSize 72 instance Serialize CookieData where - get = CookieData <$> get - <*> (id2key <$> get) - <*> (id2key <$> get) + get = CookieData <$> get <*> getPublicKey <*> getPublicKey put (CookieData tm userkey dhtkey) = do put tm - put (key2id userkey) - put (key2id dhtkey) + putPublicKey userkey + putPublicKey userkey instance Sized CookieRequest where size = ConstSize 64 -- 32 byte key + 32 byte padding -- cgit v1.2.3