Improve offchain

cardano-db-sync/app/http-get-json-metadata.hs

@@ -126,10 +126,7 @@ runHttpGetVote voteUrl mHash vtype =
   reportSuccess =<< runOrThrowIO (runExceptT httpGet)
   where
     httpGet :: ExceptT OffChainFetchError IO SimplifiedOffChainVoteData
-    httpGet = do
-      request <- parseOffChainUrl $ OffChainVoteUrl voteUrl
-      manager <- liftIO $ Http.newManager tlsManagerSettings
-      httpGetOffChainVoteData manager request voteUrl mHash vtype
+    httpGet = httpGetOffChainVoteData [] voteUrl mHash vtype
 
     reportSuccess :: SimplifiedOffChainVoteData -> IO ()
     reportSuccess spod = do

cardano-db-sync/app/test-http-get-json-metadata.hs

@@ -112,6 +112,7 @@ classifyFetchError tf fe =
     OCFErrIOException {} -> tf {tfIOException = tfIOException tf + 1}
     OCFErrTimeout {} -> tf {tfTimeout = tfTimeout tf + 1}
     OCFErrConnectionFailure {} -> tf {tfConnectionFailure = tfConnectionFailure tf + 1}
+    _ -> tf
 
 emptyTestFailure :: TestFailure
 emptyTestFailure = TestFailure 0 0 0 0 0 0 0 0 0 0 0

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

@@ -32,6 +32,7 @@ import Cardano.DbSync.Config.Node (NodeConfig (..), parseNodeConfig, parseSyncPr
 import Cardano.DbSync.Config.Shelley
 import Cardano.DbSync.Config.Types
 import Cardano.Prelude
+import qualified Data.Text as Text
 import System.FilePath (takeDirectory, (</>))
 
 configureLogging :: SyncNodeConfig -> Text -> IO (Trace IO Text)
@@ -91,7 +92,11 @@ coalesceConfig pcfg ncfg adjustGenesisPath = do
       , dncBabbageHardFork = ncBabbageHardFork ncfg
       , dncConwayHardFork = ncConwayHardFork ncfg
       , dncInsertOptions = extractInsertOptions pcfg
+      , dncIpfsGateway = endsInSlash <$> pcIpfsGateway pcfg
       }
 
 mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath)
 mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) </> fp
+
+endsInSlash :: Text -> Text
+endsInSlash txt = if Text.isSuffixOf "/" txt then txt else txt <> "/"

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

@@ -142,6 +142,7 @@ data SyncNodeConfig = SyncNodeConfig
   , dncBabbageHardFork :: !TriggerHardFork
   , dncConwayHardFork :: !TriggerHardFork
   , dncInsertOptions :: !SyncInsertOptions
+  , dncIpfsGateway :: [Text]
   }
 
 data SyncPreConfig = SyncPreConfig
@@ -153,6 +154,7 @@ data SyncPreConfig = SyncPreConfig
   , pcEnableMetrics :: !Bool
   , pcPrometheusPort :: !Int
   , pcInsertConfig :: !SyncInsertConfig
+  , pcIpfsGateway :: ![Text]
   }
   deriving (Show)
 
@@ -390,6 +392,7 @@ parseGenSyncNodeConfig o =
     <*> o .: "EnableLogMetrics"
     <*> fmap (fromMaybe 8080) (o .:? "PrometheusPort")
     <*> o .:? "insert_options" .!= def
+    <*> o .:? "ipfs_gateway" .!= ["ipfs.io"]
 
 instance FromJSON SyncProtocol where
   parseJSON o =

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

@@ -22,6 +22,7 @@ import Cardano.Db (runIohkLogging)
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Api
 import Cardano.DbSync.Api.Types (InsertOptions (..), SyncEnv (..))
+import Cardano.DbSync.Config.Types
 import Cardano.DbSync.OffChain.Http
 import Cardano.DbSync.OffChain.Query
 import qualified Cardano.DbSync.OffChain.Vote.Types as Vote
@@ -212,12 +213,12 @@ runFetchOffChainVoteThread syncEnv = do
             -- load the offChain vote work queue using the db
             _ <- runReaderT (loadOffChainVoteWorkQueue trce (envOffChainVoteWorkQueue syncEnv)) backendVote
             voteq <- atomically $ flushTBQueue (envOffChainVoteWorkQueue syncEnv)
-            manager <- Http.newManager tlsManagerSettings
             now <- liftIO Time.getPOSIXTime
-            mapM_ (queueVoteInsert <=< fetchOffChainVoteData trce manager now) voteq
+            mapM_ (queueVoteInsert <=< fetchOffChainVoteData gateways now) voteq
   where
     trce = getTrace syncEnv
     iopts = getInsertOptions syncEnv
+    gateways = dncIpfsGateway $ envSyncNodeConfig syncEnv
 
     queueVoteInsert :: OffChainVoteResult -> IO ()
     queueVoteInsert = atomically . writeTBQueue (envOffChainVoteResultQueue syncEnv)
@@ -260,13 +261,12 @@ fetchOffChainPoolData _tracer manager time oPoolWorkQ =
               , DB.offChainPoolFetchErrorRetryCount = retryCount (oPoolWqRetry oPoolWorkQ)
               }
 
-fetchOffChainVoteData :: Trace IO Text -> Http.Manager -> Time.POSIXTime -> OffChainVoteWorkQueue -> IO OffChainVoteResult
-fetchOffChainVoteData _tracer manager time oVoteWorkQ =
+fetchOffChainVoteData :: [Text] -> Time.POSIXTime -> OffChainVoteWorkQueue -> IO OffChainVoteResult
+fetchOffChainVoteData gateways time oVoteWorkQ =
   convert <<$>> runExceptT $ do
     let url = oVoteWqUrl oVoteWorkQ
         metaHash = oVoteWqMetaHash oVoteWorkQ
-    request <- parseOffChainUrl $ OffChainVoteUrl url
-    httpGetOffChainVoteData manager request url (Just metaHash) (oVoteWqType oVoteWorkQ)
+    httpGetOffChainVoteData gateways url (Just metaHash) (oVoteWqType oVoteWorkQ)
   where
     convert :: Either OffChainFetchError SimplifiedOffChainVoteData -> OffChainVoteResult
     convert eres =
@@ -323,8 +323,8 @@ fetchOffChainVoteData _tracer manager time oVoteWorkQ =
             , DB.offChainVoteDrepDataObjectives = Vote.textValue <$> Vote.objectives (Vote.body dt)
             , DB.offChainVoteDrepDataMotivations = Vote.textValue <$> Vote.motivations (Vote.body dt)
             , DB.offChainVoteDrepDataQualifications = Vote.textValue <$> Vote.qualifications (Vote.body dt)
-            , DB.offChainVoteDrepDataImageUrl = Vote.textValue . Vote.contentUrl <$> Vote.image (Vote.body dt)
-            , DB.offChainVoteDrepDataImageHash = Vote.textValue . Vote.sha256 <$> Vote.image (Vote.body dt)
+            , DB.offChainVoteDrepDataImageUrl = Vote.textValue . Vote.content <$> Vote.image (Vote.body dt)
+            , DB.offChainVoteDrepDataImageHash = Vote.textValue <$> (Vote.msha256 =<< Vote.image (Vote.body dt))
             }
       _ -> Nothing
 

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

@@ -38,6 +38,7 @@ import qualified Data.Text.Encoding as Text
 import GHC.Show (show)
 import Network.HTTP.Client (HttpException (..))
 import qualified Network.HTTP.Client as Http
+import Network.HTTP.Client.TLS (tlsManagerSettings)
 import qualified Network.HTTP.Types as Http
 
 -------------------------------------------------------------------------------------
@@ -78,13 +79,33 @@ httpGetOffChainPoolData manager request purl expectedMetaHash = do
     url = OffChainPoolUrl purl
 
 httpGetOffChainVoteData ::
-  Http.Manager ->
-  Http.Request ->
+  [Text] ->
+  VoteUrl ->
+  Maybe VoteMetaHash ->
+  DB.AnchorType ->
+  ExceptT OffChainFetchError IO SimplifiedOffChainVoteData
+httpGetOffChainVoteData gateways vurl metaHash anchorType = do
+  case useIpfsGatewayMaybe vurl gateways of
+    Nothing -> httpGetOffChainVoteDataSingle vurl metaHash anchorType
+    Just [] -> left $ OCFErrNoIpfsGateway (OffChainVoteUrl vurl)
+    Just urls -> tryAllGatewaysRec urls []
+  where
+    tryAllGatewaysRec [] acc = left $ OCFErrIpfsGatewayFailures (OffChainVoteUrl vurl) (reverse acc)
+    tryAllGatewaysRec (url : rest) acc = do
+      msocd <- liftIO $ runExceptT $ httpGetOffChainVoteDataSingle url metaHash anchorType
+      case msocd of
+        Right socd -> pure socd
+        Left err -> tryAllGatewaysRec rest (err : acc)
+
+httpGetOffChainVoteDataSingle ::
   VoteUrl ->
   Maybe VoteMetaHash ->
   DB.AnchorType ->
   ExceptT OffChainFetchError IO SimplifiedOffChainVoteData
-httpGetOffChainVoteData manager request vurl metaHash anchorType = do
+httpGetOffChainVoteDataSingle vurl metaHash anchorType = do
+  manager <- liftIO $ Http.newManager tlsManagerSettings
+  request <- parseOffChainUrl url
+  let req = httpGetBytes manager request 10000 30000 url
   httpRes <- handleExceptT (convertHttpException url) req
   (respBS, respLBS, mContentType) <- hoistEither httpRes
   (ocvd, decodedValue, metadataHash, mWarning) <- parseAndValidateVoteData respBS respLBS metaHash anchorType (Just $ OffChainVoteUrl vurl)
@@ -98,7 +119,6 @@ httpGetOffChainVoteData manager request vurl metaHash anchorType = do
       , sovaWarning = mWarning
       }
   where
-    req = httpGetBytes manager request 10000 30000 url
     url = OffChainVoteUrl vurl
 
 parseAndValidateVoteData :: ByteString -> LBS.ByteString -> Maybe VoteMetaHash -> DB.AnchorType -> Maybe OffChainUrlType -> ExceptT OffChainFetchError IO (Vote.OffChainVoteData, Aeson.Value, ByteString, Maybe Text)
@@ -152,6 +172,8 @@ httpGetBytes manager request bytesToRead maxBytes url =
                   OCFErrBadContentTypeHtml url (Text.decodeLatin1 ct)
               unless
                 ( "application/json"
+                    `BS.isInfixOf` ct
+                    || "application/ld+json"
                     `BS.isInfixOf` ct
                     || "text/plain"
                     `BS.isInfixOf` ct
@@ -217,3 +239,9 @@ convertHttpException url he =
       case url of
         OffChainPoolUrl _ -> OCFErrUrlParseFail (OffChainPoolUrl $ PoolUrl $ Text.pack urlx) (Text.pack err)
         OffChainVoteUrl _ -> OCFErrUrlParseFail (OffChainVoteUrl $ VoteUrl $ Text.pack urlx) (Text.pack err)
+
+useIpfsGatewayMaybe :: VoteUrl -> [Text] -> Maybe [VoteUrl]
+useIpfsGatewayMaybe vu gateways =
+  case Text.stripPrefix "ipfs://" (unVoteUrl vu) of
+    Just sf -> Just $ VoteUrl . (<> sf) <$> gateways
+    Nothing -> Nothing

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

@@ -171,11 +171,20 @@ data DrepBody = DrepBody
   deriving (Show, Generic)
 
 data Image = Image
+  { content :: TextValue
+  , msha256 :: Maybe TextValue
+  }
+  deriving (Show, Generic)
+
+data ImageUrl = ImageUrl
   { contentUrl :: TextValue
   , sha256 :: TextValue
   }
   deriving (Show, Generic, FromJSON)
 
+fromImageUrl :: ImageUrl -> Image
+fromImageUrl img = Image (contentUrl img) (Just (sha256 img))
+
 data Reference tp = Reference
   { rtype :: TextValue -- key is @type. It can be "GovernanceMetadata" or "Other" or ?? "other" ?? or ""
   , label :: TextValue
@@ -297,6 +306,20 @@ instance FromJSON DrepBody where
     where
       withObjectV v' s p = withObject s p v'
 
+instance FromJSON Image where
+  parseJSON v = withObjectV v "Image" $ \o -> do
+    curl <- o .: "contentUrl"
+    case Text.stripPrefix "data:" (textValue curl) of
+      Just ctb
+        | (_, tb) <- Text.break (== '/') ctb
+        , Text.isPrefixOf "/" tb
+        , (_, b) <- Text.break (== ';') tb
+        , Just imageData <- Text.stripPrefix ";base64," b ->
+            pure $ Image (TextValue imageData) Nothing
+      _ -> fromImageUrl <$> parseJSON v
+    where
+      withObjectV v' s p = withObject s p v'
+
 parseTextLimit :: Int -> Key -> Object -> Parser TextValue
 parseTextLimit maxSize str o = do
   txt <- o .: str

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

@@ -231,6 +231,8 @@ data OffChainFetchError
   | OCFErrIOException !Text
   | OCFErrTimeout !OffChainUrlType !Text
   | OCFErrConnectionFailure !OffChainUrlType
+  | OCFErrNoIpfsGateway !OffChainUrlType
+  | OCFErrIpfsGatewayFailures !OffChainUrlType [OffChainFetchError]
   deriving (Eq, Generic)
 
 instance Exception OffChainFetchError
@@ -271,6 +273,10 @@ instance Show OffChainFetchError where
         mconcat
           [fetchUrlToString url, "Connection failure error when fetching metadata from ", show url, "."]
       OCFErrIOException err -> "IO Exception: " <> show err
+      OCFErrNoIpfsGateway url ->
+        mconcat [fetchUrlToString url, "No ipfs_gateway provided in the db-sync config"]
+      OCFErrIpfsGatewayFailures url errs ->
+        mconcat $ [fetchUrlToString url, "List of errors for the each ipfs gateway: "] <> fmap show errs
 
 showMUrl :: Maybe OffChainUrlType -> String
 showMUrl = \case

cardano-db-sync/test/Cardano/DbSync/Gen.hs

@@ -56,6 +56,7 @@ syncPreConfig =
     <*> Gen.bool
     <*> Gen.int (Range.linear 0 10000)
     <*> syncInsertConfig
+    <*> pure []
 
 syncNodeParams :: MonadGen m => m SyncNodeParams
 syncNodeParams =
@@ -103,6 +104,7 @@ syncNodeConfig loggingCfg =
     <*> triggerHardFork
     <*> triggerHardFork
     <*> syncInsertOptions
+    <*> pure []
 
 syncInsertConfig :: Gen SyncInsertConfig
 syncInsertConfig =