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

import ConnectionKey
import Connection

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 qualified Data.Set            as Set
         ;import Data.Set            (Set)
import Network.Socket
import Network.Tox.DHT.Transport     as DHT
import Network.Tox.NodeId            (id2key)
import Network.Tox.Onion.Transport   as Onion
import System.IO

newtype ContactInfo = ContactInfo
      -- | Map our toxid public key to an Account record.
    { accounts :: TVar (HashMap NodeId{-my userkey-} Account)
    }

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 }
                  | AddrChange   { contact :: PublicKey, addrChange :: SockAddr }

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 or unknown.
        --  OpenToConnect     : pending friend-request.
        --  TryingToConnect   : roster entry.
    }

nullContact :: Contact
nullContact = Contact
    { contactKeyPacket     = Nothing
    , contactLastSeenAddr  = Nothing
    , contactFriendRequest = Nothing
    , contactPolicy        = Nothing
    }

mergeContact :: Contact -> Maybe Contact -> Maybe Contact
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
    mergek = flip mplus oldk $ do
        n <- newk
        stamp <- fmap DHT.dhtpkNonce oldk `mplus` return minBound
        guard (stamp <= DHT.dhtpkNonce n)
        return n

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
                           <*> newTVar Set.empty
                           <*> newBroadcastTChan

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


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 }

addrUpdate :: SockAddr -> Maybe Contact -> Maybe Contact
addrUpdate addr = mergeContact nullContact { contactLastSeenAddr = Just addr }

updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
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

setContactAddr :: PublicKey -> SockAddr -> Account -> STM ()
setContactAddr remoteUserKey addr acc = do
    modifyTVar' (contacts acc) $ HashMap.alter (addrUpdate addr) (key2id remoteUserKey)
    writeTChan (eventChan acc) $ AddrChange remoteUserKey addr

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

myKeyPairs :: ContactInfo -> STM [(SecretKey,PublicKey)]
myKeyPairs (ContactInfo accounts) = do
    acnts <- readTVar accounts
    forM (HashMap.toList acnts) $ \(nid, Account{userSecret}) -> do
        return (userSecret,id2key nid)