From 7c3169c7c940cae50c56b62afe4dcd0579626c99 Mon Sep 17 00:00:00 2001 From: joe Date: Thu, 31 May 2018 05:20:54 -0400 Subject: Do-nothing tox-to-xmpp conversion conduits. --- Presence/XMPPServer.hs | 1 + ToxToXMPP.hs | 21 ++++++++------------- examples/dhtd.hs | 15 +++++---------- g | 2 +- 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 , JabberShow(..) , Server , flushPassThrough + , greet' ) where import ConnectionKey diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs index e9e975be..eec04846 100644 --- a/ToxToXMPP.hs +++ b/ToxToXMPP.hs @@ -3,23 +3,19 @@ module ToxToXMPP where import Data.Conduit as C +import qualified Data.Conduit.List as CL import Data.XML.Types as XML import Network.Tox.Crypto.Transport as Tox +import XMPPServer as XMPP -import Announcer import ClientState -import Connection -import Connection.Tox as Connection import Control.Concurrent.STM -import Control.Concurrent.STM.TChan import Control.Monad import Crypto.Tox import Data.Bits import Data.Function -import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Data.Set as Set import qualified Data.Text as T ;import Data.Text (Text) import Data.Word @@ -29,7 +25,6 @@ import Network.Tox.DHT.Transport (FriendRequest (..)) import Network.Tox.NodeId import Network.Tox.Onion.Transport (OnionData (..)) import Presence -import XMPPServer #ifdef THREAD_DEBUG import Control.Concurrent.Lifted.Instrument #else @@ -38,13 +33,13 @@ import GHC.Conc (labelThread) #endif xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage -xmppToTox = _todo - -toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event -toxToXmpp = _todo +xmppToTox = do + awaitForever (\_ -> return ()) -accountJID :: Account -> Text -accountJID acnt = _todo -- Or perhaps this should be passed in from PresenceState +toxToXmpp :: Text -> Conduit Tox.CryptoMessage IO XML.Event +toxToXmpp toxhost = do + CL.sourceList $ XMPP.greet' "jabber:server" toxhost + awaitForever (\_ -> return ()) key2jid :: Word32 -> PublicKey -> Text key2jid 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 _ -> return () -- Remove contact. } -#ifdef XMPP - -- | Called upon a new Tox friend-connection session with a remote peer in -- order to set up translating conduits that simulate a remote XMPP server. -announceToxJabberPeer :: TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event) +announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key. + -> TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event) -> SockAddr -- ^ Local bind address for incoming Tox packets. -> SockAddr -- ^ Remote address for this connection. -> STM Bool -> C.Source IO Tox.CryptoMessage -> C.Sink (Flush Tox.CryptoMessage) IO () -> IO (Maybe (Tox.NetCryptoSession -> Tox.NetCryptoSession)) -announceToxJabberPeer echan laddr saddr pingflag tsrc tsnk +announceToxJabberPeer them echan laddr saddr pingflag tsrc tsnk = do atomically $ writeTChan echan ( (PeerKey saddr, laddr ) , Tcp.Connection pingflag xsrc xsnk ) return Nothing where - xsrc = tsrc =$= toxToXmpp + xsrc = tsrc =$= toxToXmpp (T.pack $ show them ++ ".tox") xsnk = flushPassThrough xmppToTox =$= tsnk -#endif - vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString vShowMe (Tox.ViewSnapshot { vNick, vStatus, vStatusMsg, vTyping }) indent = B.unlines @@ -1898,14 +1895,12 @@ main = runResourceT $ liftBaseWith $ \resT -> do let Just pingMachine = Tox.ncPingMachine netcrypto pingflag = readTVar (pingFlag pingMachine) receiveCrypto = atomically $ readTMChan tmchan -#ifdef XMPP onEOF = return () -- TODO: Update toxContactInfo, not connected. xmppSrc = ioToSource receiveCrypto onEOF xmppSink = newXmmpSink netcrypto forM_ msv $ \sv -> do - announceToxJabberPeer (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink + announceToxJabberPeer (Tox.ncTheirPublicKey netcrypto) (xmppEventChannel sv) addrTox (Tox.ncSockAddr netcrypto) pingflag xmppSrc xmppSink -- TODO: Update toxContactInfo, connected. -#endif atomically $ do supply <- readTVar (Tox.listenerIDSupply netCryptoSessionsState) 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) warn="-freverse-errors -fwarn-unused-imports -Wmissing-signatures -fdefer-typed-holes" exts="-XOverloadedStrings -XRecordWildCards" -defs="-DXMPP -DBENCODE_AESON -DTHREAD_DEBUG" +defs="-DBENCODE_AESON -DTHREAD_DEBUG" hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass" if [ "$rootname" == "stretch" ] -- cgit v1.2.3