blob: 53cb35862a7f1fef5939be8672c34c0e7ab232a8 (
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
|
{-# LANGUAGE NamedFieldPuns #-}
import Control.Concurrent (threadDelay)
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TMChan
import Control.Concurrent.STM.TVar
import Control.Concurrent.Supply
import Control.Monad.STM
import Crypto.Tox
import qualified Data.IntMap.Strict as IntMap
import DebugUtil
import DPut
import Network.QueryResponse
import Network.Socket
import Network.Tox
import Network.Tox.ContactInfo
import qualified Network.Tox.Crypto.Handlers as CH
import Network.Tox.Crypto.Transport
import Network.Tox.DHT.Handlers as DHT
import Network.Tox.DHT.Transport
import Network.Tox.Onion.Transport
makeToxNode :: UDPTransport -> Maybe SecretKey -> IO (Tox extra)
makeToxNode udp sec = do
keysdb <- newKeysDatabase
newToxOverTransport keysdb
(SockAddrInet 0 0)
Nothing
sec
udp
setToxID :: Tox () -> Maybe SecretKey -> IO ()
setToxID tox (Just sec) = atomically $ addContactInfo (toxContactInfo tox) sec ()
sessionChan :: Tox extra -> IO (TChan (TMChan CryptoMessage))
sessionChan Tox{toxCryptoSessions} = do
tchan <- atomically newTChan
atomically $ CH.addNewSessionHook toxCryptoSessions $ \_ nc -> do
atomically $ do
session_chan <- newTMChan
writeTChan tchan session_chan
(n,supply) <- freshId <$> readTVar (CH.listenerIDSupply toxCryptoSessions)
writeTVar (CH.listenerIDSupply toxCryptoSessions) supply
modifyTVar' (CH.ncListeners nc) $ IntMap.insert n (0,session_chan)
return Nothing
return tchan
main :: IO ()
main = do
mapM_ setVerbose [ minBound .. maxBound ]
setQuiet XRoutes
(udpA,udpB) <- testPairTransport
a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
<- makeToxNode udpA $ decodeSecret "YrJQFG7Xppg4WAyhooONNGSCRVQbrRF9L4VoQQsetF"
a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
`setToxID` -- BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI
decodeSecret "UdZUB9Mf1RD3pVGh02OsRJM6YpmGqJiVxYGVIVHkAG"
a_sessions <- sessionChan a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf
let b = read "OM7znaPMYkTbm.9GcZJAdnDATXmZxZ9fnaSTP3qNCZk@2.0.0.0:2"
b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
<- makeToxNode udpB $ decodeSecret "Lm2pnsu1+80I8h9txMoZyGgcNwfaoqBlIfg5TwWUXL"
b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
`setToxID` -- AvETKhO-YqnNRopZrj8K3xUpGtGbX0sLhZZjh2VufJB
decodeSecret "L7WNtNIbm0ajNlPrkWvSRpn0nypTUZxlHBckZPlTje"
b_sessions <- sessionChan b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
(a_quit,_,_) <- forkTox a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf False
(b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False
threadReport False >>= putStrLn
-- Tell /a/ about /b/'s DHT-key.
updateContactInfo (toxContactInfo a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf)
(AnnouncedRendezvous (id2key $ read "AvETKhO-YqnNRopZrj8K3xUpGtGbX0sLhZZjh2VufJB") -- b toxid
(Rendezvous (error "pointless mitm key") b))
$ ( id2key $ read "BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI" -- a toxid
, OnionDHTPublicKey DHTPublicKey
{ dhtpkNonce = 0
, dhtpk = id2key $ nodeId b
, dhtpkNodes = SendNodes []
}
)
DHT.ping (toxDHT a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) b
-- sendMessage (toxHandshakes a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) (nodeAddr b) hs
putStrLn "Type Enter to quit..."
getLine
a_quit
b_quit
threadDelay 500000
threadReport False >>= putStrLn
|
