Do-nothing tox-to-xmpp conversion conduits.

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" ]