Fix JSON null bytes and CI

.github/workflows/ci.yaml

@@ -9,17 +9,17 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ghc: ['9.6.3']
-        cabal: ['3.10']
-        os: ['ubuntu-20.04', 'ubuntu-22.04', 'macOS-latest']
+        ghc: ['9.10.3', '9.12.2']
+        cabal: ['latest']
+        os: ['ubuntu-22.04', 'ubuntu-24.04', 'macOS-latest']
 
     steps:
     - name: 'GitHub actions env workaround'
       run: 'echo "ACTIONS_ALLOW_UNSECURE_COMMANDS=true" >> $GITHUB_ENV'
 
     # Setup
     - name: Checkout repository
-      uses: actions/checkout@v1
+      uses: actions/checkout@v4
 
     # Haskell Setup
     - name: Install GHC and Cabal
@@ -32,7 +32,7 @@ jobs:
         ghc --version
         cabal --version
     # Project Setup
-    - uses: actions/cache@v2
+    - uses: actions/cache@v4
       name: Cache dist-newstyle
       with:
         path: |
@@ -45,6 +45,9 @@ jobs:
     - name: Install liblzma
       run: brew install xz # xz package contains liblzma
       if: startsWith(matrix.os, 'macOS')
+    - name: Install liblzma
+      run: sudo apt-get install -y liblzma-dev
+      if: startsWith(matrix.os, 'ubuntu-24')
 
     - name: Install postgresql
       run: brew install postgresql # needed by libpq
@@ -75,7 +78,7 @@ jobs:
       run: strip chainweb-data
     - uses: actions/upload-artifact@v4
       with:
-        name: chainweb-data-build-${{ matrix.os }}
+        name: chainweb-data-build-${{ matrix.os }}-${{ matrix.ghc }}
         path: chainweb-data
 
     # Test

README.org

@@ -330,3 +330,11 @@ manually by undoing migrations and removing ~schema_migrations~ entries.
 the incoming migrations **before** they upgrade their ~chainweb-data~ versions. This will allow
 them to detect any potential conflicts and insert new schema migrations to be executed at the right moment, to
 accommodate the incoming changes.
+
+* Errata
+
+chainweb-data is not necessarily able to represent on-chain data in their full fidelity because of representation issues.
+Notably:
+  - null bytes in JSON values cannot be represented in the JSON type in Postgres
+  (https://www.commandprompt.com/blog/null-characters-workarounds-arent-good-enough/).
+  chainweb-data replaces them with the <NUL> escape sequence.

cabal.project

@@ -1,6 +1,4 @@
 packages: haskell-src/chainweb-data.cabal
-with-compiler: ghc-9.6.3
-index-state: 2024-02-01T00:00:00Z
 
 source-repository-package
     type: git
@@ -13,7 +11,7 @@ package vault
 
 write-ghc-environment-files: never
 
-constraints: http2 <4.2
+-- constraints: http2 <4.2
 
 allow-newer: beam-migrate:pqueue
 allow-newer: beam-migrate:aeson

haskell-src/chainweb-data.cabal

@@ -72,6 +72,7 @@ library
     ChainwebDb.Types.Event
     ChainwebDb.Types.MinerKey
     ChainwebDb.Types.Signer
+    ChainwebDb.Types.PgText
     ChainwebDb.Types.Transaction
     ChainwebDb.Types.Transfer
   build-depends:

haskell-src/exec/Chainweb/BackfillTransfers.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -19,6 +18,7 @@ import           ChainwebData.Env
 import           ChainwebData.Types
 import           ChainwebDb.Types.Event
 import           ChainwebDb.Types.Transfer
+import           ChainwebDb.Types.PgText
 
 import           Control.Concurrent.Async (race_)
 import           Control.Lens hiding ((<.), reuse)
@@ -109,8 +109,8 @@ createTransfer ev = do
         <*> pure (_ev_idx ev)
         <*> pure (_ev_module ev)
         <*> pure (_ev_moduleHash ev)
-        <*> from_acct
-        <*> to_acct
+        <*> (PgText <$> from_acct)
+        <*> (PgText <$> to_acct)
         <*> getAmount (unwrap $ _ev_params ev)
   where
     from_acct = _ev_params ev ^? to unwrap . ix 0 . _String

haskell-src/exec/Chainweb/Gaps.hs

@@ -62,7 +62,7 @@ gapsCut env args cutBS = do
             total = sum $ fmap (sum . map (bool 0 1 . isGap)) gapsByChain :: Int
             totalNumBlocks = fromIntegral $ sum $ fmap (sum . map gapSize) gapsByChain
         logg Info $ fromString $ printf "Filling %d gaps and %d blocks" total totalNumBlocks
-        logg Debug $ fromString $ printf "Gaps to fill %s" (show gapsByChain)
+        logg Debug $ fromString $ printf "Gaps to fill %s" (show $ length gapsByChain)
         let doChain (cid, gs) = do
               let ranges = concatMap (createRanges cid) gs
               mapM_ (f logg count cid) ranges

haskell-src/exec/Chainweb/Lookups.hs

@@ -1,10 +1,6 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Chainweb.Lookups
   ( -- * Endpoints
@@ -46,6 +42,7 @@ import           ChainwebDb.Types.Block
 import           ChainwebDb.Types.Common
 import           ChainwebDb.Types.DbHash
 import           ChainwebDb.Types.Event
+import           ChainwebDb.Types.PgText
 import           ChainwebDb.Types.Signer
 import           ChainwebDb.Types.Transaction
 import           ChainwebDb.Types.Transfer
@@ -192,9 +189,7 @@ mkBlockTransactions b pl = map (mkTransaction b) $ _blockPayloadWithOutputs_tran
 -- The blockhash is the hash of the current block. A Coinbase transaction's
 -- request key is expected to the parent hash of the block it is found in.
 -- However, the source key of the event in chainweb-data database instance is
--- the current block hash and NOT the parent hash However, the source key of the
--- event in chainweb-data database instance is the current block hash and NOT
--- the parent hash.
+-- the current block hash and NOT the parent hash.
 mkBlockEvents' :: Int64 -> ChainId -> DbHash BlockHash -> BlockPayloadWithOutputs -> ([Event], [(DbHash TxHash, [Event])])
 mkBlockEvents' height cid blockhash pl =
     (mkCoinbaseEvents height cid blockhash pl, map mkPair tos)
@@ -238,8 +233,8 @@ mkTransferRows height cid@(ChainId cid') blockhash _creationTime pl eventMinHeig
         , _tr_idx = _ev_idx ev
         , _tr_modulename = _ev_module ev
         , _tr_moduleHash = _ev_moduleHash ev
-        , _tr_from_acct = fromAccount
-        , _tr_to_acct = toAccount
+        , _tr_from_acct = PgText fromAccount
+        , _tr_to_acct = PgText toAccount
         , _tr_amount = amount
         }
     getAmount :: [Value] -> Maybe KDAScientific
@@ -259,7 +254,7 @@ mkTransferRows height cid@(ChainId cid') blockhash _creationTime pl eventMinHeig
     createNonCoinBaseTransfers xs = [ transfer
       | (txhash,_,evs) <- xs
       , ev <- evs
-      , T.takeEnd 8 (_ev_qualName ev) == "TRANSFER"
+      , T.takeEnd 8 (unPgText $ _ev_qualName ev) == "TRANSFER"
       , length (unwrap (_ev_params ev)) == 3
       , transfer <- maybeToList $ mkTransfer (Just txhash) ev
       ]
@@ -290,6 +285,14 @@ mkCoinbaseEvents height cid blockhash pl = _blockPayloadWithOutputs_coinbase pl
 bpwoMinerKeys :: BlockPayloadWithOutputs -> [T.Text]
 bpwoMinerKeys = _minerData_publicKeys . _blockPayloadWithOutputs_minerData
 
+-- Remove null characters and replace them with <NUL>, because Postgres does not
+-- support null characters in JSON and will throw an error on insertion of such
+-- values.
+censorJSON :: Value -> PgJSONB Value
+censorJSON = PgJSONB . transform (over _String censorNulls)
+  where
+  censorNulls = T.replace "\0" "<NUL>"
+
 mkTransaction :: Block -> (CW.Transaction, TransactionOutput) -> Transaction
 mkTransaction b (tx,txo) = Transaction
   { _tx_requestKey = DbHash $ hashB64U $ CW._transaction_hash tx
@@ -306,16 +309,17 @@ mkTransaction b (tx,txo) = Transaction
   , _tx_pactId = DbHash . _cont_pactId <$> cnt
   , _tx_rollback = _cont_rollback <$> cnt
   , _tx_step = fromIntegral . _cont_step <$> cnt
-  , _tx_data = (PgJSONB . _cont_data <$> cnt)
-    <|> (PgJSONB <$> (exc >>= _exec_data))
+  , _tx_data = censorJSON <$>
+      ((_cont_data <$> cnt)
+      <|> (exc >>= _exec_data))
   , _tx_proof = join (_cont_proof <$> cnt)
 
   , _tx_gas = fromIntegral $ _toutGas txo
   , _tx_badResult = badres
   , _tx_goodResult = goodres
   , _tx_logs = hashB64U <$> _toutLogs txo
-  , _tx_metadata = PgJSONB <$> _toutMetaData txo
-  , _tx_continuation = PgJSONB <$> _toutContinuation txo
+  , _tx_metadata = censorJSON <$> _toutMetaData txo
+  , _tx_continuation = censorJSON <$> _toutContinuation txo
   , _tx_txid = fromIntegral <$> _toutTxId txo
   , _tx_numEvents = Just $ fromIntegral $ length $ _toutEvents txo
   }
@@ -330,8 +334,8 @@ mkTransaction b (tx,txo) = Transaction
       ExecPayload _ -> Nothing
       ContPayload c -> Just c
     (badres, goodres) = case _toutResult txo of
-      PactResult (Left v) -> (Just $ PgJSONB v, Nothing)
-      PactResult (Right v) -> (Nothing, Just $ PgJSONB v)
+      PactResult (Left v) -> (Just $ censorJSON v, Nothing)
+      PactResult (Right v) -> (Nothing, Just $ censorJSON v)
 
 mkTxEvents :: Int64 -> ChainId -> DbHash BlockHash -> (CW.Transaction,TransactionOutput) -> [Event]
 mkTxEvents height cid blk (tx,txo) = zipWith (mkEvent cid height blk (Just rk)) (_toutEvents txo) [0..]
@@ -346,11 +350,11 @@ mkEvent (ChainId chainid) height block requestkey ev idx = Event
     , _ev_chainid = fromIntegral chainid
     , _ev_height = height
     , _ev_idx = idx
-    , _ev_name = ename ev
-    , _ev_qualName = qname ev
-    , _ev_module = emodule ev
-    , _ev_moduleHash = emoduleHash ev
-    , _ev_paramText = T.decodeUtf8 $ toStrict $ encode $ params ev
+    , _ev_name = PgText $ ename ev
+    , _ev_qualName = PgText $ qname ev
+    , _ev_module = PgText $ emodule ev
+    , _ev_moduleHash = PgText $ emoduleHash ev
+    , _ev_paramText = PgText $ T.decodeUtf8 $ toStrict $ encode $ params ev
     , _ev_params = PgJSONB $ toList $ params ev
     }
   where

haskell-src/exec/Chainweb/Server.hs

@@ -81,6 +81,7 @@ import           ChainwebData.TxSummary
 import           ChainwebDb.Types.Block
 import           ChainwebDb.Types.Common
 import           ChainwebDb.Types.DbHash
+import           ChainwebDb.Types.PgText
 import           ChainwebDb.Types.Signer
 import           ChainwebDb.Types.Transfer
 import           ChainwebDb.Types.Transaction
@@ -391,7 +392,7 @@ toApiTxDetail tx contHist blk evs signers sigs = TxDetail
   where
     unMaybeValue = maybe Null unPgJsonb
     toTxEvent ev =
-      TxEvent (_ev_qualName ev) (unPgJsonb $ _ev_params ev)
+      TxEvent (unPgText $ _ev_qualName ev) (unPgJsonb $ _ev_params ev)
 
 getMaxBlockHeight :: LogFunctionIO Text -> Connection -> IO (Maybe BlockHeight)
 getMaxBlockHeight logger c =
@@ -511,10 +512,10 @@ accountHandler logger pool req account token chain minheight maxheight limit mbO
   continuation <- mkContinuation readEventToken mbOffset mbNext
   isBounded <- isBoundedStrategyM req
   let searchParams = TransferSearchParams
-       { tspToken = usedCoinType
+       { tspToken = PgText usedCoinType
        , tspChainId = chain
        , tspHeightRange = HeightRangeParams minheight maxheight
-       , tspAccount = account
+       , tspAccount = PgText account
        }
   liftIO $ M.with pool $ \(c, throttling) -> do
     let
@@ -531,15 +532,15 @@ accountHandler logger pool req account token chain minheight maxheight limit mbO
         continuation
         resultLimit
       return $ maybe noHeader (addHeader . mkEventToken) mbCont  $ results <&> \(tr, extras) -> TransferDetail
-        { _trDetail_token = _tr_modulename tr
+        { _trDetail_token = unPgText $ _tr_modulename tr
         , _trDetail_chain = fromIntegral $ _tr_chainid tr
         , _trDetail_height = fromIntegral $ _tr_height tr
         , _trDetail_blockHash = unDbHash $ unBlockId $ _tr_block tr
         , _trDetail_requestKey = getTxHash $ _tr_requestkey tr
         , _trDetail_idx = fromIntegral $ _tr_idx tr
         , _trDetail_amount = StringEncoded $ getKDAScientific $ _tr_amount tr
-        , _trDetail_fromAccount = _tr_from_acct tr
-        , _trDetail_toAccount = _tr_to_acct tr
+        , _trDetail_fromAccount = unPgText $ _tr_from_acct tr
+        , _trDetail_toAccount = unPgText $ _tr_to_acct tr
         , _trDetail_crossChainAccount = tseXChainAccount extras
         , _trDetail_crossChainId = fromIntegral <$> tseXChainId extras
         , _trDetail_blockTime = tseBlockTime extras
@@ -607,9 +608,9 @@ evHandler logger pool req limit mbOffset qSearch qParam qName qModuleName minhei
         resultLimit
       return $ maybe noHeader (addHeader . mkEventToken) mbCont $
         results <&> \(ev,extras) -> EventDetail
-          { _evDetail_name = _ev_qualName ev
+          { _evDetail_name = unPgText $ _ev_qualName ev
           , _evDetail_params = unPgJsonb $ _ev_params ev
-          , _evDetail_moduleHash = _ev_moduleHash ev
+          , _evDetail_moduleHash = unPgText $ _ev_moduleHash ev
           , _evDetail_chain = fromIntegral $ _ev_chainid ev
           , _evDetail_height = fromIntegral $ _ev_height ev
           , _evDetail_blockTime = eseBlockTime extras

haskell-src/lib/ChainwebDb/Queries.hs

@@ -40,6 +40,7 @@ import           ChainwebDb.Database
 import           ChainwebDb.Types.Block
 import           ChainwebDb.Types.DbHash
 import           ChainwebDb.Types.Event
+import           ChainwebDb.Types.PgText
 import           ChainwebDb.Types.Transaction
 import           ChainwebDb.Types.Transfer
 import ChainwebDb.Types.Common (ReqKeyOrCoinbase)
@@ -177,14 +178,14 @@ eventSearchCond EventSearchParams{..} ev = and_ $
   where
     searchString search = "%" <> search <> "%"
     searchCond = fromMaybeArg espSearch $ \s ->
-      (_ev_qualName ev `like_` val_ (searchString s)) ||.
-      (_ev_paramText ev `like_` val_ (searchString s))
+      (_ev_qualName ev `like_` val_ (searchString $ PgText s)) ||.
+      (_ev_paramText ev `like_` val_ (searchString $ PgText s))
     qualNameCond = fromMaybeArg espName $ \(EventName n) ->
-      _ev_qualName ev `like_` val_ (searchString n)
+      _ev_qualName ev `like_` val_ (searchString $ PgText n)
     paramCond = fromMaybeArg espParam $ \(EventParam p) ->
-      _ev_paramText ev `like_` val_ (searchString p)
+      _ev_paramText ev `like_` val_ (searchString $ PgText p)
     moduleCond = fromMaybeArg espModuleName $ \(EventModuleName m) ->
-      _ev_module ev ==. val_ m
+      _ev_module ev ==. val_ (PgText m)
     fromMaybeArg mbA f = f <$> maybeToList mbA
 
 data EventCursorT f = EventCursor
@@ -242,10 +243,10 @@ toAccountsSearchCursor Transfer{..} = EventCursor
   (asc _tr_idx)
 
 data TransferSearchParams = TransferSearchParams
-  { tspToken :: Text
+  { tspToken :: PgText
   , tspChainId :: Maybe ChainId
   , tspHeightRange :: HeightRangeParams
-  , tspAccount :: Text
+  , tspAccount :: PgText
   }
 
 transfersSearchSource ::

haskell-src/lib/ChainwebDb/Types/Event.hs

@@ -3,9 +3,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ImpredicativeTypes #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -18,12 +16,12 @@ module ChainwebDb.Types.Event where
 ------------------------------------------------------------------------------
 import           Data.Aeson
 import           Data.Int
-import           Data.Text (Text)
 import           Database.Beam
 import           Database.Beam.Postgres
 ------------------------------------------------------------------------------
 import           ChainwebDb.Types.Block
 import           ChainwebDb.Types.Common
+import           ChainwebDb.Types.PgText
 ------------------------------------------------------------------------------
 
 data EventT f = Event
@@ -32,11 +30,11 @@ data EventT f = Event
   , _ev_chainid :: C f Int64
   , _ev_height :: C f Int64
   , _ev_idx :: C f Int64
-  , _ev_qualName :: C f Text
-  , _ev_name :: C f Text
-  , _ev_module :: C f Text
-  , _ev_moduleHash :: C f Text
-  , _ev_paramText :: C f Text
+  , _ev_qualName :: C f PgText
+  , _ev_name :: C f PgText
+  , _ev_module :: C f PgText
+  , _ev_moduleHash :: C f PgText
+  , _ev_paramText :: C f PgText
   , _ev_params :: C f (PgJSONB [Value])
   }
   deriving stock (Generic)