netcrypto wip, compiles

3 files changed, 51 insertions, 13 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 5d791a8a..e65110e1 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -108,6 +108,10 @@ import Network.Tox.Transport
 import OnionRouter
 import Network.Tox.ContactInfo
 import Text.XXD
+import qualified Data.HashMap.Strict as HashMap
+import Data.HashMap.Strict (HashMap)
+import qualified Data.Map.Strict as Map
+
 
 newCrypto :: IO TransportCrypto
 newCrypto = do
@@ -245,16 +249,45 @@ data Tox = Tox
     }
 
 -- | initiate a netcrypto session, blocking
-netCrypto :: Tox -> SecretKey -> PublicKey -> IO NetCryptoSession
+netCrypto :: Tox -> SecretKey -> PublicKey{-UserKey -} -> IO [NetCryptoSession]
 netCrypto tox myseckey theirpubkey = do
--- convert public key to NodeInfo check ContactInfo
--- if no session:
--- 1) send dht key, actually maybe send dht-key regardless
--- 2) send handshakes to last seen ip's, if any
---
--- if sessions found, is it using this private key?
--- if not, send handshake, this is separate session
-    error "todo"
+    let mykeyAsId = key2id (toPublic myseckey)
+    mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox)))
+    case mbContactsVar of
+      Nothing -> do
+        hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") accounts lookup failed.")
+        return []
+
+      Just contactsVar -> do
+        let theirkeyAsId = key2id theirpubkey
+        mbContact <- HashMap.lookup theirkeyAsId <$> atomically (readTVar contactsVar)
+        case mbContact of
+         Nothing -> do
+            hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") friend not found (" ++ show theirkeyAsId ++ ").")
+            return []
+         Just contact -> do
+            -- TODO
+            -- convert public key to NodeInfo check ContactInfo
+            --
+            -- > case nodeInfo (key2id theirpubkey) saddr of
+            -- >  Left -> fail...
+            -- >  Right ni ->
+            --
+            sessionsMap <- atomically $ readTVar (netCryptoSessionsByKey (toxCryptoSessions tox) )
+            let sessionUsesIdentity key session = key == ncMyPublicKey session
+            case Map.lookup theirpubkey sessionsMap of
+            -- if sessions found, is it using this private key?
+              Just sessions | matchedSessions <- filter (sessionUsesIdentity (toPublic myseckey)) sessions
+                            , not (null matchedSessions)
+                            -> do
+                hPutStrLn stderr ("netCrypto: Already have a session for " ++ show mykeyAsId ++ "<-->" ++ show theirkeyAsId)
+                return matchedSessions
+            -- if not, send handshake, this is separate session
+              Nothing -> error "netCrypto: todo"
+                -- if no session:
+                -- 1) send dht key, actually maybe send dht-key regardless
+                -- 2) send handshakes to last seen ip's, if any
+                --
 
 getContactInfo :: Tox -> IO DHT.DHTPublicKey
 getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index d03fb249..153cd130 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -16,20 +16,22 @@ import Network.Tox.DHT.Transport     as DHT
 import Network.Tox.NodeId
 import Network.Tox.Onion.Transport   as Onion
 import System.IO
+import Network.Socket
 
 newtype ContactInfo = ContactInfo
       -- | Map our toxid public key to an Account record.
-    { accounts :: TVar (HashMap NodeId Account)
+    { accounts :: TVar (HashMap NodeId{-my userkey-} Account)
     }
 
 data Account = Account
     { userSecret :: SecretKey                     -- local secret key
-    , contacts   :: TVar (HashMap NodeId Contact) -- received contact info
-    , clientRefs :: TVar (Set ConnectionKey)
+    , 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
     }
 
 data Contact = Contact
     { contactKeyPacket     :: Maybe (DHT.DHTPublicKey)
+    , contactLastSeenAddr  :: Maybe SockAddr
     , contactFriendRequest :: Maybe (DHT.FriendRequest)
     , contactPolicy        :: Maybe (Connection.Policy)
         -- Possible semantics
@@ -46,9 +48,10 @@ nullContact = Contact
     }
 
 mergeContact :: Contact -> Maybe Contact -> Maybe Contact
-mergeContact (Contact newk newf newp) (Just (Contact oldk oldf oldp)) =
+mergeContact (Contact newk news newf newp) (Just (Contact oldk olds oldf oldp)) =
     Just $ Contact mergek -- Prefer newer public key packet as long as its stamp
                           -- is later than the stored one.
+                  (mplus news olds) -- Prefer newer last-seen
                   (mplus newf oldf) -- Prefer newer friend request.
                   (mplus newp oldp) -- Prefer newer connection policy.
  where
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index cca8b899..bffb4280 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -85,6 +85,7 @@ type SessionID = Word64
 
 data NetCryptoSession = NCrypto
     { ncState              :: TVar NetCryptoSessionStatus
+    , ncMyPublicKey        :: PublicKey
     , ncSessionId          :: SessionID
     , ncTheirPublicKey     :: PublicKey -- Tox id w/o nospam
     , ncTheirBaseNonce     :: TVar Nonce24 -- base nonce + packet number
@@ -339,6 +340,7 @@ freshCryptoSession  sessions
     pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
     let netCryptoSession0 =
             NCrypto { ncState              = ncState0
+                    , ncMyPublicKey        = toPublic key
                     , ncSessionId          = sessionId
                     , ncTheirPublicKey     = remotePublicKey
                     , ncTheirBaseNonce     = ncTheirBaseNonce0