escape unicode null character in sql text values

Author: larskuhtz

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/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
@@ -238,8 +235,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 +256,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
       ]
@@ -346,11 +343,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)

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

@@ -18,7 +18,6 @@ module ChainwebDb.Types.Transfer where
 ----------------------------------------------------------------------------
 import BasePrelude
 import Data.Scientific
-import Data.Text (Text)
 import Database.Beam
 import Database.Beam.Backend.SQL.SQL92
 import Database.Beam.Postgres
@@ -28,17 +27,18 @@ import Database.PostgreSQL.Simple.FromField
 ------------------------------------------------------------------------------
 import ChainwebDb.Types.Block
 import ChainwebDb.Types.Common
+import ChainwebDb.Types.PgText
 ------------------------------------------------------------------------------
 data TransferT f = Transfer
   { _tr_block :: PrimaryKey BlockT f
   , _tr_requestkey :: C f ReqKeyOrCoinbase
   , _tr_chainid :: C f Int64
   , _tr_height :: C f Int64
   , _tr_idx :: C f Int64
-  , _tr_modulename :: C f Text
-  , _tr_moduleHash :: C f Text
-  , _tr_from_acct :: C f Text
-  , _tr_to_acct :: C f Text
+  , _tr_modulename :: C f PgText
+  , _tr_moduleHash :: C f PgText
+  , _tr_from_acct :: C f PgText
+  , _tr_to_acct :: C f PgText
   , _tr_amount :: C f KDAScientific
   }
   deriving stock (Generic)
@@ -48,7 +48,7 @@ type Transfer = TransferT Identity
 type TransferId = PrimaryKey TransferT Identity
 
 instance Table TransferT where
-  data PrimaryKey TransferT f = TransferId (PrimaryKey BlockT f) (C f ReqKeyOrCoinbase) (C f Int64) (C f Int64) (C f Text)
+  data PrimaryKey TransferT f = TransferId (PrimaryKey BlockT f) (C f ReqKeyOrCoinbase) (C f Int64) (C f Int64) (C f PgText)
     deriving stock (Generic)
     deriving anyclass (Beamable)
   primaryKey = TransferId <$> _tr_block <*> _tr_requestkey <*> _tr_chainid <*> _tr_idx <*> _tr_moduleHash