Broadcast eventChan for each configured Tox identity.

4 files changed, 31 insertions, 14 deletions

diff --git a/dht-client.cabal b/dht-client.cabal
index 9a121f23..60a42f00 100644
--- a/dht-client.cabal
+++ b/dht-client.cabal
@@ -143,7 +143,7 @@ library
                     , array
                     , hashable
                     , iproute
-                    , stm
+                    , stm               >= 2.4.0
                     , base16-bytestring
                     , base32-bytestring
                     , base64-bytestring
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 091b1565..47a4cd46 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1230,9 +1230,7 @@ toxman announcer toxbkts tox = ToxManager
             accs <- readTVar accounts
             case HashMap.lookup meid accs of
                 Nothing  -> return () -- Unknown account.
-                Just acc -> modifyTVar' (contacts acc)
-                    $ HashMap.alter (mergeContact nullContact { contactPolicy = Just TryingToConnect })
-                                    themid
+                Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
             -- If unscheduled and unconnected, schedule recurring search for this contact.
         _ -> return () -- Remove contact.
     }
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index 153cd130..880740bf 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -27,15 +27,19 @@ data Account = Account
     { userSecret :: SecretKey                     -- local secret key
     , contacts   :: TVar (HashMap NodeId{-friend's userkey-} Contact) -- received contact info
     , clientRefs :: TVar (Set ConnectionKey) -- reference count so we know when to send offline etc
+    , eventChan  :: TChan ContactEvent
     }
 
+data ContactEvent = OnionRouted  { contact :: PublicKey, onionRouted :: OnionData }
+                  | PolicyChange { contact :: PublicKey, policyChange :: Policy }
+
 data Contact = Contact
     { contactKeyPacket     :: Maybe (DHT.DHTPublicKey)
     , contactLastSeenAddr  :: Maybe SockAddr
     , contactFriendRequest :: Maybe (DHT.FriendRequest)
     , contactPolicy        :: Maybe (Connection.Policy)
         -- Possible semantics
-        --  RefusingToConnect : rejected friend-request or blocked.
+        --  RefusingToConnect : rejected friend-request or blocked or unknown.
         --  OpenToConnect     : pending friend-request.
         --  TryingToConnect   : roster entry.
     }
@@ -43,6 +47,7 @@ data Contact = Contact
 nullContact :: Contact
 nullContact = Contact
     { contactKeyPacket     = Nothing
+    , contactLastSeenAddr  = Nothing
     , contactFriendRequest = Nothing
     , contactPolicy        = Nothing
     }
@@ -69,6 +74,7 @@ newContactInfo = atomically $ ContactInfo <$> newTVar HashMap.empty
 newAccount :: SecretKey -> STM Account
 newAccount sk = Account sk <$> newTVar HashMap.empty
                            <*> newTVar Set.empty
+                           <*> newBroadcastTChan
 
 addContactInfo :: ContactInfo -> SecretKey -> STM ()
 addContactInfo (ContactInfo as) sk = do
@@ -88,16 +94,25 @@ updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,
               $ HashMap.lookup (key2id localUserKey) as
 
 
+onionUpdate :: OnionData -> Maybe Contact -> Maybe Contact
+onionUpdate (Onion.OnionDHTPublicKey dhtpk)
+                = mergeContact nullContact { contactKeyPacket     = Just dhtpk }
+onionUpdate (Onion.OnionFriendRequest fr)
+                = mergeContact nullContact { contactFriendRequest = Just fr    }
+
+policyUpdate :: Policy -> Maybe Contact -> Maybe Contact
+policyUpdate policy = mergeContact nullContact { contactPolicy = Just policy }
+
 updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
-updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
-    modifyTVar' (contacts acc)
-        $ HashMap.alter (mergeContact nullContact { contactKeyPacket = Just dhtpk })
-                        (key2id remoteUserKey)
-
-updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
-    modifyTVar' (contacts acc)
-        $ HashMap.alter (mergeContact nullContact { contactFriendRequest = Just fr })
-                        (key2id remoteUserKey)
+updateAccount remoteUserKey omsg acc = do
+    modifyTVar' (contacts acc) $ HashMap.alter (onionUpdate omsg) (key2id remoteUserKey)
+    writeTChan (eventChan acc) $ OnionRouted remoteUserKey omsg
+
+setContactPolicy :: PublicKey -> Policy -> Account -> STM ()
+setContactPolicy remoteUserKey policy acc = do
+    modifyTVar' (contacts acc) $ HashMap.alter (policyUpdate policy) (key2id remoteUserKey)
+    writeTChan (eventChan acc) $ PolicyChange remoteUserKey policy
+
 
 dnsPresentation :: ContactInfo -> STM String
 dnsPresentation (ContactInfo accsvar) = do
diff --git a/todo.txt b/todo.txt
index 9659e78a..f1f1ca9a 100644
--- a/todo.txt
+++ b/todo.txt
@@ -46,6 +46,10 @@ bt: Limit peers in get_peers response for UDP packet size limiting (around 1k).
 
 bt: Use LMDB backend for peer store (and nodes too?).
 
+maint: Separate types for public keys instead of NodeId/NodeInfo: DHTKey/AliasKey/UserKey
+
+maint: Newtype for internet (ipv4,ipv6) sockaddr.
+
 maint: Rename files.
 
        OnionRouter                  -> Network.Tox.Onion.Routes