From 1b6a43939246f17662bbd62920feeb7f710df8ce Mon Sep 17 00:00:00 2001 From: Ana Pantilie <45069775+ana-pantilie@users.noreply.github.com> Date: Wed, 1 Nov 2023 13:45:18 +0200 Subject: [PATCH] PLT-8339: Fix SQL instances for ChainPoint and ChainTip (#224) Signed-off-by: Ana Pantilie --- .../src/Marconi/ChainIndex/Legacy/Orphans.hs | 82 ++++++++++++++++++- .../src/Marconi/ChainIndex/Orphans.hs | 82 ++++++++++++++++++- 2 files changed, 156 insertions(+), 8 deletions(-) diff --git a/legacy/marconi-chain-index-legacy/src/Marconi/ChainIndex/Legacy/Orphans.hs b/legacy/marconi-chain-index-legacy/src/Marconi/ChainIndex/Legacy/Orphans.hs index f3c5cb2958..2c0a96ea65 100644 --- a/legacy/marconi-chain-index-legacy/src/Marconi/ChainIndex/Legacy/Orphans.hs +++ b/legacy/marconi-chain-index-legacy/src/Marconi/ChainIndex/Legacy/Orphans.hs @@ -12,6 +12,7 @@ import Cardano.Binary qualified as CBOR import Cardano.Ledger.Shelley.API qualified as Ledger import Codec.CBOR.Read qualified as CBOR import Codec.Serialise (Serialise (decode, encode)) +import Control.Exception (throw) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy (toStrict) @@ -42,10 +43,61 @@ instance Pretty C.ChainTip where pretty (C.ChainTip sn ha bn) = "ChainTip(" <> pretty sn <> "," <+> pretty ha <> "," <+> pretty bn <> ")" instance SQL.FromRow C.ChainTip where - fromRow = C.ChainTip <$> SQL.field <*> SQL.field <*> SQL.field + fromRow = do + mF1 <- SQL.field + mF2 <- SQL.field + mF3 <- SQL.field + case (mF1, mF2, mF3) of + (Just f1, Just f2, Just f3) -> + return $ C.ChainTip f1 f2 f3 + (Nothing, Nothing, Nothing) -> return C.ChainTipAtGenesis + -- There doesn't seem to be a way to return errors + -- in 'RowParser', so we have to throw exceptions here + (Nothing, Just _, Just _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLInteger" + , SQL.errMessage = "Unexpected NULL value in first field of C.ChainTip" + , SQL.errHaskellType = "C.SlotNo" + } + (Just _, Nothing, Just _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLBlob" + , SQL.errMessage = "Unexpected NULL value in second field of C.ChainTip" + , SQL.errHaskellType = "C.Hash C.BlockHeader" + } + (Just _, Just _, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLInteger" + , SQL.errMessage = "Unexpected NULL value in third field of C.ChainTip" + , SQL.errHaskellType = "C.BlockNo" + } + (Nothing, Nothing, _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "(SQLInteger, SQLBlob)" + , SQL.errMessage = "Unexpected NULL values in first and second fields of C.ChainTip" + , SQL.errHaskellType = "(C.SlotNo, C.Hash C.BlockHeader)" + } + (Nothing, _, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "(SQLInteger, SQLInteger)" + , SQL.errMessage = "Unexpected NULL values in first and third fields of C.ChainTip" + , SQL.errHaskellType = "(C.SlotNo, C.BlockNo)" + } + (_, Nothing, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "(SQLBlob, SQLInteger)" + , SQL.errMessage = "Unexpected NULL values in second and third fields of C.ChainTip" + , SQL.errHaskellType = "(C.Hash C.BlockHeader, C.BlockNo)" + } instance ToRow C.ChainTip where - toRow C.ChainTipAtGenesis = [SQL.SQLNull] + toRow C.ChainTipAtGenesis = [SQL.SQLNull, SQL.SQLNull] toRow (C.ChainTip sn bh bno) = [toField sn, toField bh, toField bno] instance Ord C.ChainTip where @@ -59,10 +111,32 @@ instance Pretty C.ChainPoint where pretty (C.ChainPoint sn ha) = "ChainPoint(" <> pretty sn <> "," <+> pretty ha <> ")" instance SQL.FromRow C.ChainPoint where - fromRow = C.ChainPoint <$> SQL.field <*> SQL.field + fromRow = do + mF1 <- SQL.field + mF2 <- SQL.field + case (mF1, mF2) of + (Just f1, Just f2) -> + return $ C.ChainPoint f1 f2 + (Nothing, Nothing) -> return C.ChainPointAtGenesis + -- There doesn't seem to be a way to return errors + -- in 'RowParser', so we have to throw exceptions here + (Nothing, _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLInteger" + , SQL.errMessage = "Unexpected NULL value in first field of C.ChainPoint" + , SQL.errHaskellType = "C.SlotNo" + } + (_, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLBlob" + , SQL.errMessage = "Unexpected NULL value in second field of C.ChainPoint" + , SQL.errHaskellType = "C.Hash C.BlockHeader" + } instance ToRow C.ChainPoint where - toRow C.ChainPointAtGenesis = [SQL.SQLNull] + toRow C.ChainPointAtGenesis = [SQL.SQLNull, SQL.SQLNull] toRow (C.ChainPoint sn bh) = [toField sn, toField bh] -- * C.Hash C.BlockHeader diff --git a/marconi-chain-index/src/Marconi/ChainIndex/Orphans.hs b/marconi-chain-index/src/Marconi/ChainIndex/Orphans.hs index 81c0de9fef..3884095b3f 100644 --- a/marconi-chain-index/src/Marconi/ChainIndex/Orphans.hs +++ b/marconi-chain-index/src/Marconi/ChainIndex/Orphans.hs @@ -12,6 +12,7 @@ import Cardano.Binary qualified as CBOR import Cardano.Ledger.Shelley.API qualified as Ledger import Codec.CBOR.Read qualified as CBOR import Codec.Serialise (Serialise (decode, encode)) +import Control.Exception (throw) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy (toStrict) @@ -42,10 +43,61 @@ instance Pretty C.ChainTip where pretty (C.ChainTip sn ha bn) = "ChainTip(" <> pretty sn <> "," <+> pretty ha <> "," <+> pretty bn <> ")" instance SQL.FromRow C.ChainTip where - fromRow = C.ChainTip <$> SQL.field <*> SQL.field <*> SQL.field + fromRow = do + mF1 <- SQL.field + mF2 <- SQL.field + mF3 <- SQL.field + case (mF1, mF2, mF3) of + (Just f1, Just f2, Just f3) -> + return $ C.ChainTip f1 f2 f3 + (Nothing, Nothing, Nothing) -> return C.ChainTipAtGenesis + -- There doesn't seem to be a way to return errors + -- in 'RowParser', so we have to throw exceptions here + (Nothing, Just _, Just _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLInteger" + , SQL.errMessage = "Unexpected NULL value in first field of C.ChainTip" + , SQL.errHaskellType = "C.SlotNo" + } + (Just _, Nothing, Just _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLBlob" + , SQL.errMessage = "Unexpected NULL value in second field of C.ChainTip" + , SQL.errHaskellType = "C.Hash C.BlockHeader" + } + (Just _, Just _, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLInteger" + , SQL.errMessage = "Unexpected NULL value in third field of C.ChainTip" + , SQL.errHaskellType = "C.BlockNo" + } + (Nothing, Nothing, _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "(SQLInteger, SQLBlob)" + , SQL.errMessage = "Unexpected NULL values in first and second fields of C.ChainTip" + , SQL.errHaskellType = "(C.SlotNo, C.Hash C.BlockHeader)" + } + (Nothing, _, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "(SQLInteger, SQLInteger)" + , SQL.errMessage = "Unexpected NULL values in first and third fields of C.ChainTip" + , SQL.errHaskellType = "(C.SlotNo, C.BlockNo)" + } + (_, Nothing, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "(SQLBlob, SQLInteger)" + , SQL.errMessage = "Unexpected NULL values in second and third fields of C.ChainTip" + , SQL.errHaskellType = "(C.Hash C.BlockHeader, C.BlockNo)" + } instance ToRow C.ChainTip where - toRow C.ChainTipAtGenesis = [SQL.SQLNull] + toRow C.ChainTipAtGenesis = [SQL.SQLNull, SQL.SQLNull] toRow (C.ChainTip sn bh bno) = [toField sn, toField bh, toField bno] instance Ord C.ChainTip where @@ -59,10 +111,32 @@ instance Pretty C.ChainPoint where pretty (C.ChainPoint sn ha) = "ChainPoint(" <> pretty sn <> "," <+> pretty ha <> ")" instance SQL.FromRow C.ChainPoint where - fromRow = C.ChainPoint <$> SQL.field <*> SQL.field + fromRow = do + mF1 <- SQL.field + mF2 <- SQL.field + case (mF1, mF2) of + (Just f1, Just f2) -> + return $ C.ChainPoint f1 f2 + (Nothing, Nothing) -> return C.ChainPointAtGenesis + -- There doesn't seem to be a way to return errors + -- in 'RowParser', so we have to throw exceptions here + (Nothing, _) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLInteger" + , SQL.errMessage = "Unexpected NULL value in first field of C.ChainPoint" + , SQL.errHaskellType = "C.SlotNo" + } + (_, Nothing) -> + throw + SQL.UnexpectedNull + { SQL.errSQLType = "SQLBlob" + , SQL.errMessage = "Unexpected NULL value in second field of C.ChainPoint" + , SQL.errHaskellType = "C.Hash C.BlockHeader" + } instance ToRow C.ChainPoint where - toRow C.ChainPointAtGenesis = [SQL.SQLNull] + toRow C.ChainPointAtGenesis = [SQL.SQLNull, SQL.SQLNull] toRow (C.ChainPoint sn bh) = [toField sn, toField bh] -- * C.Hash C.BlockHeader