diff options
author | Joe Crayne <joe@jerkface.net> | 2018-11-28 22:19:33 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-12-16 14:08:26 -0500 |
commit | d8797823bb3cbf91eabad48c400632dcecfec245 (patch) | |
tree | 16fbe3de1231573789487d5ac175910679fbd682 /src/Data/Tox | |
parent | 92fce0499c05c609cba423ea02f5c61aa33c6915 (diff) |
Use getPublicKey/putPublicKey more liberally.
Diffstat (limited to 'src/Data/Tox')
-rw-r--r-- | src/Data/Tox/Relay.hs | 55 |
1 files changed, 26 insertions, 29 deletions
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 @@ | |||
5 | {-# LANGUAGE ConstraintKinds #-} | 5 | {-# LANGUAGE ConstraintKinds #-} |
6 | module Data.Tox.Relay where | 6 | module Data.Tox.Relay where |
7 | 7 | ||
8 | import Crypto.Error | ||
9 | import Data.ByteArray as BA | ||
10 | import Data.ByteString as B | 8 | import Data.ByteString as B |
11 | import Data.Data | 9 | import Data.Data |
12 | import Data.Functor.Contravariant | 10 | import Data.Functor.Contravariant |
@@ -17,7 +15,6 @@ import qualified Rank2 | |||
17 | 15 | ||
18 | import Crypto.Tox | 16 | import Crypto.Tox |
19 | import Network.Tox.Onion.Transport | 17 | import Network.Tox.Onion.Transport |
20 | import Network.Tox.NodeId (key2id,id2key) | ||
21 | 18 | ||
22 | data RelayPacket | 19 | data RelayPacket |
23 | = RoutingRequest PublicKey | 20 | = RoutingRequest PublicKey |
@@ -61,14 +58,14 @@ instance Serialize RelayPacket where | |||
61 | get = do | 58 | get = do |
62 | pktid <- getWord8 | 59 | pktid <- getWord8 |
63 | case pktid of | 60 | case pktid of |
64 | 0 -> RoutingRequest <$> (id2key <$> get) | 61 | 0 -> RoutingRequest <$> getPublicKey |
65 | 1 -> RoutingResponse <$> getWord8 <*> (id2key <$> get) | 62 | 1 -> RoutingResponse <$> getWord8 <*> getPublicKey |
66 | 2 -> ConnectNotification <$> getWord8 | 63 | 2 -> ConnectNotification <$> getWord8 |
67 | 3 -> DisconnectNotification <$> getWord8 | 64 | 3 -> DisconnectNotification <$> getWord8 |
68 | 4 -> RelayPing <$> getWord64be | 65 | 4 -> RelayPing <$> getWord64be |
69 | 5 -> RelayPong <$> getWord64be | 66 | 5 -> RelayPong <$> getWord64be |
70 | 6 -> OOBSend <$> (id2key <$> get) <*> (remaining >>= getBytes) | 67 | 6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes) |
71 | 7 -> OOBRecv <$> (id2key <$> get) <*> (remaining >>= getBytes) | 68 | 7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes) |
72 | 8 -> OnionPacket <$> get | 69 | 8 -> OnionPacket <$> get |
73 | 9 -> OnionPacketResponse <$> get | 70 | 9 -> OnionPacketResponse <$> get |
74 | conid -> RelayData conid <$> (remaining >>= getBytes) | 71 | conid -> RelayData conid <$> (remaining >>= getBytes) |
@@ -76,48 +73,48 @@ instance Serialize RelayPacket where | |||
76 | put rp = do | 73 | put rp = do |
77 | putWord8 $ packetNumber rp | 74 | putWord8 $ packetNumber rp |
78 | case rp of | 75 | case rp of |
79 | RoutingRequest k -> put (key2id k) | 76 | RoutingRequest k -> putPublicKey k |
80 | RoutingResponse rpid k -> putWord8 rpid >> put (key2id k) | 77 | RoutingResponse rpid k -> putWord8 rpid >> putPublicKey k |
81 | ConnectNotification conid -> putWord8 conid | 78 | ConnectNotification conid -> putWord8 conid |
82 | DisconnectNotification conid -> putWord8 conid | 79 | DisconnectNotification conid -> putWord8 conid |
83 | RelayPing pingid -> putWord64be pingid | 80 | RelayPing pingid -> putWord64be pingid |
84 | RelayPong pingid -> putWord64be pingid | 81 | RelayPong pingid -> putWord64be pingid |
85 | OOBSend k bs -> put (key2id k) >> putByteString bs | 82 | OOBSend k bs -> putPublicKey k >> putByteString bs |
86 | OOBRecv k bs -> put (key2id k) >> putByteString bs | 83 | OOBRecv k bs -> putPublicKey k >> putByteString bs |
87 | OnionPacket query -> put query | 84 | OnionPacket query -> put query |
88 | OnionPacketResponse answer -> put answer | 85 | OnionPacketResponse answer -> put answer |
89 | RelayData _ bs -> putByteString bs | 86 | RelayData _ bs -> putByteString bs |
90 | 87 | ||
91 | -- | Initial client-to-server handshake message. | 88 | -- | Initial client-to-server handshake message. |
92 | data Hello (f :: * -> *) = Hello | 89 | newtype Hello (f :: * -> *) = Hello (Asymm (f HelloData)) |
93 | { helloFrom :: PublicKey | 90 | |
94 | , helloNonce :: Nonce24 | 91 | helloFrom :: Hello f -> PublicKey |
95 | , helloData :: f HelloData | 92 | helloFrom (Hello x) = senderKey x |
96 | } | 93 | |
94 | helloNonce :: Hello f -> Nonce24 | ||
95 | helloNonce (Hello x) = asymmNonce x | ||
96 | |||
97 | helloData :: Hello f -> f HelloData | ||
98 | helloData (Hello x) = asymmData x | ||
97 | 99 | ||
98 | instance Rank2.Functor Hello where | 100 | instance Rank2.Functor Hello where |
99 | f <$> Hello k n dta = Hello k n (f dta) | 101 | f <$> Hello (Asymm k n dta) = Hello $ Asymm k n (f dta) |
100 | 102 | ||
101 | instance Payload Serialize Hello where | 103 | instance Payload Serialize Hello where |
102 | mapPayload _ f (Hello k n dta) = Hello k n (f dta) | 104 | mapPayload _ f (Hello (Asymm k n dta)) = Hello $ Asymm k n (f dta) |
103 | 105 | ||
104 | instance Rank2.Foldable Hello where | 106 | instance Rank2.Foldable Hello where |
105 | foldMap f (Hello k n dta) = f dta | 107 | foldMap f (Hello (Asymm k n dta)) = f dta |
106 | 108 | ||
107 | instance Rank2.Traversable Hello where | 109 | instance Rank2.Traversable Hello where |
108 | traverse f (Hello k n dta) = Hello k n <$> f dta | 110 | traverse f (Hello (Asymm k n dta)) = Hello . Asymm k n <$> f dta |
109 | 111 | ||
110 | instance Sized (Hello Encrypted) where | 112 | instance Sized (Hello Encrypted) where |
111 | size = ConstSize 56 <> contramap helloData size | 113 | size = ConstSize 56 <> contramap helloData size |
112 | 114 | ||
113 | instance Serialize (Hello Encrypted) where | 115 | instance Serialize (Hello Encrypted) where |
114 | get = do CryptoPassed k <- publicKey <$> getBytes 32 | 116 | get = Hello <$> getAsymm |
115 | n <- get | 117 | put (Hello asym) = putAsymm asym |
116 | dta <- get | ||
117 | return $ Hello k n dta | ||
118 | put (Hello k n dta) = do mapM_ putWord8 $ BA.unpack k | ||
119 | put n | ||
120 | put dta | ||
121 | 118 | ||
122 | data HelloData = HelloData | 119 | data HelloData = HelloData |
123 | { sessionPublicKey :: PublicKey | 120 | { sessionPublicKey :: PublicKey |
@@ -127,8 +124,8 @@ data HelloData = HelloData | |||
127 | instance Sized HelloData where size = ConstSize 56 | 124 | instance Sized HelloData where size = ConstSize 56 |
128 | 125 | ||
129 | instance Serialize HelloData where | 126 | instance Serialize HelloData where |
130 | get = HelloData <$> (id2key <$> get) <*> get | 127 | get = HelloData <$> getPublicKey <*> get |
131 | put (HelloData k n) = put (key2id k) >> put n | 128 | put (HelloData k n) = putPublicKey k >> put n |
132 | 129 | ||
133 | -- | Handshake server-to-client response packet. | 130 | -- | Handshake server-to-client response packet. |
134 | data Welcome (f :: * -> *) = Welcome | 131 | data Welcome (f :: * -> *) = Welcome |