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 :: CID -> m (Either Error CID)
add CID
cid = CID -> m (Either ClientError Response)
forall (m :: * -> *).
MonadRemoteIPFS m =>
CID -> m (Either ClientError Response)
ipfsPin CID
cid m (Either ClientError Response)
-> (Either ClientError Response -> m (Either Error CID))
-> m (Either Error 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
        Utf8Builder -> m ()
forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
<| Utf8Builder
"Pinned CID " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> CID -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Item [CID]
CID
cid'
        Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> Either Error CID -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
<| CID -> Either Error CID
forall a b. b -> Either a b
Right Item [CID]
CID
cid'

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

  Left ClientError
err -> do
    Error
formattedError <- ClientError -> m Error
forall (m :: * -> *). MonadLogger m => ClientError -> m Error
parseClientError ClientError
err
    Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> Either Error CID -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
<| Error -> Either Error CID
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 :: CID -> m (Either Error CID)
rm CID
cid = CID -> Bool -> m (Either ClientError Response)
forall (m :: * -> *).
MonadRemoteIPFS m =>
CID -> Bool -> m (Either ClientError Response)
ipfsUnpin CID
cid Bool
False m (Either ClientError Response)
-> (Either ClientError Response -> m (Either Error CID))
-> m (Either Error CID)
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
        Utf8Builder -> m ()
forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
<| Utf8Builder
"Unpinned CID " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> CID -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Item [CID]
CID
cid'
        Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> Either Error CID -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
<| CID -> Either Error CID
forall a b. b -> Either a b
Right Item [CID]
CID
cid'

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

  Left ClientError
_ -> do
    Utf8Builder -> m ()
forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logDebug (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
<| Utf8Builder
"Cannot unpin CID " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> CID -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display CID
cid Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" because it was not pinned"
    Either Error CID -> m (Either Error CID)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error CID -> m (Either Error CID))
-> Either Error CID -> m (Either Error CID)
forall a b. (a -> b) -> a -> b
<| CID -> Either Error CID
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 :: ClientError -> m Error
parseClientError ClientError
err = do
  Utf8Builder -> m ()
forall msg (m :: * -> *).
(ToLogStr msg, MonadLogger m) =>
msg -> m ()
logError (Utf8Builder -> m ()) -> Utf8Builder -> m ()
forall a b. (a -> b) -> a -> b
<| ClientError -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow ClientError
err
  Error -> m Error
forall (m :: * -> *) a. Monad m => a -> m a
return (Error -> m Error) -> Error -> m Error
forall a b. (a -> b) -> a -> b
<| case ClientError
err of
    FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
response ->
      Response
response
        Response -> (Response -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> Response -> ByteString
forall a. ResponseF a -> a
responseBody
        ByteString -> (ByteString -> Maybe ErrorBody) -> Maybe ErrorBody
forall a b. a -> (a -> b) -> b
|> ByteString -> Maybe ErrorBody
forall a. FromJSON a => ByteString -> Maybe a
decode
        Maybe ErrorBody -> (Maybe ErrorBody -> Error) -> Error
forall a b. a -> (a -> b) -> b
|> \case
          Just IPFS.ErrorBody {String
$sel:message:ErrorBody :: ErrorBody -> String
message :: String
message} ->
            Text -> Error
IPFSDaemonErr (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
<| String -> Text
forall a. Show a => a -> Text
UTF8.textShow String
message

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

    ClientError
unknownClientError ->
      Text -> Error
UnknownAddErr (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
<| ClientError -> Text
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 :: Text -> m Error
parseUnexpectedOutput Text
errStr = do
  let
    baseError :: Error
baseError = Text -> Error
UnexpectedOutput Text
errStr
    err :: Error
err = Text -> Error
UnknownAddErr (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
<| Error -> Text
forall a. Show a => a -> Text
UTF8.textShow Error
baseError

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