Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

PLT-8339: Fix SQL instances for ChainPoint and ChainTip #224

Merged
merged 9 commits into from
Nov 1, 2023
Merged

PLT-8339: Fix SQL instances for ChainPoint and ChainTip #224

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
d008199
Parse possible NULL values for ChainPoint
ana-pantilie Oct 31, 2023
911e79f
Throw UnexpectedNull when ChainPoint misses a field
ana-pantilie Oct 31, 2023
9e53254
Fix ToRow instances and fix FromRow ChainTip
ana-pantilie Oct 31, 2023
27e8b72
Merge remote-tracking branch 'origin/main' into PLT-8339-fix-chainpoi…
ana-pantilie Oct 31, 2023
2f62cc8
Fix instances in legacy code as well
ana-pantilie Oct 31, 2023
8184f8d
Retrigger CI
ana-pantilie Oct 31, 2023
7b353d5
Retrigger CI build
ana-pantilie Oct 31, 2023
8546899
Retrigger CI build
ana-pantilie Nov 1, 2023
ed97120
Merge branch 'main' into PLT-8339-fix-chainpoint-when-querying
zeme-wana Nov 1, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
82 changes: 78 additions & 4 deletions legacy/marconi-chain-index-legacy/src/Marconi/ChainIndex/Legacy/Orphans.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
82 changes: 78 additions & 4 deletions marconi-chain-index/src/Marconi/ChainIndex/Orphans.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down