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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
module OnionTransport
( parseOnionAddr
, encodeOnionAddr
, forwardOnions
, OnionToOwner(..)
, OnionMessage(..)
, DataToRoute(..)
, AnnounceResponse(..)
, AnnounceRequest(..)
, Forwarding(..)
, ReturnPath(..)
, OnionRequest(..)
, OnionResponse(..)
, Addressed(..)
, UDPTransport
) where
import Network.QueryResponse
import ToxCrypto
import DHTTransport (NodeInfo(..),NodeId(..),SendNodes,nodeInfo)
import Control.Arrow
import qualified Data.ByteString as B
;import Data.ByteString (ByteString)
import Data.Serialize as S (Get, Put, Serialize, get, put, runGet)
import Data.Typeable
import Data.Word
import GHC.TypeLits
import Network.Socket
type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
type UDPTransport = Transport String SockAddr ByteString
getOnionAssym :: Get (Assym (Encrypted DataToRoute))
getOnionAssym = _todo
data OnionMessage (f :: * -> *)
= OnionAnnounce (Assym (f (AnnounceRequest,Nonce8)))
| OnionAnnounceResponse Nonce8 Nonce24 (f AnnounceResponse)
| OnionToRoute PublicKey (Assym (f DataToRoute)) -- destination key, aliased Assym
| OnionToRouteResponse (Assym (f DataToRoute))
data OnionToOwner = OnionToOwner NodeInfo (ReturnPath 3)
| OnionToMe SockAddr -- SockAddr is immediate peer in route
onionToOwner assym ret3 saddr = do
ni <- nodeInfo (NodeId $ senderKey assym) saddr
return $ OnionToOwner ni ret3
-- data CookieAddress = WithoutCookie NodeInfo | CookieAddress Cookie SockAddr
onion bs saddr getf = do (f,(assym,ret3)) <- runGet ((,) <$> getf <*> getOnionRequest) bs
oaddr <- onionToOwner assym ret3 saddr
return (f assym, oaddr)
parseOnionAddr :: (ByteString, SockAddr) -> Either (OnionMessage Encrypted,OnionToOwner) (ByteString,SockAddr)
parseOnionAddr (msg,saddr)
| Just (typ,bs) <- B.uncons msg
, let right = Right (msg,saddr)
query = either (const right) Left
response = either (const right) (Left . (, OnionToMe saddr))
= case typ of
0x83 -> query $ onion bs saddr (pure OnionAnnounce) -- Announce Request
0x85 -> query $ onion bs saddr (OnionToRoute <$> getPublicKey) -- Onion Data Request
0x84 -> response $ runGet (OnionAnnounceResponse <$> get <*> get <*> get) bs -- Announce Response
0x86 -> response $ runGet (OnionToRouteResponse <$> getOnionAssym) bs -- Onion Data Response
_ -> right
encodeOnionAddr :: (OnionMessage Encrypted,OnionToOwner) -> (ByteString, SockAddr)
encodeOnionAddr = _todo
forwardOnions :: TransportCrypto -> UDPTransport -> UDPTransport -- HandleHi a -> IO a -> HandleLo a
forwardOnions crypto udp = udp { awaitMessage = await' }
where
-- forMe :: HandleHi
-- forThem :: handleLo
await' :: HandleLo a -> IO a
await' forThem = awaitMessage udp $ \case
m@(Just (Right (bs,saddr))) -> case B.head bs of
0x80 -> forward forThem bs $ handleOnionRequest (Proxy :: Proxy 0) crypto saddr (forThem m)
0x81 -> forward forThem bs $ handleOnionRequest (Proxy :: Proxy 1) crypto saddr (forThem m)
0x82 -> forward forThem bs $ handleOnionRequest (Proxy :: Proxy 2) crypto saddr (forThem m)
0x8c -> forward forThem bs $ handleOnionResponse (Proxy :: Proxy 3) crypto saddr (forThem m)
0x8d -> forward forThem bs $ handleOnionResponse (Proxy :: Proxy 2) crypto saddr (forThem m)
0x8e -> forward forThem bs $ handleOnionResponse (Proxy :: Proxy 1) crypto saddr (forThem m)
_ -> forThem m
m -> forThem m
forward :: forall c b b1.
Serialize b =>
(Maybe (Either String b1) -> c) -> ByteString -> (b -> c) -> c
forward forMe bs f = either (forMe . Just . Left) f $ decode $ B.tail bs
-- n = 0, 1, 2
data OnionRequest (n :: Nat) = OnionRequest
{ onionNonce :: Nonce24
, onionForward :: Forwarding (3 - n) (OnionMessage Encrypted)
, pathFromOwner :: ReturnPath n
}
instance Serialize (OnionRequest n) where { get = _todo; put = _todo }
instance Serialize (OnionResponse n) where { get = _todo; put = _todo }
-- n = 1, 2, 3
-- Attributed (Encrypted (
data OnionResponse (n :: Nat) = OnionResponse
{ pathToOwner :: ReturnPath n
, msgToOwner :: OnionMessage Encrypted
}
data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a }
data ReturnPath (n :: Nat) where
NoReturnPath :: ReturnPath 0
ReturnPath :: Nonce24 -> Encrypted (Addressed (ReturnPath n)) -> ReturnPath (n + 1)
-- instance KnownNat n => Serialize (ReturnPath n) where
-- -- Size: 59 = 1(family) + 16(ip) + 2(port) +16(mac) + 24(nonce)
-- get = ReturnPath <$> getBytes ( 59 * (fromIntegral $ natVal $ Proxy @n) )
-- put (ReturnPath bs) = putByteString bs
data Forwarding (n :: Nat) msg where
NotForwarded :: msg -> Forwarding 0 msg
Forwarding :: Assym (Encrypted (Addressed (Forwarding n msg))) -> Forwarding (n + 1) msg
handleOnionRequest :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionRequest n -> IO a
handleOnionRequest = _todo
handleOnionResponse :: KnownNat n => proxy n -> TransportCrypto -> SockAddr -> IO a -> OnionResponse n -> IO a
handleOnionResponse = _todo
data AnnounceRequest = AnnounceRequest
{ announcePingId :: Nonce32 -- Ping ID
, announceSeeking :: NodeId -- Public key we are searching for
, announceKey :: NodeId -- Public key that we want those sending back data packets to use
}
instance S.Serialize AnnounceRequest where
get = AnnounceRequest <$> S.get <*> S.get <*> S.get
put (AnnounceRequest p s k) = S.put (p,s,k)
getOnionRequest :: Get (Assym (Encrypted msg), ReturnPath 3)
getOnionRequest = _todo
data KeyRecord = NotStored Nonce32
| SendBackKey PublicKey
| Acknowledged Nonce32
getPublicKey :: Get PublicKey
getPublicKey = _todo
putPublicKey :: PublicKey -> Put
putPublicKey = _todo
instance S.Serialize KeyRecord where
get = do
is_stored <- S.get :: S.Get Word8
case is_stored of
1 -> SendBackKey <$> getPublicKey
2 -> Acknowledged <$> S.get
_ -> NotStored <$> S.get
put (NotStored n32) = S.put (0 :: Word8) >> S.put n32
put (SendBackKey key) = S.put (1 :: Word8) >> putPublicKey key
put (Acknowledged n32) = S.put (2 :: Word8) >> S.put n32
data AnnounceResponse = AnnounceResponse
{ is_stored :: KeyRecord
, announceNodes :: SendNodes
}
instance Sized AnnounceResponse where
size = VarSize $ \AnnounceResponse {} -> _todo
instance S.Serialize AnnounceResponse where
get = AnnounceResponse <$> S.get <*> S.get
put (AnnounceResponse st ns) = S.put st >> S.put ns
data DataToRoute = DataToRoute
{ dataFromKey :: PublicKey
, dataToRoute :: Encrypted (Word8,ByteString)
}
|
