Persistent to Hasql

Author: Cmdv

cardano-db/cardano-db.cabal

@@ -80,6 +80,8 @@ library
                       , fast-logger
                       , filepath
                       , file-embed
+                      , hasql
+                      , hasql-transaction
                       , iohk-monitoring
                       , lifted-base
                       , memory

cardano-db/src/Cardano/Db/Operations/Insert.hs

@@ -151,6 +151,10 @@ import Database.Persist.Types (
   entityKey,
  )
 import Database.PostgreSQL.Simple (SqlError)
+import Hasql.Statement (Statement)
+import qualified Hasql.Transaction.Sessions as Transaction
+import qualified Hasql.Transaction as Transactio
+
 
 -- The original naive way of inserting rows into Postgres was:
 --
@@ -171,8 +175,25 @@ import Database.PostgreSQL.Simple (SqlError)
 insertAdaPots :: (MonadBaseControl IO m, MonadIO m) => AdaPots -> ReaderT SqlBackend m AdaPotsId
 insertAdaPots = insertUnchecked "AdaPots"
 
-insertBlock :: (MonadBaseControl IO m, MonadIO m) => Block -> ReaderT SqlBackend m BlockId
-insertBlock = insertUnchecked "Block"
+-- insertBlock :: (MonadBaseControl IO m, MonadIO m) => Block -> ReaderT SqlBackend m BlockId
+-- insertBlock = insertUnchecked "Block"
+
+insertBlock :: Block -> Session BlockId
+insertBlock block = Transaction.transaction Transaction.ReadCommitted Transaction.Write insertBlockTransaction
+
+insertBlockStatement :: Statement Block BlockId
+insertBlockStatement =
+  Statement
+    "INSERT INTO block (id, hash, slot_no, epoch_no) VALUES ($1, $2, $3, $4) RETURNING id"
+    blockEncoder
+    (BlockId <$> Decode.int64)
+
+insertBlockTransaction :: Block -> Transaction BlockId
+insertBlockTransaction block = do
+  result <- Transaction.statement block insertBlockStatement
+  case result of
+    Right blockId -> pure blockId
+    Left err -> liftIO $ throwIO (DbInsertException "Block" (fromString $ show err))
 
 insertCollateralTxIn :: (MonadBaseControl IO m, MonadIO m) => CollateralTxIn -> ReaderT SqlBackend m CollateralTxInId
 insertCollateralTxIn = insertUnchecked "CollateralTxIn"

cardano-db/src/Cardano/Db/Schema/BaseSchema.hs

@@ -30,8 +30,8 @@ import Cardano.Db.Types (
   readVoterRole,
   renderAnchorType,
   renderGovActionType,
-  renderScriptPurpose,
-  renderScriptType,
+  scriptPurposeFromText,
+  scriptPurposeToText,
   renderSyncState,
   renderVote,
   renderVoterRole,
@@ -109,13 +109,13 @@ instance PersistField SyncState where
     Left $ mconcat ["Failed to parse Haskell type SyncState: ", Text.pack (show x)]
 
 instance PersistField ScriptPurpose where
-  toPersistValue = PersistText . renderScriptPurpose
+  toPersistValue = PersistText . scriptPurposeFromText
   fromPersistValue (PersistLiteral bs) = Right $ readScriptPurpose (BS.unpack bs)
   fromPersistValue x =
     Left $ mconcat ["Failed to parse Haskell type ScriptPurpose: ", Text.pack (show x)]
 
 instance PersistField ScriptType where
-  toPersistValue = PersistText . renderScriptType
+  toPersistValue = PersistText . scriptPurposeToText
   fromPersistValue (PersistLiteral bs) = Right $ readScriptType (BS.unpack bs)
   fromPersistValue x =
     Left $ mconcat ["Failed to parse Haskell type ScriptType: ", Text.pack (show x)]