-- | High-level DHT API for content publishing and retrieval.
--
-- Provides the user-facing operations that libp2p applications use:
-- 'provide', 'putValue', and 'findProviders'. These compose the lower-level
-- iterative lookups ('iterativeFindNode', 'iterativeGetProviders') with
-- direct RPC sending to the closest peers found.
module LibP2P.DHT.API
  ( -- * Content provider operations
    provide
  , putValue
  , findProviders
  ) where

import Control.Concurrent.Async (mapConcurrently)
import Control.Exception (SomeException, catch)
import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.Time (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import qualified Data.Text as T
import LibP2P.Crypto.PeerId (PeerId (..), peerIdBytes)
import LibP2P.DHT
  ( DHTNode (..)
  , ProviderEntry (..)
  , Validator (..)
  , addProvider
  , storeRecord
  )
import LibP2P.DHT.Lookup (iterativeFindNode, iterativeGetProviders)
import LibP2P.DHT.Message
import LibP2P.DHT.Types (BucketEntry (..), ConnectionType (..), entryPeerId, kValue)
import LibP2P.Multiaddr (Multiaddr, toBytes)

-- | Announce that the local node provides a given content key.
--
-- Performs an iterative FIND_NODE lookup for the content key, then sends
-- ADD_PROVIDER messages to the k closest peers found. The local peer's
-- listen addresses are included so remote peers can dial back.
provide :: DHTNode -> [Multiaddr] -> ByteString -> IO ()
provide :: DHTNode -> [Multiaddr] -> ByteString -> IO ()
provide DHTNode
node [Multiaddr]
addrs ByteString
key = do
  -- Find the k closest peers to this content key via iterative lookup
  closest <- DHTNode -> PeerId -> IO [BucketEntry]
iterativeFindNode DHTNode
node (ByteString -> PeerId
PeerId ByteString
key)

  -- Send ADD_PROVIDER to each of the k closest
  let providerPeer = ByteString -> [ByteString] -> ConnectionType -> DHTPeer
DHTPeer (PeerId -> ByteString
peerIdBytes (DHTNode -> PeerId
dhtLocalPeerId DHTNode
node))
                             ((Multiaddr -> ByteString) -> [Multiaddr] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Multiaddr -> ByteString
toBytes [Multiaddr]
addrs)
                             ConnectionType
Connected
      providerMsg = DHTMessage
emptyDHTMessage
        { msgType = AddProvider
        , msgKey  = key
        , msgProviderPeers = [providerPeer]
        }

  void $ mapConcurrently (\BucketEntry
entry ->
    (DHTNode -> PeerId -> DHTMessage -> IO (Either [Char] DHTMessage)
dhtSendRequest DHTNode
node) (BucketEntry -> PeerId
entryPeerId BucketEntry
entry) DHTMessage
providerMsg
      IO (Either [Char] DHTMessage)
-> (SomeException -> IO (Either [Char] DHTMessage))
-> IO (Either [Char] DHTMessage)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
_ :: SomeException) -> Either [Char] DHTMessage -> IO (Either [Char] DHTMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] DHTMessage
forall a b. a -> Either a b
Left [Char]
"send failed"))
    ) (take kValue closest)

  -- Also store locally
  now <- getCurrentTime
  addProvider node key
    ProviderEntry
      { peProvider  = dhtLocalPeerId node
      , peAddrs     = addrs
      , peTimestamp = now
      }

-- | Store a value in the DHT under the given key.
--
-- Performs an iterative FIND_NODE lookup for the key, then sends
-- PUT_VALUE messages to the k closest peers. Also stores the value
-- locally. The value is validated using the node's configured validator;
-- if validation fails, the function returns 'Left' with an error message.
putValue :: DHTNode -> Validator -> ByteString -> ByteString -> IO (Either String ())
putValue :: DHTNode
-> Validator -> ByteString -> ByteString -> IO (Either [Char] ())
putValue DHTNode
node Validator
validator ByteString
key ByteString
value = do
  -- Validate first
  case Validator -> ByteString -> ByteString -> Either [Char] ()
valValidate Validator
validator ByteString
key ByteString
value of
    Left [Char]
err -> Either [Char] () -> IO (Either [Char] ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char]
"value validation failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err)
    Right () -> do
      -- Find the k closest peers
      closest <- DHTNode -> PeerId -> IO [BucketEntry]
iterativeFindNode DHTNode
node (ByteString -> PeerId
PeerId ByteString
key)

      -- Create the record and send PUT_VALUE
      now <- getCurrentTime
      let record = ByteString -> ByteString -> Text -> DHTRecord
DHTRecord ByteString
key ByteString
value ([Char] -> Text
T.pack (UTCTime -> [Char]
forall t. ISO8601 t => t -> [Char]
iso8601Show UTCTime
now))
          putMsg = DHTMessage
emptyDHTMessage
            { msgType = PutValue
            , msgKey  = key
            , msgRecord = Just record
            }

      void $ mapConcurrently (\BucketEntry
entry ->
        (DHTNode -> PeerId -> DHTMessage -> IO (Either [Char] DHTMessage)
dhtSendRequest DHTNode
node) (BucketEntry -> PeerId
entryPeerId BucketEntry
entry) DHTMessage
putMsg
          IO (Either [Char] DHTMessage)
-> (SomeException -> IO (Either [Char] DHTMessage))
-> IO (Either [Char] DHTMessage)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
_ :: SomeException) -> Either [Char] DHTMessage -> IO (Either [Char] DHTMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] DHTMessage
forall a b. a -> Either a b
Left [Char]
"send failed"))
        ) (take kValue closest)

      -- Also store locally
      storeRecord node record
      pure (Right ())

-- | Find providers for a content key.
--
-- Convenience wrapper around 'iterativeGetProviders'.
findProviders :: DHTNode -> ByteString -> IO [ProviderEntry]
findProviders :: DHTNode -> ByteString -> IO [ProviderEntry]
findProviders DHTNode
node ByteString
key = DHTNode -> ByteString -> IO [ProviderEntry]
iterativeGetProviders DHTNode
node ByteString
key