summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/XMPPServer.hs1
-rw-r--r--ToxToXMPP.hs21
-rw-r--r--examples/dhtd.hs15
-rwxr-xr-xg2
4 files changed, 15 insertions, 24 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 520242cf..774fe886 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -29,6 +29,7 @@ module XMPPServer
29 , JabberShow(..) 29 , JabberShow(..)
30 , Server 30 , Server
31 , flushPassThrough 31 , flushPassThrough
32 , greet'
32 ) where 33 ) where
33 34
34import ConnectionKey 35import ConnectionKey
diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index e9e975be..eec04846 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -3,23 +3,19 @@
3module ToxToXMPP where 3module ToxToXMPP where
4 4
5import Data.Conduit as C 5import Data.Conduit as C
6import qualified Data.Conduit.List as CL
6import Data.XML.Types as XML 7import Data.XML.Types as XML
7import Network.Tox.Crypto.Transport as Tox 8import Network.Tox.Crypto.Transport as Tox
9import XMPPServer as XMPP
8 10
9import Announcer
10import ClientState 11import ClientState
11import Connection
12import Connection.Tox as Connection
13import Control.Concurrent.STM 12import Control.Concurrent.STM
14import Control.Concurrent.STM.TChan
15import Control.Monad 13import Control.Monad
16import Crypto.Tox 14import Crypto.Tox
17import Data.Bits 15import Data.Bits
18import Data.Function 16import Data.Function
19import qualified Data.HashMap.Strict as HashMap
20import qualified Data.Map as Map 17import qualified Data.Map as Map
21import qualified Data.Set as Set 18import qualified Data.Set as Set
22import qualified Data.Set as Set
23import qualified Data.Text as T 19import qualified Data.Text as T
24 ;import Data.Text (Text) 20 ;import Data.Text (Text)
25import Data.Word 21import Data.Word
@@ -29,7 +25,6 @@ import Network.Tox.DHT.Transport (FriendRequest (..))
29import Network.Tox.NodeId 25import Network.Tox.NodeId
30import Network.Tox.Onion.Transport (OnionData (..)) 26import Network.Tox.Onion.Transport (OnionData (..))
31import Presence 27import Presence
32import XMPPServer
33#ifdef THREAD_DEBUG 28#ifdef THREAD_DEBUG
34import Control.Concurrent.Lifted.Instrument 29import Control.Concurrent.Lifted.Instrument
35#else 30#else
@@ -38,13 +33,13 @@ import GHC.Conc (labelThread)
38#endif 33#endif
39 34
40xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage 35xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage
41xmppToTox = _todo 36xmppToTox = do
42 37 awaitForever (\_ -> return ())
43toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event
44toxToXmpp = _todo
45 38
46accountJID :: Account -> Text 39toxToXmpp :: Text -> Conduit Tox.CryptoMessage IO XML.Event
47accountJID acnt = _todo -- Or perhaps this should be passed in from PresenceState 40toxToXmpp toxhost = do
41 CL.sourceList $ XMPP.greet' "jabber:server" toxhost
42 awaitForever (\_ -> return ())
48 43
49key2jid :: Word32 -> PublicKey -> Text 44key2jid :: Word32 -> PublicKey -> Text
50key2jid nospam key = T.pack $ show $ NoSpamId nsp key 45key2jid nospam key = T.pack $ show $ NoSpamId nsp key
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 6a7695d2..553146f7 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1495,29 +1495,26 @@ toxman announcer toxbkts tox presence = ToxManager
1495 _ -> return () -- Remove contact. 1495 _ -> return () -- Remove contact.
1496 } 1496 }
1497 1497
1498#ifdef XMPP
1499
1500-- | Called upon a new Tox friend-connection session with a remote peer in 1498-- | Called upon a new Tox friend-connection session with a remote peer in
1501-- order to set up translating conduits that simulate a remote XMPP server. 1499-- order to set up translating conduits that simulate a remote XMPP server.
1502announceToxJabberPeer :: TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event) 1500announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.
1501 -> TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event)
1503 -> SockAddr -- ^ Local bind address for incoming Tox packets. 1502 -> SockAddr -- ^ Local bind address for incoming Tox packets.
1504 -> SockAddr -- ^ Remote address for this connection. 1503 -> SockAddr -- ^ Remote address for this connection.
1505 -> STM Bool 1504 -> STM Bool
1506 -> C.Source IO Tox.CryptoMessage 1505 -> C.Source IO Tox.CryptoMessage
1507 -> C.Sink (Flush Tox.CryptoMessage) IO () 1506 -> C.Sink (Flush Tox.CryptoMessage) IO ()
1508 -> IO (Maybe (Tox.NetCryptoSession -> Tox.NetCryptoSession)) 1507 -> IO (Maybe (Tox.NetCryptoSession -> Tox.NetCryptoSession))
1509announceToxJabberPeer echan laddr saddr pingflag tsrc tsnk 1508announceToxJabberPeer them echan laddr saddr pingflag tsrc tsnk
1510 = do 1509 = do
1511 atomically $ writeTChan echan 1510 atomically $ writeTChan echan
1512 ( (PeerKey saddr, laddr ) 1511 ( (PeerKey saddr, laddr )
1513 , Tcp.Connection pingflag xsrc xsnk ) 1512 , Tcp.Connection pingflag xsrc xsnk )
1514 return Nothing 1513 return Nothing
1515 where 1514 where
1516 xsrc = tsrc =$= toxToXmpp 1515 xsrc = tsrc =$= toxToXmpp (T.pack $ show them ++ ".tox")
1517 xsnk = flushPassThrough xmppToTox =$= tsnk 1516 xsnk = flushPassThrough xmppToTox =$= tsnk
1518 1517
1519#endif
1520
1521vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString 1518vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString
1522vShowMe (Tox.ViewSnapshot { vNick, vStatus, vStatusMsg, vTyping }) indent 1519vShowMe (Tox.ViewSnapshot { vNick, vStatus, vStatusMsg, vTyping }) indent
1523 = B.unlines 1520 = B.unlines
@@ -1898,14 +1895,12 @@ main = runResourceT $ liftBaseWith $ \resT -> do
1898 let Just pingMachine = Tox.ncPingMachine netcrypto 1895 let Just pingMachine = Tox.ncPingMachine netcrypto
1899 pingflag = readTVar (pingFlag pingMachine) 1896 pingflag = readTVar (pingFlag pingMachine)
1900 receiveCrypto = atomically $ readTMChan tmchan 1897 receiveCrypto = atomically $ readTMChan tmchan
1901#ifdef XMPP
1902 onEOF = return () -- TODO: Update toxContactInfo, not connected. 1898 onEOF = return () -- TODO: Update toxContactInfo, not connected.
1903 xmppSrc = ioToSource receiveCrypto onEOF 1899 xmppSrc = ioToSource receiveCrypto onEOF
1904 xmppSink = newXmmpSink netcrypto 1900 xmppSink = newXmmpSink netcrypto
1905 forM_ msv $ \sv -> do 1901 forM_ msv $ \sv -> do
1906 announceToxJabberPeer (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink 1902 announceToxJabberPeer (Tox.ncTheirPublicKey netcrypto) (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink
1907 -- TODO: Update toxContactInfo, connected. 1903 -- TODO: Update toxContactInfo, connected.
1908#endif
1909 atomically $ do 1904 atomically $ do
1910 supply <- readTVar (Tox.listenerIDSupply netCryptoSessionsState) 1905 supply <- readTVar (Tox.listenerIDSupply netCryptoSessionsState)
1911 let (listenerId,supply') = freshId supply 1906 let (listenerId,supply') = freshId supply
diff --git a/g b/g
index 3b5778fb..629785c0 100755
--- a/g
+++ b/g
@@ -4,7 +4,7 @@ rootname=$(cat /etc/debian_chroot 2>/dev/null)
4 4
5warn="-freverse-errors -fwarn-unused-imports -Wmissing-signatures -fdefer-typed-holes" 5warn="-freverse-errors -fwarn-unused-imports -Wmissing-signatures -fdefer-typed-holes"
6exts="-XOverloadedStrings -XRecordWildCards" 6exts="-XOverloadedStrings -XRecordWildCards"
7defs="-DXMPP -DBENCODE_AESON -DTHREAD_DEBUG" 7defs="-DBENCODE_AESON -DTHREAD_DEBUG"
8hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass" 8hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass"
9 9
10if [ "$rootname" == "stretch" ] 10if [ "$rootname" == "stretch" ]