summaryrefslogtreecommitdiff
path: root/src/Data/Tox/Relay.hs
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2018-11-28 22:19:33 -0500
committerJoe Crayne <joe@jerkface.net>2018-12-16 14:08:26 -0500
commitd8797823bb3cbf91eabad48c400632dcecfec245 (patch)
tree16fbe3de1231573789487d5ac175910679fbd682 /src/Data/Tox/Relay.hs
parent92fce0499c05c609cba423ea02f5c61aa33c6915 (diff)
Use getPublicKey/putPublicKey more liberally.
Diffstat (limited to 'src/Data/Tox/Relay.hs')
-rw-r--r--src/Data/Tox/Relay.hs55
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 #-}
6module Data.Tox.Relay where 6module Data.Tox.Relay where
7 7
8import Crypto.Error
9import Data.ByteArray as BA
10import Data.ByteString as B 8import Data.ByteString as B
11import Data.Data 9import Data.Data
12import Data.Functor.Contravariant 10import Data.Functor.Contravariant
@@ -17,7 +15,6 @@ import qualified Rank2
17 15
18import Crypto.Tox 16import Crypto.Tox
19import Network.Tox.Onion.Transport 17import Network.Tox.Onion.Transport
20import Network.Tox.NodeId (key2id,id2key)
21 18
22data RelayPacket 19data 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.
92data Hello (f :: * -> *) = Hello 89newtype Hello (f :: * -> *) = Hello (Asymm (f HelloData))
93 { helloFrom :: PublicKey 90
94 , helloNonce :: Nonce24 91helloFrom :: Hello f -> PublicKey
95 , helloData :: f HelloData 92helloFrom (Hello x) = senderKey x
96 } 93
94helloNonce :: Hello f -> Nonce24
95helloNonce (Hello x) = asymmNonce x
96
97helloData :: Hello f -> f HelloData
98helloData (Hello x) = asymmData x
97 99
98instance Rank2.Functor Hello where 100instance 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
101instance Payload Serialize Hello where 103instance 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
104instance Rank2.Foldable Hello where 106instance 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
107instance Rank2.Traversable Hello where 109instance 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
110instance Sized (Hello Encrypted) where 112instance Sized (Hello Encrypted) where
111 size = ConstSize 56 <> contramap helloData size 113 size = ConstSize 56 <> contramap helloData size
112 114
113instance Serialize (Hello Encrypted) where 115instance 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
122data HelloData = HelloData 119data HelloData = HelloData
123 { sessionPublicKey :: PublicKey 120 { sessionPublicKey :: PublicKey
@@ -127,8 +124,8 @@ data HelloData = HelloData
127instance Sized HelloData where size = ConstSize 56 124instance Sized HelloData where size = ConstSize 56
128 125
129instance Serialize HelloData where 126instance 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.
134data Welcome (f :: * -> *) = Welcome 131data Welcome (f :: * -> *) = Welcome