Feat/govtool saves metadata

govtool/backend/app/Main.hs

@@ -16,6 +16,7 @@ import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.Reader
 
 import           Data.Aeson                             hiding (Error)
+import           Data.Aeson                             (encode)
 import qualified Data.ByteString                        as BS
 import           Data.ByteString.Char8                  (unpack)
 import qualified Data.Cache                             as Cache
@@ -35,7 +36,7 @@ import           Data.Text.Encoding                     (encodeUtf8)
 import qualified Data.Text.IO                           as Text
 import qualified Data.Text.Lazy                         as LazyText
 import qualified Data.Text.Lazy.Encoding                as LazyText
-
+import qualified Data.ByteString.Lazy.Char8             as BS8
 import           Database.PostgreSQL.Simple             (close, connectPostgreSQL, Connection)
 
 import           Network.Wai
@@ -62,8 +63,10 @@ import           VVA.API.Types
 import           VVA.CommandLine
 import           VVA.Config
 import           VVA.Types                              (AppEnv (..),
-                                                         AppError (CriticalError, InternalError, NotFoundError, ValidationError),
+                                                         AppError (..),
                                                          CacheEnv (..))
+import           VVA.Ipfs                              (IpfsError(..))
+
 
 -- Function to create a connection pool with optimized settings
 createOptimizedConnectionPool :: BS.ByteString -> IO (Pool Connection)
@@ -288,10 +291,15 @@ liftServer appEnv =
   where
     handleErrors :: Either AppError a -> Handler a
     handleErrors (Right x) = pure x
-    handleErrors (Left (ValidationError msg)) = throwError $ err400 { errBody = BS.fromStrict $ encodeUtf8 msg }
-    handleErrors (Left (NotFoundError msg)) = throwError $ err404 { errBody = BS.fromStrict $ encodeUtf8 msg }
-    handleErrors (Left (CriticalError msg)) = throwError $ err500 { errBody = BS.fromStrict $ encodeUtf8 msg }
-    handleErrors (Left (InternalError msg)) = throwError $ err500 { errBody = BS.fromStrict $ encodeUtf8 msg }
+    handleErrors (Left appError) = do
+      let status = case appError of
+            ValidationError _ -> err400
+            NotFoundError _   -> err404
+            CriticalError _   -> err500
+            InternalError _   -> err500
+            AppIpfsError (OtherIpfsError _)    -> err400
+            AppIpfsError _    -> err503
+      throwError $ status { errBody = encode appError, errHeaders = [("Content-Type", "application/json")] }
 -- * Swagger
 
 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"

govtool/backend/example-config.json

@@ -6,6 +6,7 @@
       "password" : "postgres",
       "port"     : 5432
     },
+  "pinataapijwt": "",
   "port" : 9999,
   "host" : "localhost",
   "cachedurationseconds": 20,

govtool/backend/src/VVA/API.hs

@@ -1,10 +1,10 @@
-{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE ViewPatterns      #-}
+{-# LANGUAGE DataKinds #-}
 
 module VVA.API where
 
@@ -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)
 
@@ -29,6 +31,7 @@ import           Numeric.Natural          (Natural)
 
 import           Servant.API
 import           Servant.Server
+import           Servant.Exception        (Throws)
 import           System.Random            (randomRIO)
 
 import           Text.Read                (readMaybe)
@@ -45,12 +48,18 @@ import qualified VVA.Proposal             as Proposal
 import qualified VVA.Transaction          as Transaction
 import qualified VVA.Types                as Types
 import           VVA.Types                (App, AppEnv (..),
-                                           AppError (CriticalError, InternalError, ValidationError),
+                                           AppError (CriticalError, InternalError, ValidationError, AppIpfsError),
                                            CacheEnv (..))
 import Data.Time (TimeZone, localTimeToUTC)
+import qualified VVA.Ipfs as Ipfs
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as BSL
+import Servant.Exception (Throws)
 
 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 +98,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 +117,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 $ AppIpfsError err
+    Right ipfsHash -> return $  UploadResponse ipfsHash
+
 mapDRepType :: Types.DRepType -> DRepType
 mapDRepType Types.DRep      = NormalDRep
 mapDRepType Types.SoleVoter = SoleVoter

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

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)

govtool/backend/src/VVA/Ipfs.hs

@@ -0,0 +1,133 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module VVA.Ipfs (ipfsUpload, IpfsError(..)) where
+
+import           Control.Exception              (SomeException, try)
+import           Control.Monad.IO.Class         (liftIO)
+import qualified Data.Aeson                     as A
+import           Data.Aeson                     (FromJSON(parseJSON), withObject, (.:), eitherDecode, ToJSON(..), encode,(.=),object)
+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, Status, status503, status400)
+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
+import           Servant.Server                 (ServerError (errBody))
+import           Servant.Exception              (ToServantErr(..), Exception(..))
+
+
+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"
+
+data IpfsError
+  = PinataConnectionError String
+  | PinataAPIError Status LBS.ByteString
+  | PinataDecodingError String LBS.ByteString
+  | IpfsUnconfiguredError 
+  | OtherIpfsError String
+  deriving (Show, Generic)
+
+instance ToJSON IpfsError where
+  toJSON (PinataConnectionError msg) =
+    object ["errorType" .= A.String "PinataConnectionError", "message" .= msg]
+
+  toJSON (PinataAPIError status body) =
+    object
+      [ "errorType" .= A.String "PinataAPIError"
+      , "message" .= ("Pinata API returned error status : " ++ show status)
+      , "pinataResponse" .= object
+          [ "status" .= show status
+          , "body" .= TL.unpack (TL.decodeUtf8 body)
+          ]
+      ]
+
+  toJSON (PinataDecodingError msg body) =
+    object
+      [ "errorType" .= A.String "PinataDecodingError"
+      , "message" .= msg
+      , "pinataResponse" .= object
+          [ "status" .= ("unknown" :: String)
+          , "body" .= TL.unpack (TL.decodeUtf8 body)
+          ]
+      ]
+
+  toJSON IpfsUnconfiguredError =
+    object ["errorType" .= A.String "IpfsUnconfiguredError", "message" .= ("Backend is not configured for upfs upload" :: String)]
+
+  toJSON (OtherIpfsError msg) =
+    object ["errorType" .= A.String "OtherIpfsError", "message" .= msg]
+
+
+instance Exception IpfsError
+
+
+
+instance ToServantErr IpfsError where
+  status (OtherIpfsError _) = status400
+  status _ = status503
+
+  message (PinataConnectionError msg) = T.pack ("Pinata service connection error: " <> msg)
+  message (PinataAPIError status body) = T.pack ("Pinata API error: " <> show status <> " - " <> LBS8.unpack body)
+  message (PinataDecodingError msg body) = T.pack ("Pinata decoding error: " <> msg <> " - " <> LBS8.unpack body)
+  message IpfsUnconfiguredError = T.pack ("Backend is not configured to support ipfs upload")
+  message (OtherIpfsError msg) = T.pack msg
+
+ipfsUpload :: Maybe Text -> Text -> LBS.ByteString -> IO (Either IpfsError Text)
+ipfsUpload maybeJwt fileName fileContent =
+  case maybeJwt of
+    Nothing -> pure $ Left $ IpfsUnconfiguredError
+    Just "" -> pure $ Left $ IpfsUnconfiguredError 
+    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 $ PinataConnectionError 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
+                liftIO $ putStrLn errMsg
+                pure $ Left $ PinataDecodingError errMsg body
+              Right (res :: PinataSuccessResponse) -> pure $ Right $ cid $ pinataData res
+            else do
+              let errMsg = "Pinata API request failed with status: " <> show status
+              liftIO $ putStrLn errMsg
+              pure $ Left $ PinataAPIError status body