module Network.IPFS.Client.Pin
  ( API
  , AddAPI
  , RemoveAPI
  , Response (..)
  ) where

import qualified RIO.Text                  as Text

import           Servant.API

import           Network.IPFS.Prelude

import           Network.IPFS.CID.Types
import qualified Network.IPFS.Client.Param as Param

type API = AddAPI :<|> RemoveAPI

type AddAPI
  = "add"
    :> Param.CID'
    :> Post '[JSON] Response

-- IPFS v0.5 disallows GET requests
-- https://docs.ipfs.io/recent-releases/go-ipfs-0-5/#breaking-changes-upgrade-notes
type RemoveAPI
  = "rm"
    :> Param.CID'
    :> Param.IsRecursive
    :> Post '[JSON] Response

newtype Response = Response { Response -> [CID]
cids :: [CID] }
  deriving (Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

instance Display Response where
  textDisplay :: Response -> Text
textDisplay Response {[CID]
cids :: [CID]
$sel:cids:Response :: Response -> [CID]
cids} = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
    where
      inner :: Text
inner = Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (CID -> Text) -> [CID] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CID -> Text
forall a. Display a => a -> Text
textDisplay [CID]
cids

instance FromJSON Response where
  parseJSON :: Value -> Parser Response
parseJSON = String -> (Object -> Parser Response) -> Value -> Parser Response
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Pin Response" \Object
obj ->
    [CID] -> Response
Response ([CID] -> Response) -> Parser [CID] -> Parser Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser [CID]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Pins"