diff options
-rw-r--r-- | Presence/XMPPServer.hs | 1 | ||||
-rw-r--r-- | ToxToXMPP.hs | 21 | ||||
-rw-r--r-- | examples/dhtd.hs | 15 | ||||
-rwxr-xr-x | 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 | |||
29 | , JabberShow(..) | 29 | , JabberShow(..) |
30 | , Server | 30 | , Server |
31 | , flushPassThrough | 31 | , flushPassThrough |
32 | , greet' | ||
32 | ) where | 33 | ) where |
33 | 34 | ||
34 | import ConnectionKey | 35 | import ConnectionKey |
diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs index e9e975be..eec04846 100644 --- a/ToxToXMPP.hs +++ b/ToxToXMPP.hs | |||
@@ -3,23 +3,19 @@ | |||
3 | module ToxToXMPP where | 3 | module ToxToXMPP where |
4 | 4 | ||
5 | import Data.Conduit as C | 5 | import Data.Conduit as C |
6 | import qualified Data.Conduit.List as CL | ||
6 | import Data.XML.Types as XML | 7 | import Data.XML.Types as XML |
7 | import Network.Tox.Crypto.Transport as Tox | 8 | import Network.Tox.Crypto.Transport as Tox |
9 | import XMPPServer as XMPP | ||
8 | 10 | ||
9 | import Announcer | ||
10 | import ClientState | 11 | import ClientState |
11 | import Connection | ||
12 | import Connection.Tox as Connection | ||
13 | import Control.Concurrent.STM | 12 | import Control.Concurrent.STM |
14 | import Control.Concurrent.STM.TChan | ||
15 | import Control.Monad | 13 | import Control.Monad |
16 | import Crypto.Tox | 14 | import Crypto.Tox |
17 | import Data.Bits | 15 | import Data.Bits |
18 | import Data.Function | 16 | import Data.Function |
19 | import qualified Data.HashMap.Strict as HashMap | ||
20 | import qualified Data.Map as Map | 17 | import qualified Data.Map as Map |
21 | import qualified Data.Set as Set | 18 | import qualified Data.Set as Set |
22 | import qualified Data.Set as Set | ||
23 | import qualified Data.Text as T | 19 | import qualified Data.Text as T |
24 | ;import Data.Text (Text) | 20 | ;import Data.Text (Text) |
25 | import Data.Word | 21 | import Data.Word |
@@ -29,7 +25,6 @@ import Network.Tox.DHT.Transport (FriendRequest (..)) | |||
29 | import Network.Tox.NodeId | 25 | import Network.Tox.NodeId |
30 | import Network.Tox.Onion.Transport (OnionData (..)) | 26 | import Network.Tox.Onion.Transport (OnionData (..)) |
31 | import Presence | 27 | import Presence |
32 | import XMPPServer | ||
33 | #ifdef THREAD_DEBUG | 28 | #ifdef THREAD_DEBUG |
34 | import Control.Concurrent.Lifted.Instrument | 29 | import Control.Concurrent.Lifted.Instrument |
35 | #else | 30 | #else |
@@ -38,13 +33,13 @@ import GHC.Conc (labelThread) | |||
38 | #endif | 33 | #endif |
39 | 34 | ||
40 | xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage | 35 | xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage |
41 | xmppToTox = _todo | 36 | xmppToTox = do |
42 | 37 | awaitForever (\_ -> return ()) | |
43 | toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event | ||
44 | toxToXmpp = _todo | ||
45 | 38 | ||
46 | accountJID :: Account -> Text | 39 | toxToXmpp :: Text -> Conduit Tox.CryptoMessage IO XML.Event |
47 | accountJID acnt = _todo -- Or perhaps this should be passed in from PresenceState | 40 | toxToXmpp toxhost = do |
41 | CL.sourceList $ XMPP.greet' "jabber:server" toxhost | ||
42 | awaitForever (\_ -> return ()) | ||
48 | 43 | ||
49 | key2jid :: Word32 -> PublicKey -> Text | 44 | key2jid :: Word32 -> PublicKey -> Text |
50 | key2jid nospam key = T.pack $ show $ NoSpamId nsp key | 45 | 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 | |||
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. |
1502 | announceToxJabberPeer :: TChan ((ConnectionKey,SockAddr), Tcp.ConnectionEvent XML.Event) | 1500 | announceToxJabberPeer :: 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)) |
1509 | announceToxJabberPeer echan laddr saddr pingflag tsrc tsnk | 1508 | announceToxJabberPeer 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 | |||
1521 | vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString | 1518 | vShowMe :: Tox.ViewSnapshot -> Int -> B.ByteString |
1522 | vShowMe (Tox.ViewSnapshot { vNick, vStatus, vStatusMsg, vTyping }) indent | 1519 | vShowMe (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 |
@@ -4,7 +4,7 @@ rootname=$(cat /etc/debian_chroot 2>/dev/null) | |||
4 | 4 | ||
5 | warn="-freverse-errors -fwarn-unused-imports -Wmissing-signatures -fdefer-typed-holes" | 5 | warn="-freverse-errors -fwarn-unused-imports -Wmissing-signatures -fdefer-typed-holes" |
6 | exts="-XOverloadedStrings -XRecordWildCards" | 6 | exts="-XOverloadedStrings -XRecordWildCards" |
7 | defs="-DXMPP -DBENCODE_AESON -DTHREAD_DEBUG" | 7 | defs="-DBENCODE_AESON -DTHREAD_DEBUG" |
8 | hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass" | 8 | hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass" |
9 | 9 | ||
10 | if [ "$rootname" == "stretch" ] | 10 | if [ "$rootname" == "stretch" ] |