Skip to content

Commit

Permalink
PLT-8339: Fix SQL instances for ChainPoint and ChainTip (#224)
Browse files Browse the repository at this point in the history 
Signed-off-by: Ana Pantilie <[email protected]>
  • Loading branch information
@ana-pantilie
ana-pantilie authored Nov 1, 2023
1 parent 2421893 commit 1b6a439
Show file tree
Hide file tree
Showing 2 changed files with 156 additions and 8 deletions.
82 changes: 78 additions & 4 deletions legacy/marconi-chain-index-legacy/src/Marconi/ChainIndex/Legacy/Orphans.hs
View file
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
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

0 comments on commit 1b6a439

Please sign in to comment.