From dbac5173f397ba638b53b3d7ea4061958604be0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Sza=C5=82owski?= Date: Tue, 4 Feb 2025 09:39:28 +0100 Subject: [PATCH] feat(#2724): move drep pagination directly into sql --- govtool/backend/app/Main.hs | 1 + govtool/backend/example-config.json | 18 +- govtool/backend/sql/list-dreps.sql | 84 ++++++--- govtool/backend/src/VVA/API.hs | 66 ++----- govtool/backend/src/VVA/API/Types.hs | 190 +------------------ govtool/backend/src/VVA/Common/Types.hs | 238 ++++++++++++++++++++++++ govtool/backend/src/VVA/DRep.hs | 176 ++++++++++++------ govtool/backend/src/VVA/Types.hs | 51 ++++- govtool/backend/vva-be.cabal | 2 + 9 files changed, 497 insertions(+), 329 deletions(-) create mode 100644 govtool/backend/src/VVA/Common/Types.hs diff --git a/govtool/backend/app/Main.hs b/govtool/backend/app/Main.hs index 6311288f0..06c32127b 100644 --- a/govtool/backend/app/Main.hs +++ b/govtool/backend/app/Main.hs @@ -144,6 +144,7 @@ startApp vvaConfig sentryService = do exceptionHandler :: VVAConfig -> SentryService -> Maybe Request -> SomeException -> IO () exceptionHandler vvaConfig sentryService mRequest exception = do + print exception let isNotTimeoutThread x = case fromException x of Just TimeoutThread -> False _ -> True diff --git a/govtool/backend/example-config.json b/govtool/backend/example-config.json index fe6a47420..0ad351abd 100644 --- a/govtool/backend/example-config.json +++ b/govtool/backend/example-config.json @@ -1,13 +1,13 @@ { - "dbsyncconfig" : { - "host" : "localhost", - "dbname" : "cexplorer", - "user" : "postgres", - "password" : "postgres", - "port" : 5432 - }, - "port" : 9999, - "host" : "localhost", + "dbsyncconfig": { + "host": "localhost", + "dbname": "cexplorer", + "user": "postgres", + "password": "postgres", + "port": 5432 + }, + "port": 9999, + "host": "localhost", "cachedurationseconds": 20, "sentrydsn": "https://username:password@senty.host/id", "sentryenv": "dev" diff --git a/govtool/backend/sql/list-dreps.sql b/govtool/backend/sql/list-dreps.sql index 0a6d92d1e..371cc7fa8 100644 --- a/govtool/backend/sql/list-dreps.sql +++ b/govtool/backend/sql/list-dreps.sql @@ -117,11 +117,8 @@ DRepData AS ( leva.metadata_hash, COALESCE(dr_deposit.deposit, 0) as deposit, DRepDistr.amount, - (DRepActivity.epoch_no - GREATEST(COALESCE(voting_procedure_block.epoch_no, block_first_register.epoch_no), lve.epoch_no, newestRegister.epoch_no)) <= DRepActivity.drep_activity AS active, RankedDRepRegistration.tx_hash, - newestRegister.time AS last_register_time, - COALESCE(RankedDRepRegistration.deposit, 0) as latest_deposit, - hndva.value AS has_non_deregister_voting_anchor, + newestRegister.time AT TIME ZONE 'UTC' AS last_register_time, fetch_error.message AS fetch_error, off_chain_vote_drep_data.payment_address, off_chain_vote_drep_data.given_name, @@ -129,7 +126,20 @@ DRepData AS ( off_chain_vote_drep_data.motivations, off_chain_vote_drep_data.qualifications, off_chain_vote_drep_data.image_url, - off_chain_vote_drep_data.image_hash + off_chain_vote_drep_data.image_hash, + -- drep type + CASE + WHEN COALESCE(RankedDRepRegistration.deposit, 0) >= 0 AND leva.url IS NULL THEN 'SoleVoter' + WHEN COALESCE(RankedDRepRegistration.deposit, 0) >= 0 AND leva.url IS NOT NULL THEN 'DRep' + WHEN COALESCE(RankedDRepRegistration.deposit, 0) < 0 AND hndva.value = true THEN 'SoleVoter' + WHEN COALESCE(RankedDRepRegistration.deposit, 0) < 0 AND hndva.value = false THEN 'DRep' + END AS drep_type, + -- status + CASE + WHEN COALESCE(RankedDRepRegistration.deposit, 0) < 0 THEN 'Retired' + WHEN COALESCE(RankedDRepRegistration.deposit, 0) >= 0 AND (DRepActivity.epoch_no - GREATEST(COALESCE(voting_procedure_block.epoch_no, block_first_register.epoch_no), lve.epoch_no, newestRegister.epoch_no)) <= DRepActivity.drep_activity THEN 'Active' + WHEN COALESCE(RankedDRepRegistration.deposit, 0) >= 0 AND NOT (DRepActivity.epoch_no - GREATEST(COALESCE(voting_procedure_block.epoch_no, block_first_register.epoch_no), lve.epoch_no, newestRegister.epoch_no)) <= DRepActivity.drep_activity THEN 'Inactive' + END AS status FROM drep_hash dh JOIN RankedDRepRegistration ON RankedDRepRegistration.drep_hash_id = dh.id AND RankedDRepRegistration.rn = 1 @@ -195,15 +205,8 @@ DRepData AS ( leva.metadata_hash, dr_deposit.deposit, DRepDistr.amount, - DRepActivity.epoch_no, - voting_procedure_block.epoch_no, - block_first_register.epoch_no, - lve.epoch_no, newestRegister.epoch_no, - DRepActivity.drep_activity, RankedDRepRegistration.tx_hash, newestRegister.time, - RankedDRepRegistration.deposit, - hndva.value, fetch_error.message, off_chain_vote_drep_data.payment_address, off_chain_vote_drep_data.given_name, @@ -211,17 +214,48 @@ DRepData AS ( off_chain_vote_drep_data.motivations, off_chain_vote_drep_data.qualifications, off_chain_vote_drep_data.image_url, - off_chain_vote_drep_data.image_hash -) -SELECT * FROM DRepData -WHERE + off_chain_vote_drep_data.image_hash, + RankedDRepRegistration.deposit, + hndva.value, + DRepActivity.epoch_no, + DRepActivity.drep_activity, + voting_procedure_block.epoch_no, + block_first_register.epoch_no, + lve.epoch_no, + newestRegister.epoch_no +), +FilteredDRepData AS ( + SELECT * FROM DRepData + WHERE ( - COALESCE(?, '') = '' OR - (CASE WHEN LENGTH(?) % 2 = 0 AND ? ~ '^[0-9a-fA-F]+$' THEN drep_hash = ? ELSE false END) OR - view ILIKE ? OR - given_name ILIKE ? OR - payment_address ILIKE ? OR - objectives ILIKE ? OR - motivations ILIKE ? OR - qualifications ILIKE ? - ) \ No newline at end of file + COALESCE(?, '') = '' + OR ( + CASE + WHEN LENGTH(?) % 2 = 0 AND ? ~ '^[0-9a-fA-F]+$' THEN drep_hash = ? + ELSE false + END + ) + OR ( + ? ILIKE ANY(ARRAY[view, given_name, payment_address, objectives, motivations, qualifications]) + ) + ) + AND (?::TEXT = '' OR status = ANY(?)) + AND (drep_type != 'SoleVoter' OR (COALESCE(?, '') <> '' AND view ILIKE ?)) +) +SELECT + (SELECT COUNT(*) FROM FilteredDRepData) AS total, + COALESCE(jsonb_agg(elements), '[]'::jsonb) AS elements +FROM ( + SELECT * + FROM FilteredDRepData + ORDER BY + CASE ? + WHEN 'VotingPower' THEN amount::TEXT + WHEN 'RegistrationDate' THEN last_register_time::TEXT + WHEN 'Status' THEN status::TEXT + ELSE NULL + END DESC, + CASE WHEN ? = 'Random' THEN RANDOM() END + LIMIT ? + OFFSET ? +) AS elements \ No newline at end of file diff --git a/govtool/backend/src/VVA/API.hs b/govtool/backend/src/VVA/API.hs index 89b37cc3c..df23513bc 100644 --- a/govtool/backend/src/VVA/API.hs +++ b/govtool/backend/src/VVA/API.hs @@ -43,6 +43,7 @@ import VVA.Network as Network import qualified VVA.Proposal as Proposal import qualified VVA.Transaction as Transaction import qualified VVA.Types as Types +import VVA.Common.Types import VVA.Types (App, AppEnv (..), AppError (CriticalError, InternalError, ValidationError), CacheEnv (..)) @@ -140,60 +141,25 @@ delegationToResponse Types.Delegation {..} = drepList :: App m => Maybe Text -> [DRepStatus] -> Maybe DRepSortMode -> Maybe Natural -> Maybe Natural -> m ListDRepsResponse drepList mSearchQuery statuses mSortMode mPage mPageSize = do CacheEnv {dRepListCache} <- asks vvaCache - dreps <- cacheRequest dRepListCache (fromMaybe "" mSearchQuery) (DRep.listDReps mSearchQuery) - - let filterDRepsByQuery = case mSearchQuery of - Nothing -> filter $ \Types.DRepRegistration {..} -> - dRepRegistrationType /= Types.SoleVoter - Just query -> filter $ \Types.DRepRegistration {..} -> - let searchLower = Text.toLower query - viewLower = Text.toLower dRepRegistrationView - hashLower = Text.toLower dRepRegistrationDRepHash - in case dRepRegistrationType of - Types.SoleVoter -> - searchLower == viewLower || searchLower == hashLower - Types.DRep -> - True - - - let filterDRepsByStatus = case statuses of - [] -> id - _ -> filter $ \Types.DRepRegistration {..} -> - mapDRepStatus dRepRegistrationStatus `elem` statuses - - randomizedOrderList <- mapM (\_ -> randomRIO (0, 1 :: Double)) dreps - - let sortDReps = case mSortMode of - Nothing -> id - Just Random -> fmap snd . sortOn fst . Prelude.zip randomizedOrderList - Just VotingPower -> sortOn $ \Types.DRepRegistration {..} -> - Down dRepRegistrationVotingPower - Just RegistrationDate -> sortOn $ \Types.DRepRegistration {..} -> - Down dRepRegistrationLatestRegistrationDate - Just Status -> sortOn $ \Types.DRepRegistration {..} -> - dRepRegistrationStatus - - appEnv <- ask - - allValidDReps <- liftIO $ mapConcurrently - (\d@Types.DRepRegistration{..} -> do - let drep = drepRegistrationToDrep d - return drep) - $ sortDReps $ filterDRepsByQuery $ filterDRepsByStatus dreps - let page = (fromIntegral $ fromMaybe 0 mPage) :: Int - pageSize = (fromIntegral $ fromMaybe 10 mPageSize) :: Int + let page = fromMaybe 0 mPage + let pageSize = fromMaybe 10 mPageSize + let offset = page * pageSize + let sortMode = fromMaybe VotingPower mSortMode - total = length allValidDReps :: Int + let cacheKey = pack (show (mSearchQuery, statuses, sortMode, page, pageSize)) - let elements = take pageSize $ drop (page * pageSize) allValidDReps - return $ ListDRepsResponse - { listDRepsResponsePage = fromIntegral page - , listDRepsResponsePageSize = fromIntegral pageSize - , listDRepsResponseTotal = fromIntegral total - , listDRepsResponseElements = elements - } + cachedDReps <- cacheRequest dRepListCache cacheKey $ + fmap listDRepsResponseElements $ + DRep.listDReps mSearchQuery statuses (Just sortMode) (fromIntegral pageSize) (fromIntegral offset) + let response = ListDRepsResponse + { listDRepsResponsePage = fromIntegral page + , listDRepsResponsePageSize = fromIntegral pageSize + , listDRepsResponseTotal = fromIntegral (length cachedDReps) + , listDRepsResponseElements = cachedDReps + } + return response getVotingPower :: App m => HexText -> m Integer getVotingPower (unHexText -> dRepId) = do diff --git a/govtool/backend/src/VVA/API/Types.hs b/govtool/backend/src/VVA/API/Types.hs index 2181bd676..26bdcb83e 100644 --- a/govtool/backend/src/VVA/API/Types.hs +++ b/govtool/backend/src/VVA/API/Types.hs @@ -54,40 +54,7 @@ import VVA.API.Utils import VVA.Config import qualified VVA.Proposal as Proposal import VVA.Types (AppError (ValidationError)) - -newtype HexText - = HexText { unHexText :: Text } - deriving newtype (Eq, Show) - -instance FromJSON HexText where - parseJSON (Aeson.String t) = do - if Text.length t `mod` 2 == 1 || Text.any (not . isHexDigit) t - then mzero - else pure $ HexText t - -instance ToJSON HexText where - toJSON (HexText t) = Aeson.String t - --- To use it in routes, we need to be able to parse it from Text: -instance FromHttpApiData HexText where - parseUrlPiece txt - | Text.all isHexDigit txt && even (Text.length txt) = Right (HexText txt) - | otherwise = Left "Not a valid hex value" - - -instance ToParamSchema HexText where - toParamSchema _ = mempty - & type_ ?~ OpenApiString - & format ?~ "hex" - -instance ToSchema HexText where - declareNamedSchema _ = do - textSchema <- declareNamedSchema (Proxy :: Proxy Text) - return $ textSchema - & name ?~ "HexText" - & schema . type_ ?~ OpenApiString - & schema . format ?~ "hex" - & schema . example ?~ toJSON (HexText "a1b2c3") +import VVA.Common.Types newtype AnyValue = AnyValue { unAnyValue :: Maybe Value } @@ -204,37 +171,6 @@ instance ToParamSchema GovernanceActionType where & type_ ?~ OpenApiString & enum_ ?~ map toJSON (enumFromTo minBound maxBound :: [GovernanceActionType]) - -data DRepSortMode = Random | VotingPower | RegistrationDate | Status deriving (Bounded, Enum, Eq, Generic, Read, Show) - -instance FromJSON DRepSortMode where - parseJSON (Aeson.String dRepSortMode) = pure $ fromJust $ readMaybe (Text.unpack dRepSortMode) - parseJSON _ = fail "" - -instance ToJSON DRepSortMode where - toJSON x = Aeson.String $ Text.pack $ show x - -instance ToSchema DRepSortMode where - declareNamedSchema proxy = do - NamedSchema name_ schema_ <- genericDeclareNamedSchema (fromAesonOptions defaultOptions) proxy - return $ - NamedSchema name_ $ - schema_ - & description ?~ "DRep Sort Mode" - & example ?~ toJSON VotingPower - -instance FromHttpApiData DRepSortMode where - parseQueryParam t = case readMaybe $ Text.unpack t of - Just x -> Right x - Nothing -> Left ("incorrect DRep sort mode: " <> t) - -instance ToParamSchema DRepSortMode where - toParamSchema _ = - mempty - & type_ ?~ OpenApiString - & enum_ ?~ map toJSON (enumFromTo minBound maxBound :: [DRepSortMode]) - - data GovernanceActionSortMode = SoonestToExpire | NewestCreated | MostYesVotes deriving ( Bounded , Enum @@ -673,115 +609,6 @@ instance ToSchema GetTransactionStatusResponse where & example ?~ toJSON exampleGetTransactionStatusResponse -newtype DRepHash - = DRepHash Text - deriving (Generic, Show) - -instance FromJSON DRepHash where - parseJSON (Aeson.String s) = pure $ DRepHash s - parseJSON x = fail ("expected DRepHash to be a string but got: " <> Char8.unpack (encode x)) - -instance ToJSON DRepHash where - toJSON (DRepHash raw) = toJSON raw - - -exampleDrepHash :: Text -exampleDrepHash = "b4e4184bfedf920fec53cdc327de4da661ae427784c0ccca9e3c2f50" - -instance ToSchema DRepHash where - declareNamedSchema _ = pure $ NamedSchema (Just "DRepHash") $ mempty - & type_ ?~ OpenApiObject - & description ?~ "Hash of a DRep" - & example - ?~ toJSON exampleDrepHash - - -data DRepStatus = Active | Inactive | Retired deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show) - --- ToJSON instance for DRepStatus -instance ToJSON DRepStatus where - toJSON Retired = "Retired" - toJSON Active = "Active" - toJSON Inactive = "Inactive" - --- FromJSON instance for DRepStatus -instance FromJSON DRepStatus where - parseJSON = withText "DRepStatus" $ \case - "Retired" -> pure Retired - "Active" -> pure Active - "Inactive" -> pure Inactive - _ -> fail "Invalid DRepStatus" - --- ToSchema instance for DRepStatus -instance ToSchema DRepStatus where - declareNamedSchema _ = pure $ NamedSchema (Just "DRepStatus") $ mempty - & type_ ?~ OpenApiString - & description ?~ "DRep Status" - & enum_ ?~ map toJSON [Retired, Active, Inactive] - -instance FromHttpApiData DRepStatus where - parseQueryParam t = case readMaybe $ Text.unpack t of - Just x -> Right x - Nothing -> Left ("incorrect DRep status " <> t) - -instance ToParamSchema DRepStatus where - toParamSchema _ = - mempty - & type_ ?~ OpenApiString - & enum_ ?~ map toJSON (enumFromTo minBound maxBound :: [DRepStatus]) - -data DRepType = NormalDRep | SoleVoter - -instance Show DRepType where - show NormalDRep = "DRep" - show SoleVoter = "SoleVoter" - --- ToJSON instance for DRepType -instance ToJSON DRepType where - toJSON NormalDRep = "DRep" - toJSON SoleVoter = "SoleVoter" - --- FromJSON instance for DRepType -instance FromJSON DRepType where - parseJSON = withText "DRepType" $ \case - "DRep" -> pure NormalDRep - "SoleVoter" -> pure SoleVoter - _ -> fail "Invalid DRepType" - --- ToSchema instance for DRepType -instance ToSchema DRepType where - declareNamedSchema _ = pure $ NamedSchema (Just "DRepType") $ mempty - & type_ ?~ OpenApiString - & description ?~ "DRep Type" - & enum_ ?~ map toJSON [NormalDRep, SoleVoter] - -data DRep - = DRep - { dRepIsScriptBased :: Bool - , dRepDrepId :: DRepHash - , dRepView :: Text - , dRepUrl :: Maybe Text - , dRepMetadataHash :: Maybe Text - , dRepDeposit :: Integer - , dRepVotingPower :: Maybe Integer - , dRepStatus :: DRepStatus - , dRepType :: DRepType - , dRepLatestTxHash :: Maybe HexText - , dRepLatestRegistrationDate :: UTCTime - , dRepMetadataError :: Maybe Text - , dRepPaymentAddress :: Maybe Text - , dRepGivenName :: Maybe Text - , dRepObjectives :: Maybe Text - , dRepMotivations :: Maybe Text - , dRepQualifications :: Maybe Text - , dRepImageUrl :: Maybe Text - , dRepImageHash :: Maybe HexText - } - deriving (Generic, Show) - - -deriveJSON (jsonOptions "dRep") ''DRep - exampleDrep :: Text exampleDrep = "{\"drepId\": \"d3a62ffe9c214e1a6a9809f7ab2a104c117f85e1f171f8f839d94be5\"," @@ -803,21 +630,6 @@ exampleDrep = <> "\"imageUrl\": \"https://image.url\"," <> "\"imageHash\": \"9198b1b204273ba5c67a13310b5a806034160f6a063768297e161d9b759cad61\"}" --- ToSchema instance for DRep -instance ToSchema DRep where - declareNamedSchema proxy = do - NamedSchema name_ schema_ <- - genericDeclareNamedSchema - ( fromAesonOptions $ jsonOptions "dRep" ) - proxy - return $ - NamedSchema name_ $ - schema_ - & description ?~ "DRep" - & example - ?~ toJSON exampleDrep - - exampleListDRepsResponse :: Text exampleListDRepsResponse = "{ \"page\": 0," diff --git a/govtool/backend/src/VVA/Common/Types.hs b/govtool/backend/src/VVA/Common/Types.hs new file mode 100644 index 000000000..93c6d41c6 --- /dev/null +++ b/govtool/backend/src/VVA/Common/Types.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + + +module VVA.Common.Types where + +import Control.Exception (throw) +import Control.Lens ((.~), (?~)) +import Control.Monad (guard) +import Control.Monad.Except +import Control.Monad.Reader + +import Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as Aeson (toList) +import Data.Aeson.TH (deriveJSON) +import qualified Data.ByteString.Lazy.Char8 as Char8 +import qualified Data.Cache as Cache +import Data.Char (isHexDigit) +import Data.Function ((&)) +import Data.Has (Has, getter, modifier) +import Data.Hashable (Hashable) +import Data.Maybe (fromJust, fromMaybe) +import Data.OpenApi hiding (Info) +import Data.Pool (Pool) +import Data.Proxy (Proxy (Proxy)) +import Data.Swagger.Internal (SwaggerType (SwaggerString)) +import Data.Text hiding (map) +import qualified Data.Text as Text +import qualified Data.Text.Lazy.Encoding as Text +import Data.Time + +import Database.PostgreSQL.Simple (Connection) + +import GHC.Exts (toList) +import GHC.Generics + +import Servant.API (FromHttpApiData, parseQueryParam, parseUrlPiece) + +import Text.Read (readMaybe) + +import VVA.API.Utils +import VVA.API.Utils + + +newtype HexText + = HexText { unHexText :: Text } + deriving newtype (Eq, Show) + +instance FromJSON HexText where + parseJSON (Aeson.String t) = do + if Text.length t `mod` 2 == 1 || Text.any (not . isHexDigit) t + then mzero + else pure $ HexText t + +instance ToJSON HexText where + toJSON (HexText t) = Aeson.String t + +-- To use it in routes, we need to be able to parse it from Text: +instance FromHttpApiData HexText where + parseUrlPiece txt + | Text.all isHexDigit txt && even (Text.length txt) = Right (HexText txt) + | otherwise = Left "Not a valid hex value" + + +instance ToParamSchema HexText where + toParamSchema _ = mempty + & type_ ?~ OpenApiString + & format ?~ "hex" + +instance ToSchema HexText where + declareNamedSchema _ = do + textSchema <- declareNamedSchema (Proxy :: Proxy Text) + return $ textSchema + & name ?~ "HexText" + & schema . type_ ?~ OpenApiString + & schema . format ?~ "hex" + & schema . example ?~ toJSON (HexText "a1b2c3") + +newtype DRepHash + = DRepHash Text + deriving (Generic, Show) + +instance FromJSON DRepHash where + parseJSON (Aeson.String s) = pure $ DRepHash s + parseJSON x = fail ("expected DRepHash to be a string but got: " <> Char8.unpack (encode x)) + +instance ToJSON DRepHash where + toJSON (DRepHash raw) = toJSON raw + +exampleDrepHash :: Text +exampleDrepHash = "b4e4184bfedf920fec53cdc327de4da661ae427784c0ccca9e3c2f50" + +instance ToSchema DRepHash where + declareNamedSchema _ = pure $ NamedSchema (Just "DRepHash") $ mempty + & type_ ?~ OpenApiObject + & description ?~ "Hash of a DRep" + & example + ?~ toJSON exampleDrepHash + +data DRepStatus = Active | Inactive | Retired deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show) + +-- ToJSON instance for DRepStatus +instance ToJSON DRepStatus where + toJSON Retired = "Retired" + toJSON Active = "Active" + toJSON Inactive = "Inactive" + +-- FromJSON instance for DRepStatus +instance FromJSON DRepStatus where + parseJSON = withText "DRepStatus" $ \case + "Retired" -> pure Retired + "Active" -> pure Active + "Inactive" -> pure Inactive + _ -> fail "Invalid DRepStatus" + +-- ToSchema instance for DRepStatus +instance ToSchema DRepStatus where + declareNamedSchema _ = pure $ NamedSchema (Just "DRepStatus") $ mempty + & type_ ?~ OpenApiString + & description ?~ "DRep Status" + & enum_ ?~ map toJSON [Retired, Active, Inactive] + +instance FromHttpApiData DRepStatus where + parseQueryParam t = case readMaybe $ Text.unpack t of + Just x -> Right x + Nothing -> Left ("incorrect DRep status " <> t) + +instance ToParamSchema DRepStatus where + toParamSchema _ = + mempty + & type_ ?~ OpenApiString + & enum_ ?~ map toJSON (enumFromTo minBound maxBound :: [DRepStatus]) + +data DRepType = NormalDRep | SoleVoter + +instance Show DRepType where + show NormalDRep = "DRep" + show SoleVoter = "SoleVoter" + +-- ToJSON instance for DRepType +instance ToJSON DRepType where + toJSON NormalDRep = "DRep" + toJSON SoleVoter = "SoleVoter" + +-- FromJSON instance for DRepType +instance FromJSON DRepType where + parseJSON = withText "DRepType" $ \case + "DRep" -> pure NormalDRep + "SoleVoter" -> pure SoleVoter + _ -> fail "Invalid DRepType" + +-- ToSchema instance for DRepType +instance ToSchema DRepType where + declareNamedSchema _ = pure $ NamedSchema (Just "DRepType") $ mempty + & type_ ?~ OpenApiString + & description ?~ "DRep Type" + & enum_ ?~ map toJSON [NormalDRep, SoleVoter] + + +data DRepSortMode = Random | VotingPower | RegistrationDate | Status deriving (Bounded, Enum, Eq, Generic, Read, Show) + +instance FromJSON DRepSortMode where + parseJSON (Aeson.String dRepSortMode) = pure $ fromJust $ readMaybe (Text.unpack dRepSortMode) + parseJSON _ = fail "" + +instance ToJSON DRepSortMode where + toJSON x = Aeson.String $ Text.pack $ show x + +instance ToSchema DRepSortMode where + declareNamedSchema proxy = do + NamedSchema name_ schema_ <- genericDeclareNamedSchema (fromAesonOptions defaultOptions) proxy + return $ + NamedSchema name_ $ + schema_ + & description ?~ "DRep Sort Mode" + & example ?~ toJSON VotingPower + +instance FromHttpApiData DRepSortMode where + parseQueryParam t = case readMaybe $ Text.unpack t of + Just x -> Right x + Nothing -> Left ("incorrect DRep sort mode: " <> t) + +instance ToParamSchema DRepSortMode where + toParamSchema _ = + mempty + & type_ ?~ OpenApiString + & enum_ ?~ map toJSON (enumFromTo minBound maxBound :: [DRepSortMode]) + + +data DRep + = DRep + { dRepIsScriptBased :: Bool + , dRepDrepId :: DRepHash + , dRepView :: Text + , dRepUrl :: Maybe Text + , dRepMetadataHash :: Maybe Text + , dRepDeposit :: Integer + , dRepVotingPower :: Maybe Integer + , dRepStatus :: DRepStatus + , dRepType :: DRepType + , dRepLatestTxHash :: Maybe HexText + , dRepLatestRegistrationDate :: UTCTime + , dRepMetadataError :: Maybe Text + , dRepPaymentAddress :: Maybe Text + , dRepGivenName :: Maybe Text + , dRepObjectives :: Maybe Text + , dRepMotivations :: Maybe Text + , dRepQualifications :: Maybe Text + , dRepImageUrl :: Maybe Text + , dRepImageHash :: Maybe HexText + } + deriving (Generic, Show) + +deriveJSON (jsonOptions "dRep") ''DRep + +instance ToSchema DRep where + declareNamedSchema proxy = do + NamedSchema name_ schema_ <- + genericDeclareNamedSchema + ( fromAesonOptions $ jsonOptions "dRep" ) + proxy + return $ + NamedSchema name_ $ + schema_ + & description ?~ "DRep" diff --git a/govtool/backend/src/VVA/DRep.hs b/govtool/backend/src/VVA/DRep.hs index 187cdc73d..1f07da285 100644 --- a/govtool/backend/src/VVA/DRep.hs +++ b/govtool/backend/src/VVA/DRep.hs @@ -1,16 +1,18 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} module VVA.DRep where import Control.Monad.Except (MonadError) import Control.Monad.Reader - import Crypto.Hash +import qualified Data.Aeson as Aeson +import Data.Aeson (Value) import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as C @@ -18,19 +20,73 @@ import Data.FileEmbed (embedFile) import Data.Foldable (Foldable (sum)) import Data.Has (Has) import qualified Data.Map as M -import Data.Maybe (fromMaybe, isJust, isNothing) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Scientific import Data.String (fromString) import Data.Text (Text, pack, unpack) import qualified Data.Text.Encoding as Text import Data.Time +import Data.Vector (Vector) +import qualified Data.Vector as V + +import Debug.Trace (trace) + + +import Numeric.Natural (Natural) import qualified Database.PostgreSQL.Simple as SQL +import Database.PostgreSQL.Simple.Types (PGArray(..)) +import Database.PostgreSQL.Simple.ToField (ToField (..)) + import VVA.Config import VVA.Pool (ConnectionPool, withPool) import qualified VVA.Proposal as Proposal import VVA.Types (AppError, DRepInfo (..), DRepRegistration (..), DRepStatus (..), DRepType (..), Proposal (..), Vote (..)) +import qualified VVA.Common.Types as CommonTypes +import qualified VVA.API.Types as APITypes + +sortModeToString :: CommonTypes.DRepSortMode -> Text +sortModeToString CommonTypes.Random = "Random" +sortModeToString CommonTypes.VotingPower = "VotingPower" +sortModeToString CommonTypes.RegistrationDate = "RegistrationDate" +sortModeToString CommonTypes.Status = "Status" + +convertDRepStatus :: VVA.Types.DRepStatus -> CommonTypes.DRepStatus +convertDRepStatus VVA.Types.Active = CommonTypes.Active +convertDRepStatus VVA.Types.Inactive = CommonTypes.Inactive +convertDRepStatus VVA.Types.Retired = CommonTypes.Retired + +convertDRepStatusToDb :: CommonTypes.DRepStatus -> Text +convertDRepStatusToDb CommonTypes.Active = "Active" +convertDRepStatusToDb CommonTypes.Inactive = "Inactive" +convertDRepStatusToDb CommonTypes.Retired = "Retired" + +drepRegistrationToDrep :: DRepRegistration -> CommonTypes.DRep +drepRegistrationToDrep DRepRegistration {..} = + CommonTypes.DRep + { dRepIsScriptBased = dRepRegistrationIsScriptBased + , dRepDrepId = CommonTypes.DRepHash dRepRegistrationDRepHash + , dRepView = dRepRegistrationView + , dRepUrl = dRepRegistrationUrl + , dRepMetadataHash = dRepRegistrationDataHash + , dRepDeposit = dRepRegistrationDeposit + , dRepVotingPower = dRepRegistrationVotingPower + , dRepStatus = convertDRepStatus dRepRegistrationStatus + , dRepType = case dRepRegistrationType of + VVA.Types.DRep -> CommonTypes.NormalDRep + VVA.Types.SoleVoter -> CommonTypes.SoleVoter + , dRepLatestTxHash = fmap CommonTypes.HexText dRepRegistrationLatestTxHash + , dRepLatestRegistrationDate = dRepRegistrationLatestRegistrationDate + , dRepMetadataError = dRepRegistrationMetadataError + , dRepPaymentAddress = dRepRegistrationPaymentAddress + , dRepGivenName = dRepRegistrationGivenName + , dRepObjectives = dRepRegistrationObjectives + , dRepMotivations = dRepRegistrationMotivations + , dRepQualifications = dRepRegistrationQualifications + , dRepImageUrl = dRepRegistrationImageUrl + , dRepImageHash = fmap CommonTypes.HexText dRepRegistrationImageHash + } sqlFrom :: ByteString -> SQL.Query sqlFrom bs = fromString $ unpack $ Text.decodeUtf8 bs @@ -40,57 +96,69 @@ listDRepsSql = sqlFrom $(embedFile "sql/list-dreps.sql") listDReps :: (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m) => - Maybe Text -> m [DRepRegistration] -listDReps mSearchQuery = withPool $ \conn -> do + Maybe Text -> [CommonTypes.DRepStatus] -> Maybe CommonTypes.DRepSortMode -> Natural -> Natural -> m APITypes.ListDRepsResponse +listDReps mSearchQuery statuses order limit offset = withPool $ \conn -> do let searchParam = fromMaybe "" mSearchQuery + let sortMode = fromMaybe CommonTypes.Random order -- Default to Random + let statusList :: [Text] + statusList = if null statuses + then map convertDRepStatusToDb [CommonTypes.Active, CommonTypes.Inactive, CommonTypes.Retired] + else map convertDRepStatusToDb statuses + + let emptyStatusCheck :: Text + emptyStatusCheck = if null statuses then "" else "not_empty" + + liftIO $ putStrLn "Running listDReps query" + liftIO $ putStrLn $ "searchParam: " <> show searchParam + liftIO $ putStrLn $ "statusList: " <> show statusList + liftIO $ putStrLn $ "emptyStatusCheck: " <> show emptyStatusCheck + liftIO $ putStrLn $ "sortMode: " <> show sortMode + liftIO $ putStrLn $ "limit: " <> show limit + liftIO $ putStrLn $ "offset: " <> show offset + results <- liftIO $ SQL.query conn listDRepsSql - ( searchParam -- COALESCE(?, '') - , searchParam -- LENGTH(?) - , searchParam -- AND ? - , searchParam -- decode(?, 'hex') - , "%" <> searchParam <> "%" -- dh.view - , "%" <> searchParam <> "%" -- given_name - , "%" <> searchParam <> "%" -- payment_address - , "%" <> searchParam <> "%" -- objectives - , "%" <> searchParam <> "%" -- motivations - , "%" <> searchParam <> "%" -- qualifications + ( searchParam -- COALESCE(?, '') (used for search conditions) + , searchParam -- LENGTH(?) for hex validation + , searchParam -- Hex validation regex check + , searchParam -- drep_hash match + , "%" <> searchParam <> "%" -- Used in `ILIKE ANY(ARRAY[...])` + , emptyStatusCheck -- Status check flag + , PGArray statusList -- status = ANY(?) + , searchParam -- COALESCE(?, '') for SoleVoter filter + , "%" <> searchParam <> "%" -- view ILIKE ? + , sortModeToString sortMode -- Combined sorting case + , sortModeToString sortMode -- Used for `Random` sort + , (fromIntegral limit :: Integer) -- Limit ? + , (fromIntegral offset :: Integer) -- Offset ? ) - timeZone <- liftIO getCurrentTimeZone - return - [ DRepRegistration drepHash drepView isScriptBased url dataHash (floor @Scientific deposit) votingPower status drepType txHash (localTimeToUTC timeZone date) metadataError paymentAddress givenName objectives motivations qualifications imageUrl imageHash - | ( drepHash - , drepView - , isScriptBased - , url - , dataHash - , deposit - , votingPower - , isActive - , txHash - , date - , latestDeposit - , latestNonDeregisterVotingAnchorWasNotNull - , metadataError - , paymentAddress - , givenName - , objectives - , motivations - , qualifications - , imageUrl - , imageHash - ) <- results - , let status = case (isActive, deposit) of - (_, d) | d < 0 -> Retired - (isActive, d) | d >= 0 && isActive -> Active - | d >= 0 && not isActive -> Inactive - , let latestDeposit' = floor @Scientific latestDeposit :: Integer - , let drepType | latestDeposit' >= 0 && isNothing url = SoleVoter - | latestDeposit' >= 0 && isJust url = DRep - | latestDeposit' < 0 && not latestNonDeregisterVotingAnchorWasNotNull = SoleVoter - | latestDeposit' < 0 && latestNonDeregisterVotingAnchorWasNotNull = DRep - | Data.Maybe.isJust url = DRep - ] + liftIO $ putStrLn "listDReps query complete" + liftIO $ putStrLn $ "results: " <> show results + + case results of + [(totalCountRaw :: Integer, Aeson.Array elements)] -> do + let totalCount = fromIntegral totalCountRaw :: Int + timeZone <- liftIO getCurrentTimeZone + + let drepsJSON = mapMaybe (\x -> case Aeson.fromJSON x of + Aeson.Success drep -> Just drep + Aeson.Error err -> trace ("JSON parsing error: " <> err <> " on input: " <> show x) Nothing) + (V.toList elements) + + liftIO $ putStrLn $ "drepsJSON: " <> show drepsJSON + + let dreps = map drepRegistrationToDrep drepsJSON + + liftIO $ putStrLn $ "dreps: " <> show dreps + + return $ APITypes.ListDRepsResponse + { listDRepsResponsePage = fromIntegral offset `div` fromIntegral limit + , listDRepsResponsePageSize = fromIntegral limit + , listDRepsResponseTotal = fromIntegral totalCount + , listDRepsResponseElements = dreps + } + + _ -> error "Unexpected result from database query in listDReps" getVotingPowerSql :: SQL.Query getVotingPowerSql = sqlFrom $(embedFile "sql/get-voting-power.sql") diff --git a/govtool/backend/src/VVA/Types.hs b/govtool/backend/src/VVA/Types.hs index 7a8fa3722..f9d11013f 100644 --- a/govtool/backend/src/VVA/Types.hs +++ b/govtool/backend/src/VVA/Types.hs @@ -5,17 +5,20 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE LambdaCase #-} module VVA.Types where import Control.Concurrent.QSem import Control.Exception import Control.Monad.Except (MonadError) +import Control.Monad (fail) import Control.Monad.Fail (MonadFail) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (MonadReader) -import Data.Aeson (Value, ToJSON (..), object, (.=)) +import qualified Data.Aeson as Aeson +import Data.Aeson (Value, ToJSON (..), FromJSON (..), object, (.=), (.:), (.:?), withObject) import qualified Data.Cache as Cache import Data.Has import Data.Pool (Pool) @@ -25,9 +28,11 @@ import Data.Scientific import Database.PostgreSQL.Simple (Connection) import Database.PostgreSQL.Simple.FromRow +import Database.PostgreSQL.Simple.ToField (ToField (..)) import VVA.Cache import VVA.Config +import VVA.Common.Types (DRepSortMode, DRep) type App m = (MonadReader AppEnv m, MonadIO m, MonadFail m, MonadError AppError m) @@ -97,8 +102,26 @@ data DRepInfo data DRepStatus = Active | Inactive | Retired deriving (Show, Eq, Ord) +instance Aeson.FromJSON DRepStatus where + parseJSON = Aeson.withText "DRepStatus" $ \case + "Active" -> pure Active + "Inactive" -> pure Inactive + "Retired" -> pure Retired + _ -> fail "Invalid DRepStatus" + +instance ToField DRepStatus where + toField Active = toField ("Active" :: Text) + toField Inactive = toField ("Inactive" :: Text) + toField Retired = toField ("Retired" :: Text) + data DRepType = DRep | SoleVoter deriving (Show, Eq) +instance Aeson.FromJSON DRepType where + parseJSON = Aeson.withText "DRepType" $ \case + "DRep" -> pure DRep + "SoleVoter" -> pure SoleVoter + _ -> fail "Invalid DRepType" + data DRepRegistration = DRepRegistration { dRepRegistrationDRepHash :: Text @@ -123,6 +146,30 @@ data DRepRegistration } deriving (Show) +-- That should map field names in SQL query +instance FromJSON DRepRegistration where + parseJSON = withObject "DRepRegistration" $ \v -> + DRepRegistration + <$> v .: "drep_hash" + <*> v .: "view" + <*> v .: "has_script" + <*> v .:? "url" + <*> v .:? "metadata_hash" + <*> v .: "deposit" + <*> v .:? "amount" + <*> v .: "status" + <*> v .: "drep_type" + <*> v .:? "tx_hash" + <*> v .: "last_register_time" + <*> v .:? "fetch_error" + <*> v .:? "payment_address" + <*> v .:? "given_name" + <*> v .:? "objectives" + <*> v .:? "motivations" + <*> v .:? "qualifications" + <*> v .:? "image_url" + <*> v .:? "image_hash" + data Proposal = Proposal { proposalId :: Integer @@ -211,7 +258,7 @@ data CacheEnv , dRepGetVotesCache :: Cache.Cache Text ([Vote], [Proposal]) , dRepInfoCache :: Cache.Cache Text DRepInfo , dRepVotingPowerCache :: Cache.Cache Text Integer - , dRepListCache :: Cache.Cache Text [DRepRegistration] + , dRepListCache :: Cache.Cache Text [DRep] , networkMetricsCache :: Cache.Cache () NetworkMetrics } diff --git a/govtool/backend/vva-be.cabal b/govtool/backend/vva-be.cabal index 2f05a3d46..c3ce466c9 100644 --- a/govtool/backend/vva-be.cabal +++ b/govtool/backend/vva-be.cabal @@ -104,9 +104,11 @@ library , vector , async , random + , unordered-containers exposed-modules: VVA.Config , VVA.CommandLine + , VVA.Common.Types , VVA.API , VVA.API.Types , VVA.API.Utils