diff options
author | joe <joe@jerkface.net> | 2017-09-01 23:32:31 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-09-01 23:32:31 -0400 |
commit | 52b32cc5d67723d4285610f21a240cf4d0b3a2b0 (patch) | |
tree | 3a2235efc5e493ff95dfa995c357d62a4ac5ee9f /DHTTransport.hs | |
parent | a4038e485c5a303262ebcb8370f1eccb652ebab0 (diff) |
Encryption layer for DHT and Onion transports.
Diffstat (limited to 'DHTTransport.hs')
-rw-r--r-- | DHTTransport.hs | 64 |
1 files changed, 63 insertions, 1 deletions
diff --git a/DHTTransport.hs b/DHTTransport.hs index 97a8113c..690ee346 100644 --- a/DHTTransport.hs +++ b/DHTTransport.hs | |||
@@ -2,6 +2,8 @@ | |||
2 | {-# LANGUAGE KindSignatures #-} | 2 | {-# LANGUAGE KindSignatures #-} |
3 | {-# LANGUAGE LambdaCase #-} | 3 | {-# LANGUAGE LambdaCase #-} |
4 | {-# LANGUAGE RankNTypes #-} | 4 | {-# LANGUAGE RankNTypes #-} |
5 | {-# LANGUAGE TupleSections #-} | ||
6 | {-# LANGUAGE TypeOperators #-} | ||
5 | module DHTTransport | 7 | module DHTTransport |
6 | ( parseDHTAddr | 8 | ( parseDHTAddr |
7 | , encodeDHTAddr | 9 | , encodeDHTAddr |
@@ -16,15 +18,20 @@ module DHTTransport | |||
16 | , Cookie | 18 | , Cookie |
17 | , DHTRequest | 19 | , DHTRequest |
18 | , mapMessage | 20 | , mapMessage |
21 | , encrypt | ||
22 | , decrypt | ||
19 | ) where | 23 | ) where |
20 | 24 | ||
21 | import ToxAddress | 25 | import ToxAddress |
22 | import ToxCrypto | 26 | import ToxCrypto hiding (encrypt,decrypt) |
27 | import qualified ToxCrypto | ||
23 | import Network.QueryResponse | 28 | import Network.QueryResponse |
24 | 29 | ||
25 | import Control.Arrow | 30 | import Control.Arrow |
31 | import Control.Monad | ||
26 | import qualified Data.ByteString as B | 32 | import qualified Data.ByteString as B |
27 | ;import Data.ByteString (ByteString) | 33 | ;import Data.ByteString (ByteString) |
34 | import Data.Tuple | ||
28 | import Data.Serialize as S (Get, Serialize, get, put, runGet) | 35 | import Data.Serialize as S (Get, Serialize, get, put, runGet) |
29 | import Data.Word | 36 | import Data.Word |
30 | import Network.Socket | 37 | import Network.Socket |
@@ -124,6 +131,10 @@ data DHTRequest | |||
124 | | NATPong Nonce8 | 131 | | NATPong Nonce8 |
125 | | DHTPK DHTPublicKey | 132 | | DHTPK DHTPublicKey |
126 | 133 | ||
134 | instance Serialize DHTRequest where | ||
135 | get = return _todo | ||
136 | put _ = return () -- todo | ||
137 | |||
127 | -- | Length | Contents | | 138 | -- | Length | Contents | |
128 | -- |:------------|:------------------------------------| | 139 | -- |:------------|:------------------------------------| |
129 | -- | `1` | `uint8_t` (0x9c) | | 140 | -- | `1` | `uint8_t` (0x9c) | |
@@ -177,6 +188,10 @@ data Cookie = Cookie Nonce24 (Encrypted CookieData) | |||
177 | 188 | ||
178 | instance Sized Cookie where size = ConstSize 112 -- 24 byte nonce + 88 byte cookie data | 189 | instance Sized Cookie where size = ConstSize 112 -- 24 byte nonce + 88 byte cookie data |
179 | 190 | ||
191 | instance Serialize Cookie where | ||
192 | get = return $ Cookie _todo _todo | ||
193 | put _ = return () -- todo | ||
194 | |||
180 | data CookieData = CookieData -- 16 (mac) | 195 | data CookieData = CookieData -- 16 (mac) |
181 | { cookieTime :: Word64 -- 8 | 196 | { cookieTime :: Word64 -- 8 |
182 | , longTermKey :: PublicKey -- 32 | 197 | , longTermKey :: PublicKey -- 32 |
@@ -186,6 +201,10 @@ data CookieData = CookieData -- 16 (mac) | |||
186 | instance Sized CookieRequest where | 201 | instance Sized CookieRequest where |
187 | size = ConstSize 64 -- 32 byte key + 32 byte padding | 202 | size = ConstSize 64 -- 32 byte key + 32 byte padding |
188 | 203 | ||
204 | instance Serialize CookieRequest where | ||
205 | get = CookieRequest <$> return _todo | ||
206 | put (CookieRequest _) = return () -- todo | ||
207 | |||
189 | forwardDHTRequests :: TransportCrypto -> (PublicKey -> IO (Maybe NodeInfo)) -> DHTTransport -> DHTTransport | 208 | forwardDHTRequests :: TransportCrypto -> (PublicKey -> IO (Maybe NodeInfo)) -> DHTTransport -> DHTTransport |
190 | forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' } | 209 | forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' } |
191 | where | 210 | where |
@@ -198,3 +217,46 @@ forwardDHTRequests crypto closeLookup dht = dht { awaitMessage = await' } | |||
198 | await' pass | 217 | await' pass |
199 | m -> pass m | 218 | m -> pass m |
200 | 219 | ||
220 | encrypt :: TransportCrypto -> DHTMessage ((,) Nonce8) -> NodeInfo -> (DHTMessage Encrypted8, NodeInfo) | ||
221 | encrypt crypto msg ni = (transcode (encryptMessage crypto) msg, ni) | ||
222 | |||
223 | encryptMessage :: Serialize a => | ||
224 | TransportCrypto -> Nonce24 -> Either (Nonce8,a) (Assym (Nonce8,a)) -> Encrypted8 a | ||
225 | encryptMessage crypto n (Right assym) = E8 $ ToxCrypto.encrypt secret plain | ||
226 | where | ||
227 | secret = computeSharedSecret (transportSecret crypto) (senderKey assym) n | ||
228 | plain = encodePlain $ swap $ assymData assym | ||
229 | encryptMessage crypto n (Left plain) = _todo | ||
230 | |||
231 | decrypt :: TransportCrypto -> DHTMessage Encrypted8 -> NodeInfo -> Either String (DHTMessage ((,) Nonce8), NodeInfo) | ||
232 | decrypt crypto msg ni = (, ni) <$> (sequenceMessage $ transcode (decryptMessage crypto) msg) | ||
233 | |||
234 | decryptMessage :: Serialize x => | ||
235 | TransportCrypto | ||
236 | -> Nonce24 | ||
237 | -> Either (Encrypted8 x) (Assym (Encrypted8 x)) | ||
238 | -> (Either String ∘ ((,) Nonce8)) x | ||
239 | decryptMessage crypto n (Right assymE) = plain8 $ ToxCrypto.decrypt secret e | ||
240 | where | ||
241 | secret = computeSharedSecret (transportSecret crypto) (senderKey assymE) n | ||
242 | E8 e = assymData assymE | ||
243 | plain8 = Composed . fmap swap . (>>= decodePlain) | ||
244 | decryptMessage crypto n (Left (E8 e)) = _todo | ||
245 | |||
246 | sequenceMessage :: Applicative m => DHTMessage (m ∘ f) -> m (DHTMessage f) | ||
247 | sequenceMessage (DHTPing asym) = fmap DHTPing $ sequenceA $ fmap uncomposed asym | ||
248 | sequenceMessage (DHTPong asym) = fmap DHTPong $ sequenceA $ fmap uncomposed asym | ||
249 | sequenceMessage (DHTGetNodes asym) = fmap DHTGetNodes $ sequenceA $ fmap uncomposed asym | ||
250 | sequenceMessage (DHTSendNodes asym) = fmap DHTSendNodes $ sequenceA $ fmap uncomposed asym | ||
251 | sequenceMessage (DHTCookieRequest asym) = fmap DHTCookieRequest $ sequenceA $ fmap uncomposed asym | ||
252 | sequenceMessage (DHTCookie n dta) = fmap (DHTCookie n) $ uncomposed dta | ||
253 | sequenceMessage (DHTDHTRequest pubkey asym) = fmap (DHTDHTRequest pubkey) $ sequenceA $ fmap uncomposed asym | ||
254 | |||
255 | transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Assym (f a)) -> g a) -> DHTMessage f -> DHTMessage g | ||
256 | transcode f (DHTPing asym) = DHTPing $ asym { assymData = f (assymNonce asym) (Right asym) } | ||
257 | transcode f (DHTPong asym) = DHTPong $ asym { assymData = f (assymNonce asym) (Right asym) } | ||
258 | transcode f (DHTGetNodes asym) = DHTGetNodes $ asym { assymData = f (assymNonce asym) (Right asym) } | ||
259 | transcode f (DHTSendNodes asym) = DHTSendNodes $ asym { assymData = f (assymNonce asym) (Right asym) } | ||
260 | transcode f (DHTCookieRequest asym) = DHTCookieRequest $ asym { assymData = f (assymNonce asym) (Right asym) } | ||
261 | transcode f (DHTCookie n dta) = DHTCookie n $ f n $ Left dta | ||
262 | transcode f (DHTDHTRequest pubkey asym) = DHTDHTRequest pubkey $ asym { assymData = f (assymNonce asym) (Right asym) } | ||