Add a warning and populate the json field of Vote metadata

Author: kderme

cardano-db-sync/src/Cardano/DbSync/OffChain.hs

@@ -78,21 +78,22 @@ loadOffChainVoteWorkQueue trce workQueue =
       }
 
 loadOffChainWorkQueue ::
+  forall a m.
   (MonadBaseControl IO m, MonadIO m) =>
   Trace IO Text ->
   LoadOffChainWorkQueue a m ->
   ReaderT SqlBackend m ()
 loadOffChainWorkQueue _trce offChainWorkQueue = do
   whenM (liftIO $ atomically (isEmptyTBQueue (lQueue offChainWorkQueue))) $ do
     now <- liftIO Time.getPOSIXTime
-    runnableOffChainData <- filter (isRunnable now offChainWorkQueue) <$> lGetData offChainWorkQueue now 100
-    liftIO $ mapM_ (queueInsert offChainWorkQueue) runnableOffChainData
+    runnableOffChainData <- filter (isRunnable now) <$> lGetData offChainWorkQueue now 100
+    liftIO $ mapM_ queueInsert runnableOffChainData
   where
-    isRunnable :: POSIXTime -> LoadOffChainWorkQueue a m -> a -> Bool
-    isRunnable now oCWorkQueue locWq = retryRetryTime (lRetryTime oCWorkQueue locWq) <= now
+    isRunnable :: POSIXTime -> a -> Bool
+    isRunnable now locWq = retryRetryTime (lRetryTime offChainWorkQueue locWq) <= now
 
-    queueInsert :: LoadOffChainWorkQueue a m -> a -> IO ()
-    queueInsert oCWorkQueue locWq = atomically $ writeTBQueue (lQueue oCWorkQueue) locWq
+    queueInsert :: a -> IO ()
+    queueInsert locWq = atomically $ writeTBQueue (lQueue offChainWorkQueue) locWq
 
 ---------------------------------------------------------------------------------------------------------------------------------
 -- Insert OffChain
@@ -266,6 +267,7 @@ fetchOffChainVoteData _tracer manager time oVoteWorkQ =
               , DB.offChainVoteDataHash = sovaHash sVoteData
               , DB.offChainVoteDataJson = sovaJson sVoteData
               , DB.offChainVoteDataVotingAnchorId = oVoteWqReferenceId oVoteWorkQ
+              , DB.offChainVoteDataWarning = sovaWarning sVoteData
               }
         Left err ->
           OffChainVoteResultError $

cardano-db-sync/src/Cardano/DbSync/OffChain/Http.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.DbSync.OffChain.Http (
   httpGetOffChainPoolData,
@@ -26,7 +27,6 @@ import Cardano.DbSync.Types (
  )
 import Cardano.DbSync.Util (renderByteArray)
 import Cardano.Prelude hiding (show)
-import Control.Monad.Extra (whenJust)
 import Control.Monad.Trans.Except.Extra (handleExceptT, hoistEither, left)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Char8 as BS
@@ -100,8 +100,11 @@ httpGetOffChain manager request mHash url =
         . left
         $ OCFErrHttpResponse url (Http.statusCode status) (Text.decodeLatin1 $ Http.statusMessage status)
 
-      -- Read a maxiumm of 600 bytes and then later check if the length exceeds 512 bytes.
-      respLBS <- liftIO $ Http.brReadSome (Http.responseBody responseBR) 600
+      let (bytesToRead, maxBytes) =
+            case url of
+              OffChainPoolUrl _ -> (600, 512)
+              OffChainVoteUrl _ -> (3000, 3000)
+      respLBS <- liftIO $ Http.brReadSome (Http.responseBody responseBR) bytesToRead
       let respBS = LBS.toStrict respLBS
 
       let mContentType = List.lookup Http.hContentType (Http.responseHeaders responseBR)
@@ -132,20 +135,24 @@ httpGetOffChain manager request mHash url =
                 . left
                 $ OCFErrBadContentType url (Text.decodeLatin1 ct)
 
-      unless (BS.length respBS <= 512)
+      unless (BS.length respBS <= maxBytes)
         . left
         $ OCFErrDataTooLong url
 
       let metadataHash = Crypto.digest (Proxy :: Proxy Crypto.Blake2b_256) respBS
 
-      whenJust mHash $ \expectedMetaHash -> do
-        let eMetaHash =
-              case expectedMetaHash of
-                OffChainPoolHash (PoolMetaHash m) -> m
-                OffChainVoteHash (VoteMetaHash m) -> m
-        when (metadataHash /= eMetaHash)
-          . left
-          $ OCFErrHashMismatch url (renderByteArray eMetaHash) (renderByteArray metadataHash)
+      mWarning <- case mHash of
+        Nothing -> pure Nothing
+        Just expectedMetaHash -> do
+          case expectedMetaHash of
+            OffChainPoolHash (PoolMetaHash m) ->
+              if metadataHash /= m
+                then left $ OCFErrHashMismatch url (renderByteArray m) (renderByteArray metadataHash)
+                else pure Nothing
+            OffChainVoteHash (VoteMetaHash m) ->
+              if metadataHash /= m
+                then pure $ Just $ textShow $ OCFErrHashMismatch url (renderByteArray m) (renderByteArray metadataHash)
+                else pure Nothing
 
       case url of
         OffChainPoolUrl _ -> do
@@ -165,15 +172,19 @@ httpGetOffChain manager request mHash url =
                   spodJson = Text.decodeUtf8 $ LBS.toStrict (Aeson.encode decodedMetadata)
                 , spodContentType = mContentType
                 }
-        OffChainVoteUrl _ ->
+        OffChainVoteUrl _ -> do
+          decodedMetadata <-
+            case Aeson.eitherDecode' @Aeson.Value respLBS of
+              Left err -> left $ OCFErrJsonDecodeFail url (Text.pack err)
+              Right res -> pure res
           pure $
             SimplifiedOffChainVoteDataType
               SimplifiedOffChainVoteData
                 { sovaHash = metadataHash
                 , sovaBytes = respBS
-                , -- TODO: no json format decided for vote metadata yet so we are leaving it blank for now
-                  sovaJson = "{}"
+                , sovaJson = Text.decodeUtf8 $ LBS.toStrict (Aeson.encode decodedMetadata)
                 , sovaContentType = mContentType
+                , sovaWarning = mWarning
                 }
 
 -- | Is the provided ByteSring possibly JSON object?

cardano-db-sync/src/Cardano/DbSync/Types.hs

@@ -183,6 +183,7 @@ data SimplifiedOffChainVoteData = SimplifiedOffChainVoteData
   , sovaBytes :: !ByteString
   , sovaJson :: !Text
   , sovaContentType :: !(Maybe ByteString)
+  , sovaWarning :: !(Maybe Text)
   }
 
 data Retry = Retry

cardano-db/src/Cardano/Db/Schema.hs

@@ -660,6 +660,7 @@ share
     hash                ByteString
     json                Text                sqltype=jsonb
     bytes               ByteString          sqltype=bytea
+    warning             Text Maybe
     UniqueOffChainVoteData votingAnchorId hash
     deriving Show
 
@@ -1250,11 +1251,13 @@ schemaDocs =
       VotingProcedureVotingAnchorId # "The VotingAnchor table index associated with this VotingProcedure."
 
     OffChainVoteData --^ do
-      "The table with the offchain metadata related to Vote Anchors. New in 13.2-Conway."
+      "The table with the offchain metadata related to Vote Anchors. It accepts metadata in a more lenient way than what's\
+        \ decribed in CIP-100. New in 13.2-Conway."
       OffChainVoteDataVotingAnchorId # "The VotingAnchor table index this offchain data refers."
       OffChainVoteDataHash # "The hash of the offchain data."
       OffChainVoteDataJson # "The payload as JSON."
       OffChainVoteDataBytes # "The raw bytes of the payload."
+      OffChainVoteDataWarning # "A warning that occured while validating the metadata."
 
     OffChainVoteFetchError --^ do
       "Errors while fetching or validating offchain Voting Anchor metadata. New in 13.2-Conway."

schema/migration-2-0035-20231218.sql

@@ -0,0 +1,19 @@
+-- Persistent generated migration.
+
+CREATE FUNCTION migrate() RETURNS void AS $$
+DECLARE
+  next_version int ;
+BEGIN
+  SELECT stage_two + 1 INTO next_version FROM schema_version ;
+  IF next_version = 35 THEN
+    EXECUTE 'ALTER TABLE "off_chain_vote_data" ADD COLUMN "warning" VARCHAR NULL' ;
+    -- Hand written SQL statements can be added here.
+    UPDATE schema_version SET stage_two = next_version ;
+    RAISE NOTICE 'DB has been migrated to stage_two version %', next_version ;
+  END IF ;
+END ;
+$$ LANGUAGE plpgsql ;
+
+SELECT migrate() ;
+
+DROP FUNCTION migrate() ;