1974 - add user agent to offchain queries

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Config.hs

@@ -34,6 +34,7 @@ insertConfig = do
           , sioPoolStats = PoolStatsConfig False
           , sioJsonType = JsonTypeDisable
           , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+          , sioOffchainUserAgent = OffChainUserAgent Nothing
           , sioStopAtBlock = Nothing
           }
 

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Config/Parse.hs

@@ -104,6 +104,7 @@ insertConfig = do
           , sioPoolStats = PoolStatsConfig False
           , sioJsonType = JsonTypeDisable
           , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+          , sioOffchainUserAgent = OffChainUserAgent Nothing
           , sioStopAtBlock = Nothing
           }
 

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

@@ -3,6 +3,7 @@
 
 import Cardano.Db (PoolMetaHash (..), PoolUrl (..), VoteMetaHash (..), VoteUrl (..))
 import qualified Cardano.Db as DB
+import Cardano.DbSync.Config.Types (OffChainUserAgent (..))
 import Cardano.DbSync.Error (bsBase16Encode, runOrThrowIO)
 import Cardano.DbSync.OffChain.Http
 import Cardano.DbSync.Types
@@ -107,10 +108,12 @@ runHttpGetPool poolUrl mHash =
   where
     httpGet :: ExceptT OffChainFetchError IO SimplifiedOffChainPoolData
     httpGet = do
-      request <- parseOffChainUrl $ OffChainPoolUrl poolUrl
+      request <- parseOffChainUrl (OffChainPoolUrl poolUrl) defaultUserAgent
       manager <- liftIO $ Http.newManager tlsManagerSettings
       httpGetOffChainPoolData manager request poolUrl mHash
 
+    defaultUserAgent = OffChainUserAgent Nothing
+
     reportSuccess :: SimplifiedOffChainPoolData -> IO ()
     reportSuccess spod = do
       case spodContentType spod of
@@ -126,7 +129,9 @@ runHttpGetVote voteUrl mHash vtype =
   reportSuccess =<< runOrThrowIO (runExceptT httpGet)
   where
     httpGet :: ExceptT OffChainFetchError IO SimplifiedOffChainVoteData
-    httpGet = httpGetOffChainVoteData [] voteUrl mHash vtype
+    httpGet = httpGetOffChainVoteData [] voteUrl defaultUserAgent mHash vtype
+
+    defaultUserAgent = OffChainUserAgent Nothing
 
     reportSuccess :: SimplifiedOffChainVoteData -> IO ()
     reportSuccess spod = do

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

@@ -7,6 +7,7 @@
 #endif
 
 import qualified Cardano.Db as DB
+import Cardano.DbSync.Config.Types (OffChainUserAgent (..))
 import Cardano.DbSync.OffChain.Http (
   httpGetOffChainPoolData,
   parseOffChainUrl,
@@ -40,8 +41,9 @@ main = do
     testOne manager !accum testPoolOffChain = do
       let poolUrl = toUrl testPoolOffChain
           mHash = Just $ toHash testPoolOffChain
+          defaultUserAgent = OffChainUserAgent Nothing
       eres <- runExceptT $ do
-        request <- parseOffChainUrl (OffChainPoolUrl poolUrl)
+        request <- parseOffChainUrl (OffChainPoolUrl poolUrl) defaultUserAgent
         httpGetOffChainPoolData manager request poolUrl mHash
       case eres of
         Left err -> do

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

@@ -320,6 +320,7 @@ extractSyncOptions snp aop snc =
         , ioPoolStats = isPoolStatsEnabled (sioPoolStats (dncInsertOptions snc))
         , ioGov = useGovernance
         , ioRemoveJsonbFromSchema = isRemoveJsonbFromSchemaEnabled (sioRemoveJsonbFromSchema (dncInsertOptions snc))
+        , ioOffChainUserAgent = sioOffchainUserAgent (dncInsertOptions snc)
         , ioTxOutVariantType = ioTxOutVariantType'
         }
 

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

@@ -28,7 +28,7 @@ import Ouroboros.Network.Magic (NetworkMagic (..))
 
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Cache.Types (CacheStatistics, CacheStatus)
-import Cardano.DbSync.Config.Types (SnapshotIntervalConfig, SyncNodeConfig)
+import Cardano.DbSync.Config.Types (OffChainUserAgent, SnapshotIntervalConfig, SyncNodeConfig)
 import Cardano.DbSync.Ledger.Types (HasLedgerEnv)
 import Cardano.DbSync.LocalStateQuery (NoLedgerEnv)
 import Cardano.DbSync.Types (
@@ -88,6 +88,7 @@ data InsertOptions = InsertOptions
   , ioPoolStats :: !Bool
   , ioGov :: !Bool
   , ioRemoveJsonbFromSchema :: !Bool
+  , ioOffChainUserAgent :: !OffChainUserAgent
   , ioTxOutVariantType :: !DB.TxOutVariantType
   }
   deriving (Show)

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

@@ -38,6 +38,7 @@ module Cardano.DbSync.Config.Types (
   PlutusConfig (..),
   GovernanceConfig (..),
   OffchainPoolDataConfig (..),
+  OffChainUserAgent (..),
   JsonTypeConfig (..),
   SnapshotIntervalConfig (..),
   LedgerStateDir (..),
@@ -192,6 +193,7 @@ data SyncInsertOptions = SyncInsertOptions
   , sioPoolStats :: PoolStatsConfig
   , sioJsonType :: JsonTypeConfig
   , sioRemoveJsonbFromSchema :: RemoveJsonbFromSchemaConfig
+  , sioOffchainUserAgent :: OffChainUserAgent
   , sioStopAtBlock :: Maybe Word64
   }
   deriving (Eq, Show)
@@ -266,6 +268,12 @@ newtype OffchainPoolDataConfig = OffchainPoolDataConfig
   }
   deriving (Eq, Show)
 
+newtype OffChainUserAgent = OffChainUserAgent
+  { unOffChainUserAgent :: Maybe Text
+  }
+  deriving (Eq, Show)
+  deriving newtype (ToJSON, FromJSON)
+
 newtype RemoveJsonbFromSchemaConfig = RemoveJsonbFromSchemaConfig
   { isRemoveJsonbFromSchemaEnabled :: Bool
   }
@@ -465,6 +473,7 @@ parseOverrides obj baseOptions = do
     <*> obj .:? "pool_stat" .!= sioPoolStats baseOptions
     <*> obj .:? "json_type" .!= sioJsonType baseOptions
     <*> obj .:? "remove_jsonb_from_schema" .!= sioRemoveJsonbFromSchema baseOptions
+    <*> obj .:? "offchain_user_agent" .!= sioOffchainUserAgent baseOptions
     <*> obj .:? "stop_at_block" .!= sioStopAtBlock baseOptions
 
 instance ToJSON SyncInsertConfig where
@@ -487,6 +496,7 @@ optionsToList SyncInsertOptions {..} =
     , toJsonIfSet "pool_stat" sioPoolStats
     , toJsonIfSet "json_type" sioJsonType
     , toJsonIfSet "remove_jsonb_from_schema" sioRemoveJsonbFromSchema
+    , toJsonIfSet "offchain_user_agent" sioOffchainUserAgent
     , toJsonIfSet "stop_at_block" sioStopAtBlock
     ]
 
@@ -509,6 +519,7 @@ instance FromJSON SyncInsertOptions where
       <*> obj .:? "pool_stat" .!= sioPoolStats def
       <*> obj .:? "json_type" .!= sioJsonType def
       <*> obj .:? "remove_jsonb_from_schema" .!= sioRemoveJsonbFromSchema def
+      <*> obj .:? "offchain_user_agent" .!= sioOffchainUserAgent def
       <*> obj .:? "stop_at_block" .!= sioStopAtBlock def
 
 instance ToJSON SyncInsertOptions where
@@ -526,6 +537,7 @@ instance ToJSON SyncInsertOptions where
       , "pool_stat" .= sioPoolStats
       , "json_type" .= sioJsonType
       , "remove_jsonb_from_schema" .= sioRemoveJsonbFromSchema
+      , "offchain_user_agent" .= sioOffchainUserAgent
       , "stop_at_block" .= sioStopAtBlock
       ]
 
@@ -773,6 +785,7 @@ instance Default SyncInsertOptions where
       , sioPoolStats = PoolStatsConfig False
       , sioJsonType = JsonTypeText
       , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+      , sioOffchainUserAgent = OffChainUserAgent Nothing
       , sioStopAtBlock = Nothing
       }
 
@@ -792,6 +805,7 @@ fullInsertOptions =
     , sioPoolStats = PoolStatsConfig True
     , sioJsonType = JsonTypeText
     , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    , sioOffchainUserAgent = OffChainUserAgent Nothing
     , sioStopAtBlock = Nothing
     }
 
@@ -811,6 +825,7 @@ onlyUTxOInsertOptions =
     , sioPoolStats = PoolStatsConfig False
     , sioJsonType = JsonTypeText
     , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    , sioOffchainUserAgent = OffChainUserAgent Nothing
     , sioStopAtBlock = Nothing
     }
 
@@ -838,6 +853,7 @@ disableAllInsertOptions =
     , sioGovernance = GovernanceConfig False
     , sioJsonType = JsonTypeText
     , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    , sioOffchainUserAgent = OffChainUserAgent Nothing
     , sioStopAtBlock = Nothing
     }
 

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

@@ -255,11 +255,12 @@ runFetchOffChainPoolThread syncEnv = do
             poolq <- atomically $ flushTBQueue (envOffChainPoolWorkQueue threadSyncEnv)
             manager <- Http.newManager tlsManagerSettings
             now <- liftIO Time.getPOSIXTime
-            mapM_ (queuePoolInsert <=< fetchOffChainPoolData trce manager now) poolq
+            mapM_ (queuePoolInsert <=< fetchOffChainPoolData trce manager now userAgent) poolq
       )
   where
     trce = getTrace syncEnv
     iopts = getInsertOptions syncEnv
+    userAgent = ioOffChainUserAgent iopts
 
     queuePoolInsert :: OffChainPoolResult -> IO ()
     queuePoolInsert = atomically . writeTBQueue (envOffChainPoolResultQueue syncEnv)
@@ -290,12 +291,13 @@ runFetchOffChainVoteThread syncEnv = do
                 loadOffChainVoteWorkQueue trce (envOffChainVoteWorkQueue threadSyncEnv)
             voteq <- atomically $ flushTBQueue (envOffChainVoteWorkQueue threadSyncEnv)
             now <- liftIO Time.getPOSIXTime
-            mapM_ (queueVoteInsert <=< fetchOffChainVoteData gateways now) voteq
+            mapM_ (queueVoteInsert <=< fetchOffChainVoteData gateways userAgent now) voteq
       )
   where
     trce = getTrace syncEnv
     iopts = getInsertOptions syncEnv
     gateways = dncIpfsGateway $ envSyncNodeConfig syncEnv
+    userAgent = ioOffChainUserAgent iopts
 
     queueVoteInsert :: OffChainVoteResult -> IO ()
     queueVoteInsert = atomically . writeTBQueue (envOffChainVoteResultQueue syncEnv)
@@ -307,12 +309,12 @@ tDelay = threadDelay 300_000_000
 ---------------------------------------------------------------------------------------------------------------------------------
 -- Fetch OffChain data
 ---------------------------------------------------------------------------------------------------------------------------------
-fetchOffChainPoolData :: Trace IO Text -> Http.Manager -> Time.POSIXTime -> OffChainPoolWorkQueue -> IO OffChainPoolResult
-fetchOffChainPoolData _tracer manager time oPoolWorkQ =
+fetchOffChainPoolData :: Trace IO Text -> Http.Manager -> Time.POSIXTime -> OffChainUserAgent -> OffChainPoolWorkQueue -> IO OffChainPoolResult
+fetchOffChainPoolData _tracer manager time ocUserAgent oPoolWorkQ =
   convert <<$>> runExceptT $ do
     let url = oPoolWqUrl oPoolWorkQ
         metaHash = oPoolWqMetaHash oPoolWorkQ
-    request <- parseOffChainUrl $ OffChainPoolUrl url
+    request <- parseOffChainUrl (OffChainPoolUrl url) ocUserAgent
     httpGetOffChainPoolData manager request url (Just metaHash)
   where
     convert :: Either OffChainFetchError SimplifiedOffChainPoolData -> OffChainPoolResult
@@ -338,12 +340,12 @@ fetchOffChainPoolData _tracer manager time oPoolWorkQ =
               , DB.offChainPoolFetchErrorRetryCount = retryCount (oPoolWqRetry oPoolWorkQ)
               }
 
-fetchOffChainVoteData :: [Text] -> Time.POSIXTime -> OffChainVoteWorkQueue -> IO OffChainVoteResult
-fetchOffChainVoteData gateways time oVoteWorkQ =
+fetchOffChainVoteData :: [Text] -> OffChainUserAgent -> Time.POSIXTime -> OffChainVoteWorkQueue -> IO OffChainVoteResult
+fetchOffChainVoteData gateways userAgent time oVoteWorkQ =
   convert <<$>> runExceptT $ do
     let url = oVoteWqUrl oVoteWorkQ
         metaHash = oVoteWqMetaHash oVoteWorkQ
-    httpGetOffChainVoteData gateways url (Just metaHash) (oVoteWqType oVoteWorkQ)
+    httpGetOffChainVoteData gateways url userAgent (Just metaHash) (oVoteWqType oVoteWorkQ)
   where
     convert :: Either OffChainFetchError SimplifiedOffChainVoteData -> OffChainVoteResult
     convert eres =

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

@@ -13,6 +13,7 @@ import qualified Cardano.Crypto.Hash.Blake2b as Crypto
 import qualified Cardano.Crypto.Hash.Class as Crypto
 import Cardano.Db (PoolMetaHash (..), PoolUrl (..), VoteMetaHash (..), VoteUrl (..))
 import qualified Cardano.Db as DB
+import Cardano.DbSync.Config.Types (OffChainUserAgent (..))
 import Cardano.DbSync.OffChain.Types (
   PoolOffChainMetadata (..),
   PoolTicker (..),
@@ -81,30 +82,32 @@ httpGetOffChainPoolData manager request purl expectedMetaHash = do
 httpGetOffChainVoteData ::
   [Text] ->
   VoteUrl ->
+  OffChainUserAgent ->
   Maybe VoteMetaHash ->
   DB.AnchorType ->
   ExceptT OffChainFetchError IO SimplifiedOffChainVoteData
-httpGetOffChainVoteData gateways vurl metaHash anchorType = do
+httpGetOffChainVoteData gateways vurl userAgent metaHash anchorType = do
   case useIpfsGatewayMaybe vurl gateways of
-    Nothing -> httpGetOffChainVoteDataSingle vurl metaHash anchorType
+    Nothing -> httpGetOffChainVoteDataSingle vurl userAgent 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
+      msocd <- liftIO $ runExceptT $ httpGetOffChainVoteDataSingle url userAgent metaHash anchorType
       case msocd of
         Right socd -> pure socd
         Left err -> tryAllGatewaysRec rest (err : acc)
 
 httpGetOffChainVoteDataSingle ::
   VoteUrl ->
+  OffChainUserAgent ->
   Maybe VoteMetaHash ->
   DB.AnchorType ->
   ExceptT OffChainFetchError IO SimplifiedOffChainVoteData
-httpGetOffChainVoteDataSingle vurl metaHash anchorType = do
+httpGetOffChainVoteDataSingle vurl userAgent metaHash anchorType = do
   manager <- liftIO $ Http.newManager tlsManagerSettings
-  request <- parseOffChainUrl url
+  request <- parseOffChainUrl url userAgent
   let req = httpGetBytes manager request 3000000 3000000 url
   httpRes <- handleExceptT (convertHttpException url) req
   (respBS, respLBS, mContentType) <- hoistEither httpRes
@@ -205,19 +208,24 @@ isPossiblyJsonObject bs =
 -------------------------------------------------------------------------------------
 -- Url
 -------------------------------------------------------------------------------------
-parseOffChainUrl :: OffChainUrlType -> ExceptT OffChainFetchError IO Http.Request
-parseOffChainUrl url =
-  handleExceptT wrapHttpException $ applyContentType <$> Http.parseRequest (showUrl url)
+parseOffChainUrl :: OffChainUrlType -> OffChainUserAgent -> ExceptT OffChainFetchError IO Http.Request
+parseOffChainUrl url userAgent =
+  handleExceptT wrapHttpException $ applyHeaders userAgent <$> Http.parseRequest (showUrl url)
   where
     wrapHttpException :: HttpException -> OffChainFetchError
     wrapHttpException err = OCFErrHttpException url (textShow err)
 
-applyContentType :: Http.Request -> Http.Request
-applyContentType req =
+applyHeaders :: OffChainUserAgent -> Http.Request -> Http.Request
+applyHeaders (OffChainUserAgent mUserAgent) req =
   req
     { Http.requestHeaders =
-        Http.requestHeaders req ++ [(CI.mk "content-type", "application/json")]
+        Http.requestHeaders req
+          ++ [ (CI.mk "content-type", "application/json")
+             , (CI.mk "user-agent", Text.encodeUtf8 userAgent)
+             ]
     }
+  where
+    userAgent = fromMaybe "cardano-db-sync" mUserAgent
 
 -------------------------------------------------------------------------------------
 -- Exceptions to Error

cardano-db-sync/test/Cardano/DbSync/Config/TypesTest.hs

@@ -140,12 +140,18 @@ genDefaultJson =
           },
           "governance": "enable",
           "offchain_pool_data": "enable",
+          "offchain_user_agent": null,
           "json_type": "text"
         }
       |]
     , [aesonQQ|
         { }
       |]
+    , [aesonQQ|
+        {
+          "offchain_user_agent": null
+        }
+      |]
     , [aesonQQ|
         {
           "tx_out": {

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

@@ -135,6 +135,7 @@ syncInsertOptions =
     <*> (PoolStatsConfig <$> Gen.bool)
     <*> Gen.element [JsonTypeText, JsonTypeJsonb, JsonTypeDisable]
     <*> (RemoveJsonbFromSchemaConfig <$> Gen.bool)
+    <*> pure (OffChainUserAgent Nothing)
     <*> pure Nothing
 
 txOutConfig :: Gen TxOutConfig

doc/configuration.md

@@ -63,6 +63,7 @@ Below is a sample `insert_options` section that shows all the defaults:
 | [plutus](#plutus)                            | `object`   | Optional |
 | [governance](#governance)                    | `enum`     | Optional |
 | [offchain\_pool\_data](#offchain-pool-data)  | `enum`     | Optional |
+| [offchain\_user\_agent](#offchain-user-agent) | `string`   | Optional |
 | [pool\_stat](#pool-stat)                     | `enum`     | Optional |
 | [remove\_jsonb_from_schema](#remove-jsonb-from-schema) | `enum`     | Optional |
 | [stop\_at\_block](#stop-at-block)            | `integer`  | Optional |
@@ -535,6 +536,25 @@ This will effect all governance related data/functionality.
 | `"enable"` | Enables fetching offchain metadata.       |
 | `"disable"`| Disables fetching pool offchain metadata. |
 
+## Offchain User Agent
+
+`offchain_user_agent`
+
+ * Type: `string`
+ * Optional: When not specified, defaults to "cardano-db-sync"
+
+Configures the User-Agent header sent when fetching offchain metadata (pool metadata, governance vote data, etc.). This allows operators to identify their db-sync instance in server logs.
+
+### Example
+
+```json
+{
+  "insert_options": {
+    "offchain_user_agent": "my-cardano-node-v1.0"
+  }
+}
+```
+
 ## Pool Stat
 
 `pool_stat`