-- |
-- Module      :  Network.Ipfs.Api.Dht
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unknown
--
-- Api calls with `dht` prefix.
--

module Network.Ipfs.Api.Dht where

import           Control.Monad.IO.Class           (MonadIO)
import           Data.Text                        (Text)

import           Network.Ipfs.Api.Internal.Call   (streamCall)
import           Network.Ipfs.Api.Internal.Stream (_dhtFindPeer, _dhtFindProvs,
                                                   _dhtGet, _dhtProvide,
                                                   _dhtQuery)

-- | Find the multiaddresses associated with the given peerId.
findPeer :: MonadIO m => Text -> m ()
findPeer :: Text -> m ()
findPeer = ClientM (SourceT IO DhtObj) -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
ClientM (SourceT IO a) -> m ()
streamCall (ClientM (SourceT IO DhtObj) -> m ())
-> (Text -> ClientM (SourceT IO DhtObj)) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientM (SourceT IO DhtObj)
_dhtFindPeer

-- | Find peers that can provide a specific value, given a key.
findProvs :: MonadIO m => Text -> m ()
findProvs :: Text -> m ()
findProvs = ClientM (SourceT IO DhtObj) -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
ClientM (SourceT IO a) -> m ()
streamCall (ClientM (SourceT IO DhtObj) -> m ())
-> (Text -> ClientM (SourceT IO DhtObj)) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientM (SourceT IO DhtObj)
_dhtFindProvs

-- | Given a key, query the routing system for its best value.
get :: MonadIO m => Text -> m ()
get :: Text -> m ()
get Text
cid = ClientM (SourceT IO DhtObj) -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
ClientM (SourceT IO a) -> m ()
streamCall (ClientM (SourceT IO DhtObj) -> m ())
-> ClientM (SourceT IO DhtObj) -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> ClientM (SourceT IO DhtObj)
_dhtGet Text
cid

-- | Announce to the network that you are providing given values.
provide :: MonadIO m => Text -> m ()
provide :: Text -> m ()
provide = ClientM (SourceT IO DhtObj) -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
ClientM (SourceT IO a) -> m ()
streamCall (ClientM (SourceT IO DhtObj) -> m ())
-> (Text -> ClientM (SourceT IO DhtObj)) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientM (SourceT IO DhtObj)
_dhtProvide

-- | Find the closest Peer IDs to a given peerID by querying the DHT.
query :: MonadIO m => Text -> m ()
query :: Text -> m ()
query = ClientM (SourceT IO DhtObj) -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
ClientM (SourceT IO a) -> m ()
streamCall (ClientM (SourceT IO DhtObj) -> m ())
-> (Text -> ClientM (SourceT IO DhtObj)) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientM (SourceT IO DhtObj)
_dhtQuery