module Network.IPFS.Pin
  ( add
  , rm
  ) where

import           Network.IPFS.Prelude
import           Network.IPFS.Remote.Class
import qualified Network.IPFS.Internal.UTF8       as UTF8

import qualified Network.IPFS.Client.Pin     as Pin
import           Network.IPFS.Add.Error      as IPFS.Add
import           Network.IPFS.Types          as IPFS
import           Servant.Client

-- | Pin a CID
add :: (MonadRemoteIPFS m, MonadLogger m) => IPFS.CID -> m (Either IPFS.Add.Error CID)
add :: forall (m :: * -> *).
(MonadRemoteIPFS m, MonadLogger m) =>
CID -> m (Either Error CID)
add CID
cid = forall (m :: * -> *).
MonadRemoteIPFS m =>
CID -> m (Either ClientError Response)
ipfsPin CID
cid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right Pin.Response { [CID]
$sel:cids:Response :: Response -> [CID]
cids :: [CID]
cids } ->
    case [CID]
cids of
      [Item [CID]
cid'] -> do
        forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logDebug forall a b. (a -> b) -> a -> b
<| Utf8Builder
"Pinned CID " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Item [CID]
cid'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| forall a b. b -> Either a b
Right Item [CID]
cid'

      [CID]
_ -> do
        Error
formattedErr <- forall (m :: * -> *). MonadLogger m => Text -> m Error
parseUnexpectedOutput forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Text
UTF8.textShow [CID]
cids
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| forall a b. a -> Either a b
Left Error
formattedErr

  Left ClientError
err -> do
    Error
formattedError <- forall (m :: * -> *). MonadLogger m => ClientError -> m Error
parseClientError ClientError
err
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| forall a b. a -> Either a b
Left Error
formattedError

-- | Unpin a CID
rm :: (MonadRemoteIPFS m, MonadLogger m) => IPFS.CID -> m (Either IPFS.Add.Error CID)
rm :: forall (m :: * -> *).
(MonadRemoteIPFS m, MonadLogger m) =>
CID -> m (Either Error CID)
rm CID
cid = forall (m :: * -> *).
MonadRemoteIPFS m =>
CID -> Bool -> m (Either ClientError Response)
ipfsUnpin CID
cid Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right Pin.Response { [CID]
cids :: [CID]
$sel:cids:Response :: Response -> [CID]
cids } ->
    case [CID]
cids of
      [Item [CID]
cid'] -> do
        forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logDebug forall a b. (a -> b) -> a -> b
<| Utf8Builder
"Unpinned CID " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Item [CID]
cid'
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| forall a b. b -> Either a b
Right Item [CID]
cid'

      [CID]
_ -> do
        Error
formattedErr <- forall (m :: * -> *). MonadLogger m => Text -> m Error
parseUnexpectedOutput forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Text
UTF8.textShow [CID]
cids
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| forall a b. a -> Either a b
Left Error
formattedErr

  Left ClientError
_ -> do
    forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logDebug forall a b. (a -> b) -> a -> b
<| Utf8Builder
"Cannot unpin CID " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display CID
cid forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" because it was not pinned"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| forall a b. b -> Either a b
Right CID
cid

-- | Parse and Log the Servant Client Error returned from the IPFS Daemon
parseClientError :: MonadLogger m => ClientError -> m Error
parseClientError :: forall (m :: * -> *). MonadLogger m => ClientError -> m Error
parseClientError ClientError
err = do
  forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logError forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Utf8Builder
displayShow ClientError
err
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
<| case ClientError
err of
    FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
response ->
      Response
response
        forall a b. a -> (a -> b) -> b
|> forall a. ResponseF a -> a
responseBody
        forall a b. a -> (a -> b) -> b
|> forall a. FromJSON a => ByteString -> Maybe a
decode
        forall a b. a -> (a -> b) -> b
|> \case
          Just IPFS.ErrorBody {String
$sel:message:ErrorBody :: ErrorBody -> String
message :: String
message} ->
            Text -> Error
IPFSDaemonErr forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Text
UTF8.textShow String
message

          Maybe ErrorBody
_ ->
            Text -> Error
UnexpectedOutput forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Text
UTF8.textShow ClientError
err

    ClientError
unknownClientError ->
      Text -> Error
UnknownAddErr forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Text
UTF8.textShow ClientError
unknownClientError

-- | Parse and Log unexpected output when attempting to pin
parseUnexpectedOutput :: MonadLogger m => Text -> m IPFS.Add.Error
parseUnexpectedOutput :: forall (m :: * -> *). MonadLogger m => Text -> m Error
parseUnexpectedOutput Text
errStr = do
  let
    baseError :: Error
baseError = Text -> Error
UnexpectedOutput Text
errStr
    err :: Error
err = Text -> Error
UnknownAddErr forall a b. (a -> b) -> a -> b
<| forall a. Show a => a -> Text
UTF8.textShow Error
baseError

  forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logError forall a b. (a -> b) -> a -> b
<| forall a. Display a => a -> Utf8Builder
display Error
baseError
  return Error
err