{-# LANGUAGE NamedFieldPuns #-}
module Network.Tox.ContactInfo where

import Control.Concurrent.STM
import Control.Monad
import Crypto.PubKey.Curve25519
import qualified Data.HashMap.Strict as HashMap
         ;import Data.HashMap.Strict (HashMap)
import Data.Maybe
import Network.Tox.DHT.Transport     as DHT
import Network.Tox.NodeId
import Network.Tox.Onion.Transport   as Onion
import System.IO

newtype ContactInfo = ContactInfo { accounts :: TVar (HashMap NodeId Account) }

data Account = Account
    { userSecret :: SecretKey                   -- local secret key
    , contacts :: TVar (HashMap NodeId Contact) -- received contact info
    }

data Contact = Contact
    { contactKeyPacket     :: Maybe (DHT.DHTPublicKey)
    , contactFriendRequest :: Maybe (DHT.FriendRequest)
    }

mergeContact :: Contact -> Maybe Contact -> Maybe Contact
mergeContact (Contact newk newf) (Just (Contact oldk oldf)) =
    Just (Contact mergek mergef)
 where
    mergek = mplus oldk $ do
        n <- newk
        stamp <- fmap DHT.dhtpkNonce oldk `mplus` return minBound
        guard (stamp <= DHT.dhtpkNonce n)
        return n
    mergef = mplus oldf newf
mergeContact new Nothing = Just new

newContactInfo :: IO ContactInfo
newContactInfo = atomically $ ContactInfo <$> newTVar HashMap.empty

newAccount :: SecretKey -> STM Account
newAccount sk = Account sk <$> newTVar HashMap.empty

addContactInfo :: ContactInfo -> SecretKey -> STM ()
addContactInfo (ContactInfo as) sk = do
    a <- newAccount sk
    modifyTVar' as $ HashMap.insert (key2id $ toPublic sk) a

delContactInfo :: ContactInfo -> PublicKey -> STM ()
delContactInfo (ContactInfo as) pk = modifyTVar' as $ HashMap.delete (key2id pk)

updateContactInfo :: ContactInfo -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO ()
updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do
    hPutStrLn stderr "updateContactInfo!!!"
    atomically $ do
        as <- readTVar (accounts roster)
        maybe (return ())
              (updateAccount remoteUserKey omsg)
              $ HashMap.lookup (key2id localUserKey) as


updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact (Just dhtpk) Nothing)
                                               (key2id remoteUserKey)

updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
    modifyTVar' (contacts acc) $ HashMap.alter (mergeContact $ Contact Nothing (Just fr))
                                               (key2id remoteUserKey)

dnsPresentation :: ContactInfo -> STM String
dnsPresentation (ContactInfo accsvar) = do
    accs <- readTVar accsvar
    ms <- forM accs $ \Account { userSecret = sec, contacts = cvar } -> do
        cs <- readTVar cvar
        return $
            "; local key = " ++ show (key2id $ toPublic sec) ++ "\n"
             ++ concatMap dnsPresentation1
                          (mapMaybe (\(nid,m) -> ((,) nid) <$> contactKeyPacket m)
                                    $ HashMap.toList cs)
    return $ concat ms

dnsPresentation1 :: (NodeId,DHTPublicKey) -> String
dnsPresentation1 (nid,dk) = unlines
    [ concat [ show nid, ".tox. IN CNAME ", show (key2id $ dhtpk dk), ".dht." ]
    ]

type LocalKey = NodeId
type RemoteKey = NodeId

friendRequests :: ContactInfo -> STM (HashMap LocalKey [(RemoteKey,DHT.FriendRequest)])
friendRequests (ContactInfo roster) = do
    accs <- readTVar roster
    forM accs $ \Account { userSecret = sec, contacts = cvar } -> do
        cs <- readTVar cvar
        let remotes = mapMaybe (\(nid,m) -> ((,) nid) <$> contactFriendRequest m)
                               $ HashMap.toList cs
        return remotes