add offchain user header to configuration

Author: Cmdv

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

@@ -38,6 +38,7 @@ module Cardano.DbSync.Config.Types (
   PlutusConfig (..),
   GovernanceConfig (..),
   OffchainPoolDataConfig (..),
+  OffChainUserAgent (..),
   JsonTypeConfig (..),
   LedgerStateDir (..),
   LogFileDir (..),
@@ -189,6 +190,7 @@ data SyncInsertOptions = SyncInsertOptions
   , sioPoolStats :: PoolStatsConfig
   , sioJsonType :: JsonTypeConfig
   , sioRemoveJsonbFromSchema :: RemoveJsonbFromSchemaConfig
+  , sioOffchainUserAgent :: OffChainUserAgent
   , sioStopAtBlock :: Maybe Word64
   }
   deriving (Eq, Show)
@@ -263,6 +265,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
   }
@@ -456,6 +464,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
@@ -478,6 +487,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
     ]
 
@@ -500,6 +510,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
@@ -517,6 +528,7 @@ instance ToJSON SyncInsertOptions where
       , "pool_stat" .= sioPoolStats
       , "json_type" .= sioJsonType
       , "remove_jsonb_from_schema" .= sioRemoveJsonbFromSchema
+      , "offchain_user_agent" .= sioOffchainUserAgent
       , "stop_at_block" .= sioStopAtBlock
       ]
 
@@ -747,6 +759,7 @@ instance Default SyncInsertOptions where
       , sioPoolStats = PoolStatsConfig False
       , sioJsonType = JsonTypeText
       , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+      , sioOffchainUserAgent = OffChainUserAgent Nothing
       , sioStopAtBlock = Nothing
       }
 
@@ -766,6 +779,7 @@ fullInsertOptions =
     , sioPoolStats = PoolStatsConfig True
     , sioJsonType = JsonTypeText
     , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    , sioOffchainUserAgent = OffChainUserAgent Nothing
     , sioStopAtBlock = Nothing
     }
 
@@ -785,6 +799,7 @@ onlyUTxOInsertOptions =
     , sioPoolStats = PoolStatsConfig False
     , sioJsonType = JsonTypeText
     , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    , sioOffchainUserAgent = OffChainUserAgent Nothing
     , sioStopAtBlock = Nothing
     }
 
@@ -812,6 +827,7 @@ disableAllInsertOptions =
     , sioGovernance = GovernanceConfig False
     , sioJsonType = JsonTypeText
     , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
+    , sioOffchainUserAgent = OffChainUserAgent Nothing
     , sioStopAtBlock = Nothing
     }
 

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 (..),
@@ -46,11 +47,12 @@ import qualified Network.HTTP.Types as Http
 -------------------------------------------------------------------------------------
 httpGetOffChainPoolData ::
   Http.Manager ->
-  Http.Request ->
   PoolUrl ->
+  OffChainUserAgent ->
   Maybe PoolMetaHash ->
   ExceptT OffChainFetchError IO SimplifiedOffChainPoolData
-httpGetOffChainPoolData manager request purl expectedMetaHash = do
+httpGetOffChainPoolData manager purl userAgent expectedMetaHash = do
+  request <- parseOffChainUrl url userAgent
   httpRes <- handleExceptT (convertHttpException url) req
   (respBS, respLBS, mContentType) <- hoistEither httpRes
   let metadataHash = Crypto.digest (Proxy :: Proxy Crypto.Blake2b_256) respBS
@@ -81,30 +83,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,22 +209,24 @@ isPossiblyJsonObject bs =
 -------------------------------------------------------------------------------------
 -- Url
 -------------------------------------------------------------------------------------
-parseOffChainUrl :: OffChainUrlType -> ExceptT OffChainFetchError IO Http.Request
-parseOffChainUrl url =
-  handleExceptT wrapHttpException $ applyHeaders <$> 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)
 
-applyHeaders :: Http.Request -> Http.Request
-applyHeaders req =
+applyHeaders :: OffChainUserAgent -> Http.Request -> Http.Request
+applyHeaders (OffChainUserAgent mUserAgent) req =
   req
     { Http.requestHeaders =
         Http.requestHeaders req
           ++ [ (CI.mk "content-type", "application/json")
-             , (CI.mk "user-agent", "cardano-db-sync")
+             , (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": "test-agent-v1.0"
+        }
+      |]
     , [aesonQQ|
         {
           "tx_out": {

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 |
@@ -534,6 +535,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`