module Network.IPFS.Client.DAG.Put.Types (API, Response (..)) where

import           Servant.API
import           Servant.Multipart

import           Network.IPFS.Prelude

import           Network.IPFS.CID.Types
import qualified Network.IPFS.File.Form.Types as File

type API
  =  QueryParam' '[Required, Strict] "pin" Bool
  :> MultipartForm Tmp File.Form
  :> Post '[JSON] Response

newtype Response = Response CID

instance FromJSON Response where
  parseJSON :: Value -> Parser Response
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IPFS.DAG.Response" \Object
obj -> do
    Object
cidField <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Cid"
    CID
cid      <- Object
cidField forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"/"
    return $ CID -> Response
Response CID
cid