1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
module Network.Tox.Onion.Transport
( parseOnionAddr
, encodeOnionAddr
, parseDataToRoute
, encodeDataToRoute
, forwardOnions
, AliasSelector(..)
, OnionDestination(..)
, OnionMessage(..)
, Rendezvous(..)
, DataToRoute(..)
, OnionData(..)
, AnnouncedRendezvous(..)
, AnnounceResponse(..)
, AnnounceRequest(..)
, Forwarding(..)
, ReturnPath(..)
, OnionRequest(..)
, OnionResponse(..)
, Addressed(..)
, UDPTransport
, KeyRecord(..)
, encrypt
, decrypt
, peelSymmetric
, OnionRoute(..)
, dummyRoute
, N0
, N1
, N2
, N3
, onionKey
, onionAliasSelector
, selectAlias
, RouteId(..)
, routeId
, putRequest
, wrapForRoute
, wrapSymmetric
, wrapOnion
, wrapOnionPure
, unwrapAnnounceResponse
, wrapIndirectHops
) where
import qualified Data.ByteString as B
;import Data.ByteString (ByteString)
import Data.Maybe
import Data.Serialize
import Network.Socket
import Crypto.Tox hiding (encrypt,decrypt)
import Network.Tox.TCP.NodeId (udpNodeInfo)
import qualified Data.Tox.Relay as TCP
import Data.Tox.Onion
import Network.Address (nullAddress4)
import Network.Tox.DHT.Transport (SendNodes(..))
import Network.Tox.NodeId
import Network.QueryResponse
encodeOnionAddr :: TransportCrypto
-> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
-> (OnionMessage Encrypted,OnionDestination RouteId)
-> IO (Maybe (ByteString, SockAddr))
encodeOnionAddr crypto _ (msg,OnionToOwner ni p) =
return $ Just ( runPut $ putResponse (OnionResponse p msg)
, nodeAddr ni )
encodeOnionAddr crypto getRoute (msg,OnionDestination x ni Nothing) = do
encodeOnionAddr crypto getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
let go route = do
req <- wrapForRoute crypto msg ni route
return ( runPut $ putRequest req , nodeAddr $ routeNodeA route)
m <- {-# SCC "encodeOnionAddr.getRoute" #-} getRoute ni rid
x <- {-# SCC "encodeOnionAddr.wrapForRoute" #-} mapM go m
return x
wrapForRoute :: TransportCrypto
-> OnionMessage Encrypted
-> NodeInfo
-> OnionRoute
-> IO (OnionRequest N0)
wrapForRoute crypto msg ni r =
wrapIndirectHops crypto msg ni r $ \nonce saddr msg' -> do
fwd <- wrapOnion crypto (routeAliasA r)
nonce
(id2key . nodeId $ routeNodeA r)
saddr
msg'
return $ OnionRequest { onionNonce = nonce
, onionForward = fwd
, pathFromOwner = NoReturnPath
}
wrapIndirectHops :: TransportCrypto
-> OnionMessage Encrypted
-> NodeInfo
-> OnionRoute
-> (Nonce24 -> SockAddr -> Forwarding N2 (OnionMessage Encrypted) -> IO a)
-> IO a
wrapIndirectHops crypto msg ni r fin = do
let nonce = msgNonce msg
fwd <- wrapOnion crypto (routeAliasB r)
nonce
(id2key . nodeId $ routeNodeB r)
(nodeAddr $ routeNodeC r)
=<< wrapOnion crypto (routeAliasC r)
nonce
(id2key . nodeId $ routeNodeC r)
(nodeAddr ni)
(NotForwarded msg)
fin nonce (nodeAddr $ routeNodeB r) fwd
unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns0)) | let ns = map udpNodeInfo ns0
= case is_stored of
NotStored n32 -> ( ns , [] , Just n32)
SendBackKey k -> ( ns , [Rendezvous k ni] , Nothing )
Acknowledged n32 -> ( ns , maybeToList $ fmap (\k -> Rendezvous (id2key k) ni) alias , Just n32)
|
