fix(#1713): fix inconsistent voting status

CHANGELOG.md

@@ -16,7 +16,7 @@ changes.
 
 ### Fixed
 
--
+- Fix inconsistent voting status [Issue 1713](https://github.com/IntersectMBO/govtool/issues/1713)
 
 ### Changed
 

govtool/backend/sql/get-network-metrics.sql

@@ -175,7 +175,7 @@ SELECT
     total_gov_action_proposals.count as total_gov_action_proposals,
     total_drep_votes.count as total_drep_votes,
     total_registered_dreps.unique_registrations as total_registered_dreps,
-    total_stake_controlled_by_dreps.total as total_stake_controlled_by_dreps,
+    COALESCE(total_stake_controlled_by_dreps.total, 0) as total_stake_controlled_by_dreps,
     total_active_dreps.unique_active_drep_registrations as total_active_dreps,
     total_inactive_dreps.total_inactive_dreps as total_inactive_dreps,
     total_active_cip119_compliant_dreps.unique_active_cip119_compliant_drep_registrations as total_active_cip119_compliant_dreps,

govtool/backend/sql/get-transaction-status.sql

@@ -1 +1,9 @@
-select exists (select * from tx where tx.hash = decode(?, 'hex'))
+SELECT 
+    EXISTS (SELECT 1 FROM tx WHERE tx.hash = decode(?, 'hex')) AS tx_exists,
+    COALESCE(
+        (SELECT json_agg(voting_procedure.*)
+            FROM voting_procedure
+            JOIN tx ON voting_procedure.tx_id = tx.id
+            WHERE tx.hash = decode(?, 'hex')
+        ), '[]'::json
+    ) AS voting_procedures;

govtool/backend/src/VVA/API.hs

@@ -13,7 +13,7 @@ import           Control.Exception        (throw, throwIO)
 import           Control.Monad.Except     (runExceptT, throwError)
 import           Control.Monad.Reader
 
-import           Data.Aeson               (Value(..), Array, decode, encode, FromJSON, ToJSON)
+import           Data.Aeson               (Value(..), Array, decode, encode, FromJSON, ToJSON, toJSON)
 import           Data.Bool                (Bool)
 import           Data.List                (sortOn)
 import qualified Data.Map                 as Map
@@ -416,11 +416,11 @@ getCurrentEpochParams = do
 
 getTransactionStatus :: App m => HexText -> m GetTransactionStatusResponse
 getTransactionStatus (unHexText -> transactionId) = do
-  x <- Transaction.getTransactionStatus transactionId
-  case x of
-    Types.TransactionConfirmed   -> return $ GetTransactionStatusResponse True
-    Types.TransactionUnconfirmed -> return $ GetTransactionStatusResponse False
-
+  status <- Transaction.getTransactionStatus transactionId
+  return $ GetTransactionStatusResponse $ case status of
+    Just value -> Just $ toJSON value
+    Nothing    -> Nothing
+    
 throw500 :: App m => m ()
 throw500 = throwError $ CriticalError "intentional system break for testing purposes"
 

govtool/backend/src/VVA/API/Types.hs

@@ -651,29 +651,26 @@ instance ToSchema GetProposalResponse where
             ?~ toJSON exampleGetProposalResponse
 
 newtype GetTransactionStatusResponse
-  = GetTransactionStatusResponse { getTransactionstatusResponseTransactionConfirmed :: Bool }
-  deriving (Generic, Show)
+  = GetTransactionStatusResponse { getTransactionStatusResponse :: Maybe Value }
+  deriving newtype (Show)
 
+instance FromJSON GetTransactionStatusResponse where
+  parseJSON = pure . GetTransactionStatusResponse . Just
 
-deriveJSON (jsonOptions "getTransactionstatusResponse") ''GetTransactionStatusResponse
+instance ToJSON GetTransactionStatusResponse where
+  toJSON (GetTransactionStatusResponse Nothing)       = Null
+  toJSON (GetTransactionStatusResponse (Just status)) = toJSON status
 
 exampleGetTransactionStatusResponse :: Text
-exampleGetTransactionStatusResponse = "{ \"transactionConfirmed\": True }"
+exampleGetTransactionStatusResponse =
+  "{ \"transactionConfirmed\": True, \"votingProcedure\": {\"vote\": \"yes\"}}"
 
 instance ToSchema GetTransactionStatusResponse where
-  declareNamedSchema proxy = do
-    NamedSchema name_ schema_ <-
-      genericDeclareNamedSchema
-        ( fromAesonOptions $
-            jsonOptions "getTransactionstatusResponse"
-        )
-        proxy
-    return $
-      NamedSchema name_ $
-        schema_
-          & description ?~ "GetTransactionStatus Response"
-          & example
-            ?~ toJSON exampleGetTransactionStatusResponse
+    declareNamedSchema _ = pure $ NamedSchema (Just "GetTransactionStatusResponse") $ mempty
+        & type_ ?~ OpenApiObject
+        & description ?~ "Transaction status encoded as JSON"
+        & example
+          ?~ toJSON exampleGetTransactionStatusResponse
 
 newtype DRepHash
   = DRepHash Text
@@ -923,4 +920,3 @@ instance ToSchema GetNetworkMetricsResponse where
         & description ?~ "GetNetworkMetricsResponse"
         & example
           ?~ toJSON exampleGetNetworkMetricsResponse
-

govtool/backend/src/VVA/Transaction.hs

@@ -15,6 +15,8 @@ import           Data.Has                   (Has)
 import           Data.String                (fromString)
 import           Data.Text                  (Text, pack, unpack)
 import qualified Data.Text.Encoding         as Text
+import qualified Data.Text.IO               as Text
+import           Data.Maybe                 (fromMaybe)
 
 import qualified Database.PostgreSQL.Simple as SQL
 
@@ -31,10 +33,10 @@ getTransactionStatusSql = sqlFrom $(embedFile "sql/get-transaction-status.sql")
 getTransactionStatus ::
   (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadError AppError m)
   => Text
-  -> m TransactionStatus
+  -> m (Maybe TransactionStatus)
 getTransactionStatus transactionId = withPool $ \conn -> do
-  result <- liftIO $ SQL.query conn getTransactionStatusSql (SQL.Only transactionId)
+  result <- liftIO $ SQL.query conn getTransactionStatusSql (transactionId, transactionId)
   case result of
-    [SQL.Only True] -> return TransactionConfirmed
-    [SQL.Only False] -> return TransactionUnconfirmed
-    x -> throwError $ CriticalError ("Expected exactly one result from get-transaction-status.sql but got " <> pack (show (length x)) <> " of them. This should never happen")
+    [(transactionConfirmed, votingProcedure)] -> do
+      return $ Just $ TransactionStatus transactionConfirmed votingProcedure
+    _ -> return Nothing

govtool/backend/src/VVA/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
@@ -14,7 +15,7 @@ import           Control.Monad.Fail         (MonadFail)
 import           Control.Monad.IO.Class     (MonadIO)
 import           Control.Monad.Reader       (MonadReader)
 
-import           Data.Aeson                 (Value)
+import           Data.Aeson                 (Value, ToJSON (..), object, (.=))
 import qualified Data.Cache                 as Cache
 import           Data.Has
 import           Data.Pool                  (Pool)
@@ -184,7 +185,20 @@ instance FromRow Proposal where
       <*> field
       <*> field
 
-data TransactionStatus = TransactionConfirmed | TransactionUnconfirmed
+data TransactionStatus = TransactionStatus
+  { transactionConfirmed         :: Bool
+  , votingProcedure :: Maybe Value
+  }
+
+instance FromRow TransactionStatus where
+  fromRow = TransactionStatus <$> field <*> field
+
+instance ToJSON TransactionStatus where
+  toJSON TransactionStatus {transactionConfirmed, votingProcedure} =
+    object
+      [ "transactionConfirmed" .= transactionConfirmed
+      , "votingProcedure" .= votingProcedure
+      ]
 
 data CacheEnv
   = CacheEnv