{-# LANGUAGE NamedFieldPuns #-}
module Roster where

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

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

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

newRoster :: IO Roster
newRoster = atomically $ Roster <$> newTVar HashMap.empty

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

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

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

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


updateConcts :: DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey
updateConcts new (Just old) | DHT.dhtpkNonce old < DHT.dhtpkNonce new = Just new
updateConcts new Nothing                                              = Just new
updateConcts _   old                                                  = old


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

updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
    -- TODO
    return ()

dnsPresentation :: Roster -> STM String
dnsPresentation (Roster 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 (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." ]
    ]