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

module Network.Ipfs.Api.Bitswap where

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

import           Network.Ipfs.Api.Internal      (_bitswapLedger,
                                                 _bitswapReprovide,
                                                 _bitswapStat, _bitswapWL)
import           Network.Ipfs.Api.Internal.Call (call)
import           Network.Ipfs.Api.Types         (BitswapLedgerObj,
                                                 BitswapStatObj, BitswapWLObj,
                                                 ReprovideReturnType)
import           Network.Ipfs.Client            (IpfsT)

-- | 'Show some diagnostic information on the bitswap agent.
stat :: MonadIO m => IpfsT m BitswapStatObj
stat :: IpfsT m BitswapStatObj
stat = ClientM BitswapStatObj -> IpfsT m BitswapStatObj
forall (m :: * -> *) a. MonadIO m => ClientM a -> IpfsT m a
call ClientM BitswapStatObj
_bitswapStat

-- | Show blocks currently on the wantlist.
wl :: MonadIO m => IpfsT m BitswapWLObj
wl :: IpfsT m BitswapWLObj
wl = ClientM BitswapWLObj -> IpfsT m BitswapWLObj
forall (m :: * -> *) a. MonadIO m => ClientM a -> IpfsT m a
call ClientM BitswapWLObj
_bitswapWL

-- | Show the current ledger for a peer.
ledger :: MonadIO m => Text -> IpfsT m BitswapLedgerObj
ledger :: Text -> IpfsT m BitswapLedgerObj
ledger = ClientM BitswapLedgerObj -> IpfsT m BitswapLedgerObj
forall (m :: * -> *) a. MonadIO m => ClientM a -> IpfsT m a
call (ClientM BitswapLedgerObj -> IpfsT m BitswapLedgerObj)
-> (Text -> ClientM BitswapLedgerObj)
-> Text
-> IpfsT m BitswapLedgerObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientM BitswapLedgerObj
_bitswapLedger

-- | Trigger reprovider.
reprovide :: MonadIO m => IpfsT m ReprovideReturnType
reprovide :: IpfsT m Text
reprovide = ClientM Text -> IpfsT m Text
forall (m :: * -> *) a. MonadIO m => ClientM a -> IpfsT m a
call ClientM Text
_bitswapReprovide