{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module Network.DHT.Tox where

import Data.Serialize
import Data.Default
import Text.PrettyPrint.HughesPJClass

import Network.DHT.Types
import Network.DatagramServer.Types
import qualified Network.DatagramServer.Tox as Tox
import Network.KRPC.Method
import Data.Word
import Data.ByteString (ByteString)
import Data.IP
import Data.Bool
import Data.Maybe
import Control.Monad
import System.Random

instance Kademlia Tox.Message where
    data DHTData Tox.Message ip = ToxData
    namePing      _   = Tox.Ping
    nameFindNodes _   = Tox.GetNodes
    initializeDHTData = return ToxData

instance Pretty (NodeId Tox.Message) where
    pPrint (Tox.NodeId nid) = encodeHexDoc nid

instance Serialize (Query Tox.Message (Ping Tox.Message)) where
    get = getToxPing False Network.DHT.Types.Query Tox.QueryNonce
    put (Network.DHT.Types.Query extra Ping) = putToxPing False (Tox.qryNonce extra)
instance Serialize (Response Tox.Message (Ping Tox.Message)) where
    get = getToxPing True Network.DHT.Types.Response Tox.ResponseNonce
    put (Network.DHT.Types.Response extra Ping) = putToxPing True (Tox.rspNonce extra)

instance Serialize (Query Tox.Message (FindNode Tox.Message ip)) where
    get = do
        nid <- get
        n8 <- get
        return $ Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)
    put (Network.DHT.Types.Query (Tox.QueryNonce n8) (FindNode nid)) = do
        put nid
        put n8
instance Serialize (Response Tox.Message (NodeFound Tox.Message IPv4)) where
    get = do
        num <- get :: Get Word8
        when (num > 4) $ fail "Too many nodes in Tox get-nodes reply"
        ns0 <- sequence $ replicate (fromIntegral num) (nodeFormatToNodeInfo <$> get)
        -- TODO: Allow tcp and ipv6. For now filtering to udp ip4...
        let ns = flip mapMaybe ns0 $ \(NodeInfo nid addr u) -> do
                    guard $ not u
                    ip4 <- fromAddr addr
                    return $ NodeInfo nid ip4 ()
        n8 <- get
        return $ Network.DHT.Types.Response (Tox.ResponseNonce n8) $ NodeFound ns
    put (Network.DHT.Types.Response (Tox.ResponseNonce n8) (NodeFound ns)) = do
        put ( fromIntegral (length ns) :: Word8 )
        forM_ ns $ \(NodeInfo nid ip4 ()) -> do
            put Tox.NodeFormat { nodePublicKey = nid
                               , nodeIsTCP     = False
                               , nodeIP        = IPv4 (nodeHost ip4)
                               , nodePort      = nodePort ip4
                               }
        put n8

instance KRPC Tox.Message (Query    Tox.Message (FindNode  Tox.Message IPv4))
                          (Response Tox.Message (NodeFound Tox.Message IPv4)) where
    method = Method Tox.GetNodes
    validateExchange = validateToxExchange
    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
    messageSender q _ = Tox.msgClient q
    messageResponder _ r = Tox.msgClient r

instance KRPC Tox.Message (Query    Tox.Message (Ping Tox.Message))
                          (Response Tox.Message (Ping Tox.Message)) where
    method = Method Tox.Ping
    validateExchange = validateToxExchange
    makeQueryExtra _ _ _ _ = Tox.QueryNonce <$> randomIO
    makeResponseExtra _ _ q _ = return $ Tox.ResponseNonce $ Tox.qryNonce $ queryExtra q
    messageSender q _ = Tox.msgClient q
    messageResponder _ r = Tox.msgClient r

instance DataHandlers ByteString Tox.Message

instance Default Bool where def = False

getToxPing isPong c n = do
    q'r <- get :: Get Word8
    when (bool 0 1 isPong /= q'r) $
        fail "Tox ping/pong parse fail."
    n8 <- get :: Get Tox.Nonce8
    return $ c (n n8) Ping

putToxPing isPong n8 = do
    put (bool 0 1 isPong :: Word8)
    put n8

validateToxExchange q r = qnonce == rnonce
      where
        qnonce = Tox.qryNonce . queryExtra    . Tox.msgPayload $ q
        rnonce = Tox.rspNonce . responseExtra . Tox.msgPayload $ r


nodeFormatToNodeInfo nf = NodeInfo nid addr u
 where
    u    = Tox.nodeIsTCP nf
    addr = NodeAddr (Tox.nodeIP nf) (Tox.nodePort nf)
    nid  = Tox.nodePublicKey nf

-- instance Default Bool where def = False