{-# LANGUAGE OverloadedStrings #-}

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

module Network.Ipfs.Api.Config where

import           Control.Monad.IO.Class         (MonadIO)
import           Data.Text                      (Text)
import           Network.HTTP.Client            (responseStatus)
import           Network.HTTP.Types             (Status (..))

import           Network.Ipfs.Api.Internal      (_configGet, _configSet)
import           Network.Ipfs.Api.Internal.Call (call, multipartCall)
import           Network.Ipfs.Api.Types         (ConfigObj)
import           Network.Ipfs.Client            (IpfsT)


-- | Get ipfs config values.
get :: MonadIO m => Text -> IpfsT m ConfigObj
get :: Text -> IpfsT m ConfigObj
get = ClientM ConfigObj -> IpfsT m ConfigObj
forall (m :: * -> *) a. MonadIO m => ClientM a -> IpfsT m a
call (ClientM ConfigObj -> IpfsT m ConfigObj)
-> (Text -> ClientM ConfigObj) -> Text -> IpfsT m ConfigObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientM ConfigObj
_configGet

-- | Set ipfs config values.
set :: MonadIO m => Text -> Maybe Text -> IpfsT m ConfigObj
set :: Text -> Maybe Text -> IpfsT m ConfigObj
set Text
key = ClientM ConfigObj -> IpfsT m ConfigObj
forall (m :: * -> *) a. MonadIO m => ClientM a -> IpfsT m a
call (ClientM ConfigObj -> IpfsT m ConfigObj)
-> (Maybe Text -> ClientM ConfigObj)
-> Maybe Text
-> IpfsT m ConfigObj
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> ClientM ConfigObj
_configSet Text
key

-- | Replace the config with the file at <filePath>.
replace :: MonadIO m => Text -> IpfsT m Bool
replace :: Text -> IpfsT m Bool
replace = (Response ByteString -> Bool)
-> IpfsT m (Response ByteString) -> IpfsT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response ByteString -> Bool
forall body. Response body -> Bool
isSuccess (IpfsT m (Response ByteString) -> IpfsT m Bool)
-> (Text -> IpfsT m (Response ByteString)) -> Text -> IpfsT m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> IpfsT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> IpfsT m (Response ByteString)
multipartCall Text
"config/replace"
  where
    isSuccess :: Response body -> Bool
isSuccess = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200) (Int -> Bool) -> (Response body -> Int) -> Response body -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> Status
forall body. Response body -> Status
responseStatus