Add Pinata ipfs upload API

mesudip · mesudip · commit ddf233e4aee6 · 2025-07-25T12:32:12.000+05:45
diff --git a/govtool/backend/example-config.json b/govtool/backend/example-config.json
@@ -6,6 +6,7 @@
       "password" : "postgres",
       "port"     : 5432
     },
+  "pinataapijwt": "",
   "port" : 9999,
   "host" : "localhost",
   "cachedurationseconds": 20,
diff --git a/govtool/backend/src/VVA/API.hs b/govtool/backend/src/VVA/API.hs
@@ -13,14 +13,16 @@ import           Control.Exception        (throw, throwIO)
 import           Control.Monad.Except     (runExceptT, throwError)
 import           Control.Monad.Reader
 
-import           Data.Aeson               (Value(..), Array, decode, encode, ToJSON, toJSON)
+import           Data.Aeson               (Value(..), Array, decode, ToJSON, toJSON)
 import           Data.Bool                (Bool)
 import           Data.List                (sortOn, sort)
 import qualified Data.Map                 as Map
 import           Data.Maybe               (Maybe (Nothing), catMaybes, fromMaybe, mapMaybe)
 import           Data.Ord                 (Down (..))
 import           Data.Text                hiding (any, drop, elem, filter, length, map, null, take)
 import qualified Data.Text                as Text
+import qualified Data.Text.Lazy           as TL
+import qualified Data.Text.Lazy.Encoding  as TL
 import qualified Data.Vector as V
 import           Data.Time.LocalTime      (TimeZone, getCurrentTimeZone)
 
@@ -48,9 +50,14 @@ import           VVA.Types                (App, AppEnv (..),
                                            AppError (CriticalError, InternalError, ValidationError),
                                            CacheEnv (..))
 import Data.Time (TimeZone, localTimeToUTC)
+import qualified VVA.Ipfs as Ipfs
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as BSL
 
 type VVAApi =
-         "drep" :> "list"
+         "ipfs"
+                :> "upload"  :> QueryParam "fileName" Text :> ReqBody '[PlainText] Text :> Post '[JSON] UploadResponse
+    :<|> "drep" :> "list"
                 :> QueryParam "search" Text
                 :> QueryParams "status" DRepStatus
                 :> QueryParam "sort" DRepSortMode
@@ -89,7 +96,8 @@ type VVAApi =
     :<|> "account" :> Capture "stakeKey" HexText :> Get '[JSON] GetAccountInfoResponse
 
 server :: App m => ServerT VVAApi m
-server = drepList
+server = upload
+    :<|> drepList
     :<|> getVotingPower
     :<|> getVotes
     :<|> drepInfo
@@ -107,6 +115,19 @@ server = drepList
     :<|> getNetworkTotalStake
     :<|> getAccountInfo
 
+upload :: App m => Maybe Text -> Text -> m UploadResponse
+upload mFileName fileContentText = do
+  AppEnv {vvaConfig} <- ask
+  let fileContent = TL.encodeUtf8 $ TL.fromStrict fileContentText
+      vvaPinataJwt = pinataApiJwt vvaConfig
+      fileName = fromMaybe "data.txt" mFileName -- Default to data.txt if no filename is provided
+  when (BSL.length fileContent > 1024 * 512) $
+    throwError $ ValidationError "The uploaded file is larger than 500Kb"
+  eIpfsHash <- liftIO $ Ipfs.ipfsUpload vvaPinataJwt fileName fileContent
+  case eIpfsHash of
+    Left err  -> throwError $ InternalError $ "IPFS upload failed: " <> pack err
+    Right ipfsHash -> return $ UploadResponse ipfsHash
+
 mapDRepType :: Types.DRepType -> DRepType
 mapDRepType Types.DRep      = NormalDRep
 mapDRepType Types.SoleVoter = SoleVoter
diff --git a/govtool/backend/src/VVA/API/Types.hs b/govtool/backend/src/VVA/API/Types.hs
@@ -1112,6 +1112,14 @@ data GetAccountInfoResponse
       }
   deriving (Generic, Show)
 deriveJSON (jsonOptions "getAccountInfoResponse") ''GetAccountInfoResponse
+
+data UploadResponse
+  = UploadResponse
+      { uploadResponseIpfsCid :: Text
+      }
+  deriving (Generic, Show)
+deriveJSON (jsonOptions "uploadResponse") ''UploadResponse
+
 exampleGetAccountInfoResponse :: Text
 exampleGetAccountInfoResponse =
   "{\"stakeKey\": \"stake1u9\","
@@ -1125,3 +1133,14 @@ instance ToSchema GetAccountInfoResponse where
         & description ?~ "GetAccountInfoResponse"
         & example
           ?~ toJSON exampleGetAccountInfoResponse
+
+exampleUploadResponse :: Text
+exampleUploadResponse =
+  "{\"ipfsHash\": \"QmZKLGf2D3Z3F2J2K5J2L5J2L5J2L5J2L5J2L5J2L5J2L5\"}"
+
+instance ToSchema UploadResponse where
+    declareNamedSchema _ = pure $ NamedSchema (Just "UploadResponse") $ mempty
+        & type_ ?~ OpenApiObject
+        & description ?~ "UploadResponse"
+        & example
+          ?~ toJSON exampleUploadResponse
diff --git a/govtool/backend/src/VVA/Config.hs b/govtool/backend/src/VVA/Config.hs
@@ -32,7 +32,7 @@ import qualified Conferer.Source.Env      as Env
 
 import           Control.Monad.Reader
 
-import           Data.Aeson
+import           Data.Aeson               as Aeson
 import qualified Data.Aeson.Encode.Pretty as AP
 import           Data.ByteString          (ByteString, toStrict)
 import           Data.Has                 (Has, getter)
@@ -58,7 +58,7 @@ data DBConfig
         -- | Port
       , dBConfigPort     :: Int
       }
-  deriving (FromConfig, Generic, Show)
+  deriving (FromConfig, FromJSON, Generic, Show)
 
 instance DefaultConfig DBConfig where
   configDef = DBConfig "localhost" "cexplorer" "postgres" "test" 9903
@@ -79,9 +79,12 @@ data VVAConfigInternal
       , vVAConfigInternalSentrydsn                               :: String
         -- | Sentry environment
       , vVAConfigInternalSentryEnv                               :: String
+        -- | Pinata API JWT
+      , vVAConfigInternalPinataApiJwt                            :: Maybe Text
       }
   deriving (FromConfig, Generic, Show)
 
+
 instance DefaultConfig VVAConfigInternal where
   configDef =
     VVAConfigInternal
@@ -90,7 +93,8 @@ instance DefaultConfig VVAConfigInternal where
         vVAConfigInternalHost = "localhost",
         vVaConfigInternalCacheDurationSeconds = 20,
         vVAConfigInternalSentrydsn = "https://username:password@senty.host/id",
-        vVAConfigInternalSentryEnv = "development"
+        vVAConfigInternalSentryEnv = "development",
+        vVAConfigInternalPinataApiJwt = Nothing
       }
 
 -- | DEX configuration.
@@ -108,6 +112,8 @@ data VVAConfig
       , sentryDSN                               :: String
         -- | Sentry environment
       , sentryEnv                               :: String
+        -- | Pinata API JWT
+      , pinataApiJwt                            :: Maybe Text
       }
   deriving (Generic, Show, ToJSON)
 
@@ -148,7 +154,8 @@ convertConfig VVAConfigInternal {..} =
       serverHost = vVAConfigInternalHost,
       cacheDurationSeconds = vVaConfigInternalCacheDurationSeconds,
       sentryDSN = vVAConfigInternalSentrydsn,
-      sentryEnv = vVAConfigInternalSentryEnv
+      sentryEnv = vVAConfigInternalSentryEnv,
+      pinataApiJwt = vVAConfigInternalPinataApiJwt
     }
 
 -- | Load configuration from a file specified on the command line.  Load from
@@ -163,7 +170,7 @@ loadVVAConfig configFile = do
   where
     buildConfig :: IO Config
     buildConfig =
-      Conferer.mkConfig'
+      mkConfig'
         []
         [ Env.fromConfig "vva",
           JSON.fromFilePath (fromMaybe "example-config.json" configFile)
@@ -185,4 +192,4 @@ getServerPort = asks (serverPort . getter)
 getServerHost ::
   (Has VVAConfig r, MonadReader r m) =>
   m Text
-getServerHost = asks (serverHost . getter)
+getServerHost = asks (serverHost . getter)
diff --git a/govtool/backend/src/VVA/Ipfs.hs b/govtool/backend/src/VVA/Ipfs.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module VVA.Ipfs (ipfsUpload) where
+
+import           Control.Exception              (SomeException, try)
+import           Control.Monad.IO.Class         (liftIO)
+import           Data.Aeson                     (FromJSON(parseJSON), withObject, (.:), eitherDecode)
+import qualified Data.ByteString.Lazy           as LBS
+import           Data.Text                      (Text)
+import qualified Data.Text.Encoding             as TE
+import           GHC.Generics                   (Generic)
+import           Network.HTTP.Client            (newManager, parseRequest, httpLbs, method, requestHeaders, RequestBody(..), Request, responseBody, responseStatus)
+import           Network.HTTP.Client.TLS        (tlsManagerSettings)
+import           Network.HTTP.Client.MultipartFormData (formDataBody, partBS, partFileRequestBody)
+import           Network.HTTP.Types.Status      (statusIsSuccessful)
+import qualified Data.ByteString.Lazy.Char8 as LBS8
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text as T
+
+
+data PinataData = PinataData
+  { cid    :: Text
+  , size     :: Int
+  , created_at   :: Text
+  , isDuplicate :: Maybe Bool
+  } deriving (Show, Generic)
+
+instance FromJSON PinataData
+
+data PinataSuccessResponse = PinataSuccessResponse
+  { pinataData :: PinataData
+  } deriving (Show)
+
+instance FromJSON PinataSuccessResponse where
+  parseJSON = withObject "PinataSuccessResponse" $ \v -> PinataSuccessResponse
+    <$> v .: "data"
+
+ipfsUpload :: Maybe Text -> Text -> LBS.ByteString -> IO (Either String Text)
+ipfsUpload maybeJwt fileName fileContent =
+  case maybeJwt of
+    Nothing -> pure $ Left "Backend is not configured to support ipfs upload"
+    Just "" -> pure $ Left "Backend is not configured to support ipfs upload"
+    Just jwt -> do
+      manager <- newManager tlsManagerSettings
+      initialRequest <- parseRequest "https://uploads.pinata.cloud/v3/files"
+      let req = initialRequest
+            { method = "POST"
+            , requestHeaders = [("Authorization", "Bearer " <> TE.encodeUtf8 jwt)]
+            }
+      result <- try $ flip httpLbs manager =<< formDataBody
+        [ partBS "network" "public"
+        , partFileRequestBody "file" (T.unpack fileName) $ RequestBodyLBS fileContent
+        ]
+        req
+
+      case result of
+        Left (e :: SomeException) -> do
+          let errMsg = show e
+          liftIO $ putStrLn errMsg
+          pure $ Left errMsg
+        Right response -> do
+          let body = responseBody response
+          let status = responseStatus response
+          if statusIsSuccessful status
+            then case eitherDecode body of
+              Left err -> do
+                let errMsg = "Failed to decode Pinata API reponse: " <> err <> "\nResponse body: " <>   LBS8.unpack body
+                liftIO $ putStrLn errMsg
+                pure $ Left errMsg
+              Right (res :: PinataSuccessResponse) -> pure $ Right $ cid $ pinataData res
+            else do
+              let errMsg = "Pinata API request failed with status: " <> show status <> "\nResponse body: " <> LBS8.unpack body
+              liftIO $ putStrLn errMsg
+              pure $ Left errMsg
diff --git a/govtool/backend/stack.yaml b/govtool/backend/stack.yaml
@@ -4,3 +4,4 @@ packages:
 
 extra-deps:
 - raven-haskell-0.1.4.1@sha256:9187272adc064197528645b5ad9b89163b668f386f34016d97fa646d5c790784
+- http-client-multipart-0.3.0.0@sha256:d675f10cba69c98233467dd533ba46e64f34798fc2ea528efe662ad2ea6c89bf,554
diff --git a/govtool/backend/stack.yaml.lock b/govtool/backend/stack.yaml.lock
@@ -1,7 +1,7 @@
 # This file was autogenerated by Stack.
 # You should not edit this file by hand.
 # For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
 
 packages:
 - completed:
@@ -11,6 +11,13 @@ packages:
       size: 632
   original:
     hackage: raven-haskell-0.1.4.1@sha256:9187272adc064197528645b5ad9b89163b668f386f34016d97fa646d5c790784
+- completed:
+    hackage: http-client-multipart-0.3.0.0@sha256:d675f10cba69c98233467dd533ba46e64f34798fc2ea528efe662ad2ea6c89bf,554
+    pantry-tree:
+      sha256: a35e249bf5a162c18e5fa2309c5cfcdaaead1d8fc914be029f3f1239102bd648
+      size: 164
+  original:
+    hackage: http-client-multipart-0.3.0.0@sha256:d675f10cba69c98233467dd533ba46e64f34798fc2ea528efe662ad2ea6c89bf,554
 snapshots:
 - completed:
     sha256: e019cd29e3f7f9dbad500225829a3f7a50f73c674614f2f452e21bb8bf5d99ea
diff --git a/govtool/backend/vva-be.cabal b/govtool/backend/vva-be.cabal
@@ -45,8 +45,8 @@ executable vva-be
     -- other-modules:
 
     -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
-    build-depends:    base >=4.16 && <4.18
+    -- other-extensions9
+    build-depends:    base >=4.16 && <4.19
                     , vva-be
                     , optparse-applicative
                     , text
@@ -80,7 +80,7 @@ executable vva-be
 
 library
   hs-source-dirs: src
-  build-depends: base  >=4.16 && <4.18
+  build-depends: base  >=4.16 && <4.19
                , servant-server
                , conferer
                , mtl
@@ -107,9 +107,11 @@ library
                , swagger2
                , http-client
                , http-client-tls
+               , http-client-multipart
                , vector
                , async
                , random
+               , http-types
 
   exposed-modules: VVA.Config
                  , VVA.CommandLine
@@ -126,4 +128,5 @@ library
                  , VVA.Types
                  , VVA.Network
                  , VVA.Account
+                 , VVA.Ipfs
   ghc-options: -threaded

Original file line number	Diff line number	Diff line change
`@@ -4,3 +4,4 @@ packages:`
`4`	`4`
`5`	`5`	`extra-deps:`
`6`	`6`	`- raven-haskell-0.1.4.1@sha256:9187272adc064197528645b5ad9b89163b668f386f34016d97fa646d5c790784`
	`7`	`+- http-client-multipart-0.3.0.0@sha256:d675f10cba69c98233467dd533ba46e64f34798fc2ea528efe662ad2ea6c89bf,554`