{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Tox.DHT.Node where

import           Control.Monad.State         (gets)
import           Data.Binary                 (Binary)
import qualified Data.ByteString             as BS
import           Data.Foldable               (forM_)
import           Tox.DHT.DhtPacket           as DhtPacket
import           Tox.DHT.DhtRequestPacket    (DhtRequestPacket)
import           Tox.DHT.DhtState            as DhtState
import           Tox.DHT.Operation           (DhtNodeMonad, bootstrapNode,
                                              doDHT, handleDhtRequestPacket,
                                              handleNodesRequest,
                                              handleNodesResponse,
                                              handlePingRequest,
                                              handlePingResponse)
import qualified Tox.Network.Core.Encoding   as Encoding
import           Tox.Network.Core.NodeInfo   (NodeInfo (..))
import           Tox.Network.Core.Packet     (Packet (..))
import           Tox.Network.Core.PacketKind as PacketKind

-- | A unified packet handler for DHT protocol packets.
-- Decrypts the DHT envelope and dispatches to the appropriate handler.
handleIncomingPacket :: forall m. DhtNodeMonad m => NodeInfo -> Packet BS.ByteString -> m ()
handleIncomingPacket :: NodeInfo -> Packet ByteString -> m ()
handleIncomingPacket NodeInfo
from (Packet PacketKind
kind ByteString
payload) = do
    KeyPair
kp <- (DhtState -> KeyPair) -> m KeyPair
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DhtState -> KeyPair
DhtState.dhtKeyPair
    let decodeDht :: forall a. Binary a => (NodeInfo -> a -> m ()) -> m ()
        decodeDht :: (NodeInfo -> a -> m ()) -> m ()
decodeDht NodeInfo -> a -> m ()
handler = case ByteString -> Maybe DhtPacket
forall (m :: * -> *) a.
(MonadFail m, Binary a) =>
ByteString -> m a
Encoding.decode ByteString
payload of
            Maybe DhtPacket
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just DhtPacket
dhtPacket -> do
                Maybe a
mDecoded <- KeyPair -> DhtPacket -> m (Maybe a)
forall payload (m :: * -> *).
(Binary payload, Keyed m) =>
KeyPair -> DhtPacket -> m (Maybe payload)
DhtPacket.decodeKeyed KeyPair
kp DhtPacket
dhtPacket
                Maybe a -> (a -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
mDecoded (NodeInfo -> a -> m ()
handler NodeInfo
from)
    case PacketKind
kind of
        PacketKind
PacketKind.PingRequest   -> (NodeInfo -> RpcPacket PingPacket -> m ()) -> m ()
forall a. Binary a => (NodeInfo -> a -> m ()) -> m ()
decodeDht NodeInfo -> RpcPacket PingPacket -> m ()
forall (m :: * -> *).
DhtNodeMonad m =>
NodeInfo -> RpcPacket PingPacket -> m ()
handlePingRequest
        PacketKind
PacketKind.PingResponse  -> (NodeInfo -> RpcPacket PingPacket -> m ()) -> m ()
forall a. Binary a => (NodeInfo -> a -> m ()) -> m ()
decodeDht NodeInfo -> RpcPacket PingPacket -> m ()
forall (m :: * -> *).
DhtNodeMonad m =>
NodeInfo -> RpcPacket PingPacket -> m ()
handlePingResponse
        PacketKind
PacketKind.NodesRequest  -> (NodeInfo -> RpcPacket NodesRequest -> m ()) -> m ()
forall a. Binary a => (NodeInfo -> a -> m ()) -> m ()
decodeDht NodeInfo -> RpcPacket NodesRequest -> m ()
forall (m :: * -> *).
DhtNodeMonad m =>
NodeInfo -> RpcPacket NodesRequest -> m ()
handleNodesRequest
        PacketKind
PacketKind.NodesResponse -> (NodeInfo -> RpcPacket NodesResponse -> m ()) -> m ()
forall a. Binary a => (NodeInfo -> a -> m ()) -> m ()
decodeDht NodeInfo -> RpcPacket NodesResponse -> m ()
forall (m :: * -> *).
DhtNodeMonad m =>
NodeInfo -> RpcPacket NodesResponse -> m ()
handleNodesResponse
        PacketKind
PacketKind.Crypto        -> case ByteString -> Maybe DhtRequestPacket
forall (m :: * -> *) a.
(MonadFail m, Binary a) =>
ByteString -> m a
Encoding.decode ByteString
payload of
            Maybe DhtRequestPacket
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just (DhtRequestPacket
dhtReq :: DhtRequestPacket) -> NodeInfo -> DhtRequestPacket -> m ()
forall (m :: * -> *).
DhtNodeMonad m =>
NodeInfo -> DhtRequestPacket -> m ()
handleDhtRequestPacket NodeInfo
from DhtRequestPacket
dhtReq
        PacketKind
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Periodic maintenance for the DHT node.
handleMaintenance :: DhtNodeMonad m => m ()
handleMaintenance :: m ()
handleMaintenance = m ()
forall (m :: * -> *). DhtNodeMonad m => m ()
doDHT

-- | Bootstrap from a known node.
handleBootstrap :: DhtNodeMonad m => NodeInfo -> m ()
handleBootstrap :: NodeInfo -> m ()
handleBootstrap = NodeInfo -> m ()
forall (m :: * -> *). DhtNodeMonad m => NodeInfo -> m ()
bootstrapNode