summaryrefslogtreecommitdiff
path: root/ToxTransport.hs
blob: 1b2bcbe47bfc07f12da8316edfeeaf91c299a843 (plain)
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
197
198
199
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds,KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
module ToxTransport where

import Network.QueryResponse
import ToxCrypto
import ToxAddress as Tox hiding (ReturnPath)
import ToxPacket

import Control.Concurrent.STM
import qualified Data.ByteString as B
         ;import Data.ByteString (ByteString)
import Data.Word
import Network.Socket
import Data.Serialize as S (decode, Serialize, get, put, Get, Put)
import GHC.TypeLits
import Data.Typeable

newtype SymmetricKey = SymmetricKey ByteString

data TransportCrypto = TransportCrypto
    { transportSecret :: SecretKey
    , transportPublic :: PublicKey
    , transportSymmetric :: STM SymmetricKey
    }

transportDecrypt :: TransportCrypto -> Assym (Encrypted a) -> Either String a
transportDecrypt = _todo

-- layer :: TransportCrypto
          -- -> Transport String SockAddr    ByteString
          -- -> Transport String Tox.Address ByteString
-- layer crypto = layerTransport (toxParse crypto) (toxEncode crypto)

toxEncode :: TransportCrypto -> ByteString -> Tox.Address -> (ByteString, SockAddr)
toxEncode = _todo

-- toxParse :: TransportCrypto -> ByteString -> SockAddr -> Either String (ByteString, Tox.Address)
-- toxParse crypto bs saddr = case B.head bs of _todo

data Message = Todo | DHTReq DHTRequest | AnnounceReq AnnounceRequest

-- awaitMessage :: forall a. (Maybe (Either err (x, addr)) -> IO a) -> IO a

toxTransport :: TransportCrypto -> Transport String SockAddr ByteString -> Transport String Tox.Address Message
toxTransport crypto (Transport await send close) = Transport await' send' close
 where
    await' :: HandleHi a -> IO a
    await' forMe = fix $ await . handleOnion crypto forMe

    send' = _todo

type HandleHi a = Maybe (Either String (Message, Tox.Address)) -> IO a
type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a

--   Byte value   Packet Kind           Return address
--  :----------- :--------------------
--   `0x00`       Ping Request          DHTNode
--   `0x01`       Ping Response         -
--   `0x02`       Nodes Request         DHTNode
--   `0x04`       Nodes Response        -
--   `0x18`       Cookie Request        DHTNode, but without sending pubkey
--   `0x19`       Cookie Response       -
--
--   `0x21`       LAN Discovery         DHTNode (No reply, port 33445, trigger Nodes Request/Response)
--
--   `0x20`       DHT Request           DHTNode/-forward
--
--   `0x1a`       Crypto Handshake      CookieAddress
--
--   `0x1b`       Crypto Data           SessionAddress
--
--   `0x83`       Announce Request      OnionToOwner
--   `0x84`       Announce Response     -
--   `0x85`       Onion Data Request    OnionToOwner
--   `0x86`       Onion Data Response   -
--
--   `0xf0`       Bootstrap Info        SockAddr?
--
--   `0x80`       Onion Request 0       -forward
--   `0x81`       Onion Request 1       -forward
--   `0x82`       Onion Request 2       -forward
--   `0x8c`       Onion Response 3      -return
--   `0x8d`       Onion Response 2      -return
--   `0x8e`       Onion Response 1      -return

handleOnion :: forall a. TransportCrypto -> HandleHi a -> IO a -> HandleLo a
handleOnion crypto forMe forThem (Just (Right (bs,saddr))) = case B.head bs of
    0x20 -> forward forMe bs $ handleDHTRequest crypto saddr forMe forThem
    0x80 -> forward forMe bs $ handleOnionRequest (Proxy :: Proxy 0) crypto saddr forThem
    0x81 -> forward forMe bs $ handleOnionRequest (Proxy :: Proxy 1) crypto saddr forThem
    0x82 -> forward forMe bs $ handleOnionRequest (Proxy :: Proxy 2) crypto saddr forThem
    0x8c -> forward forMe bs $ handleOnionResponse (Proxy :: Proxy 3) crypto saddr forThem
    0x8d -> forward forMe bs $ handleOnionResponse (Proxy :: Proxy 2) crypto saddr forThem
    0x8e -> forward forMe bs $ handleOnionResponse (Proxy :: Proxy 1) crypto saddr forThem
    typ  -> go typ (B.tail bs)
 where
    go :: Word8 -> ByteString -> IO a
    go typ bs = forMe $ Just (parseMessage typ bs)

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

parseMessage :: Word8 -> ByteString -> Either String (Message,Address)
--     Announce :: Aliased Assymetric -> ReturnPath 3 -> Packet --0x83
parseMessage 0x83 bs = _todo -- Announce Request      OnionToOwner
parseMessage _ _ = _todo

handleDHTRequest :: forall a. TransportCrypto -> SockAddr -> HandleHi a -> IO a -> DHTRequestPacket -> IO a
handleDHTRequest crypto saddr forMe forThem (DHTRequestPacket target payload)
    | target == transportPublic crypto = forMe' payload
    | otherwise                        = _todo -- lookup target in close list, forward message
                                         >> forThem
 where
    forMe' :: Assym (Encrypted DHTRequest) -> IO a
    forMe' payload = do
        case (,) <$> transportDecrypt crypto payload <*> eaddr of
            Left e         -> forMe (Just (Left e))
            Right (p,addr) -> forMe (Just (Right (DHTReq p,addr)))

    eaddr :: Either String Tox.Address
    eaddr = fmap DHTNode $ nodeInfo (NodeId $ senderKey payload) saddr

data Attributed a = Attributed
    { author          :: PublicKey
    , attributedNonce :: Nonce24
    , attributed      :: a
    }

--   `0x83`       Announce Request      OnionToOwner
--   `0x85`       Onion Data Request    OnionToOwner
data OPacket -- payload of an onion request


--   `0x84`       Announce Response     -
--   `0x86`       Onion Data Response   -
data RPacket -- payload of an onion response

-- n = 0, 1, 2
data OnionRequest (n :: Nat) = OnionRequest
    { onionNonce    :: Nonce24
    , onionForward  :: Forwarding (3 - n) OPacket
    , 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  :: RPacket
    }

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)

data Forwarding (n :: Nat) msg where
    NotForwarded :: msg -> Forwarding 0 msg
    Forwarding :: Attributed (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 Size a = ConstSize Int
            | VarSize (a -> Int)

data PacketChunk a
    = Plain a
    | Assymetric a
    | Symmetric a
    -}


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