Add CIP-179 v5 linked survey linking and voting

CHANGELOG.md

@@ -12,6 +12,8 @@ changes.
 
 ### Added
 
+- Add feature-flagged CIP-179 linked survey authoring, rendering, and vote-response submission for governance actions
+
 ### Fixed
 
 - Fix disappearing proposals in the governance actions list for the same tx hashes [Issue 3918](https://github.com/IntersectMBO/govtool/issues/3918)

govtool/backend/sql/get-survey-definition.sql

@@ -0,0 +1,6 @@
+SELECT encode(tx_metadata.bytes, 'hex')
+FROM tx_metadata
+JOIN tx ON tx.id = tx_metadata.tx_id
+WHERE tx.hash = decode(?, 'hex')
+  AND tx_metadata.key = 17
+LIMIT 1;

govtool/backend/src/VVA/API.hs

@@ -13,10 +13,11 @@ import           Control.Exception        (throw, throwIO)
 import           Control.Monad.Except     (runExceptT, throwError)
 import           Control.Monad.Reader
 
-import           Data.Aeson               (Array, ToJSON, Value (..), decode, toJSON)
+import           Data.Aeson               (Array, ToJSON, Value (..), decode, object, toJSON, (.=))
 import           Data.Bool                (Bool)
 import           Data.ByteString.Lazy     (ByteString)
 import qualified Data.ByteString.Lazy     as BSL
+import           Data.Hashable            (hash, hashWithSalt)
 import           Data.List                (sort, sortOn)
 import qualified Data.Map                 as Map
 import           Data.Maybe               (Maybe (Nothing), catMaybes, fromMaybe, mapMaybe)
@@ -28,7 +29,6 @@ import qualified Data.Text.Lazy.Encoding  as TL
 import           Data.Time                (TimeZone, localTimeToUTC)
 import           Data.Time.LocalTime      (TimeZone, getCurrentTimeZone)
 import qualified Data.Vector              as V
-import           Data.Hashable            (hash, hashWithSalt)
 
 import           Numeric.Natural          (Natural)
 
@@ -50,6 +50,7 @@ import qualified VVA.Epoch                as Epoch
 import qualified VVA.Ipfs                 as Ipfs
 import           VVA.Network              as Network
 import qualified VVA.Proposal             as Proposal
+import qualified VVA.Survey               as Survey
 import qualified VVA.Transaction          as Transaction
 import qualified VVA.Types                as Types
 import           VVA.Types                (App, AppEnv (..),
@@ -89,6 +90,7 @@ type VVAApi =
                     :> QueryParam "search" Text
                     :> Get '[JSON] ListProposalsResponse
     :<|> "proposal" :> "get" :> Capture "proposalId" GovActionId :> QueryParam "drepId" HexText :> Get '[JSON] GetProposalResponse
+    :<|> "survey" :> "definition" :> Capture "txId" HexText :> Capture "index" Natural :> Get '[JSON] (Headers '[Header "Cache-Control" Text] AnyValue)
     :<|> "proposal" :> "enacted-details" :> QueryParam "type" GovernanceActionType :> Get '[JSON] (Maybe EnactedProposalDetailsResponse)
     :<|> "epoch" :> "params" :> Get '[JSON] GetCurrentEpochParamsResponse
     :<|> "transaction" :> "status" :> Capture "transactionId" HexText :> Get '[JSON] GetTransactionStatusResponse
@@ -109,6 +111,7 @@ server = upload
     :<|> getStakeKeyVotingPower
     :<|> listProposals
     :<|> getProposal
+    :<|> getSurveyDefinition
     :<|> getEnactedProposalDetails
     :<|> getCurrentEpochParams
     :<|> getTransactionStatus
@@ -118,6 +121,21 @@ server = upload
     :<|> getNetworkTotalStake
     :<|> getAccountInfo
 
+getSurveyDefinition :: App m => HexText -> Natural -> m (Headers '[Header "Cache-Control" Text] AnyValue)
+getSurveyDefinition (unHexText -> txId) surveyIndex = do
+  when (Text.length txId /= 64) $
+    throwError $ ValidationError "txId must be a 64-character hex string"
+  when (surveyIndex > 65535) $
+    throwError $ ValidationError "surveyIndex must be between 0 and 65535"
+  payloadCborHex <- Survey.getSurveyDefinition txId
+  pure $ addHeader "public, max-age=31536000, immutable" $ AnyValue $ Just $
+    object
+      [ "txId" .= Text.toLower txId
+      , "surveyIndex" .= surveyIndex
+      , "metadataLabel" .= (17 :: Integer)
+      , "payloadCborHex" .= payloadCborHex
+      ]
+
 upload :: App m => Maybe Text -> Text -> m UploadResponse
 upload mFileName fileContentText = do
   AppEnv {vvaConfig} <- ask

govtool/backend/src/VVA/Account.hs

@@ -4,21 +4,22 @@
 
 module VVA.Account where
 
-import           Control.Monad.Except       (MonadError, throwError)
-import           Control.Monad.Reader       (MonadIO, MonadReader, liftIO)
+import           Control.Monad.Except        (MonadError, throwError)
+import           Control.Monad.Reader        (MonadIO, MonadReader, liftIO)
+import           Control.Monad.Trans.Control (MonadBaseControl)
 
-import           Data.ByteString            (ByteString)
-import           Data.FileEmbed             (embedFile)
-import           Data.Has                   (Has)
-import           Data.String                (fromString)
-import           Data.Text                  (Text, unpack)
-import qualified Data.Text.Encoding         as Text
-import qualified Data.Text.IO               as Text
+import           Data.ByteString             (ByteString)
+import           Data.FileEmbed              (embedFile)
+import           Data.Has                    (Has)
+import           Data.String                 (fromString)
+import           Data.Text                   (Text, unpack)
+import qualified Data.Text.Encoding          as Text
+import qualified Data.Text.IO                as Text
 
-import qualified Database.PostgreSQL.Simple as SQL
+import qualified Database.PostgreSQL.Simple  as SQL
 
-import           VVA.Pool                   (ConnectionPool, withPool)
-import           VVA.Types                  (AccountInfo (..), AppError (..))
+import           VVA.Pool                    (ConnectionPool, withPool)
+import           VVA.Types                   (AccountInfo (..), AppError (..))
 
 sqlFrom :: ByteString -> SQL.Query
 sqlFrom = fromString . unpack . Text.decodeUtf8
@@ -27,7 +28,7 @@ accountInfoSql :: SQL.Query
 accountInfoSql = sqlFrom $(embedFile "sql/get-account-info.sql")
 
 accountInfo ::
-  (Has ConnectionPool r, MonadReader r m, MonadIO m, MonadError AppError m) =>
+  (Has ConnectionPool r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadError AppError m) =>
   Text ->
     m AccountInfo
 accountInfo stakeKey = withPool $ \conn -> do

govtool/backend/src/VVA/AdaHolder.hs

@@ -6,26 +6,27 @@
 
 module VVA.AdaHolder where
 
-import           Control.Exception          (SomeException, try)
+import           Control.Exception           (SomeException, try)
 import           Control.Monad.Except
 import           Control.Monad.Reader
+import           Control.Monad.Trans.Control (MonadBaseControl)
 
 import           Crypto.Hash
 
-import           Data.ByteString            (ByteString)
-import qualified Data.ByteString.Char8      as C
-import           Data.FileEmbed             (embedFile)
-import           Data.Has                   (Has)
+import           Data.ByteString             (ByteString)
+import qualified Data.ByteString.Char8       as C
+import           Data.FileEmbed              (embedFile)
+import           Data.Has                    (Has)
 import           Data.Scientific
-import           Data.String                (fromString)
-import           Data.Text                  (Text, unpack)
-import qualified Data.Text.Encoding         as Text
-import qualified Data.Text.IO               as Text
+import           Data.String                 (fromString)
+import           Data.Text                   (Text, unpack)
+import qualified Data.Text.Encoding          as Text
+import qualified Data.Text.IO                as Text
 
-import qualified Database.PostgreSQL.Simple as SQL
+import qualified Database.PostgreSQL.Simple  as SQL
 
 import           VVA.Config
-import           VVA.Pool                   (ConnectionPool, withPool)
+import           VVA.Pool                    (ConnectionPool, withPool)
 import           VVA.Types
 
 sqlFrom :: ByteString -> SQL.Query
@@ -35,7 +36,7 @@ getCurrentDelegationSql :: SQL.Query
 getCurrentDelegationSql = sqlFrom $(embedFile "sql/get-current-delegation.sql")
 
 getCurrentDelegation ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m) =>
   Text ->
   m (Maybe Delegation)
 getCurrentDelegation stakeKey = withPool $ \conn -> do
@@ -49,7 +50,7 @@ getVotingPowerSql :: SQL.Query
 getVotingPowerSql = sqlFrom $(embedFile "sql/get-stake-key-voting-power.sql")
 
 getStakeKeyVotingPower ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadFail m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadFail m) =>
   Text ->
   m Integer
 getStakeKeyVotingPower stakeKey = withPool $ \conn -> do

govtool/backend/src/VVA/DRep.hs

@@ -8,6 +8,7 @@ module VVA.DRep where
 
 import           Control.Monad.Except               (MonadError)
 import           Control.Monad.Reader
+import           Control.Monad.Trans.Control        (MonadBaseControl)
 
 import           Crypto.Hash
 
@@ -78,7 +79,7 @@ sqlFrom bs = fromString $ unpack $ Text.decodeUtf8 bs
 listDRepsSql :: SQL.Query
 listDRepsSql = sqlFrom $(embedFile "sql/list-dreps.sql")
 listDReps ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m) =>
   Maybe Text -> m [DRepRegistration]
 listDReps mSearchQuery = withPool $ \conn -> do
   let searchParam = fromMaybe "" mSearchQuery
@@ -134,7 +135,7 @@ getVotingPowerSql :: SQL.Query
 getVotingPowerSql = sqlFrom $(embedFile "sql/get-voting-power.sql")
 
 getVotingPower ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadFail m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadFail m) =>
   Text ->
   m Integer
 getVotingPower drepId = withPool $ \conn -> do
@@ -147,7 +148,7 @@ getVotesSql :: SQL.Query
 getVotesSql = sqlFrom $(embedFile "sql/get-votes.sql")
 
 getVotes ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadFail m, MonadError AppError m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadFail m, MonadError AppError m) =>
   Text ->
   [Text] ->
   m ([Vote], [Proposal])
@@ -183,6 +184,7 @@ getDRepInfo
      , Has VVAConfig r
      , MonadReader r m
      , MonadIO m
+     , MonadBaseControl IO m
      , MonadFail m
      , MonadError AppError m
      )
@@ -244,7 +246,7 @@ getFilteredDRepVotingPowerSql :: SQL.Query
 getFilteredDRepVotingPowerSql = sqlFrom $(embedFile "sql/get-filtered-dreps-voting-power.sql")
 
 getDRepsVotingPowerList ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m) =>
   [Text] ->
   m [DRepVotingPowerList]
 getDRepsVotingPowerList identifiers = withPool $ \conn -> do

govtool/backend/src/VVA/Epoch.hs

@@ -4,21 +4,22 @@
 
 module VVA.Epoch where
 
-import           Control.Monad.Except       (MonadError, throwError)
+import           Control.Monad.Except        (MonadError, throwError)
 import           Control.Monad.Reader
+import           Control.Monad.Trans.Control (MonadBaseControl)
 
-import           Data.Aeson                 (Value)
-import           Data.ByteString            (ByteString)
-import           Data.FileEmbed             (embedFile)
-import           Data.Has                   (Has)
-import           Data.String                (fromString)
-import           Data.Text                  (Text, unpack)
-import qualified Data.Text.Encoding         as Text
+import           Data.Aeson                  (Value)
+import           Data.ByteString             (ByteString)
+import           Data.FileEmbed              (embedFile)
+import           Data.Has                    (Has)
+import           Data.String                 (fromString)
+import           Data.Text                   (Text, unpack)
+import qualified Data.Text.Encoding          as Text
 
-import qualified Database.PostgreSQL.Simple as SQL
+import qualified Database.PostgreSQL.Simple  as SQL
 
 import           VVA.Config
-import           VVA.Pool                   (ConnectionPool, withPool)
+import           VVA.Pool                    (ConnectionPool, withPool)
 
 sqlFrom :: ByteString -> SQL.Query
 sqlFrom bs = fromString $ unpack $ Text.decodeUtf8 bs
@@ -27,7 +28,7 @@ getCurrentEpochParamsSql :: SQL.Query
 getCurrentEpochParamsSql = sqlFrom $(embedFile "sql/get-current-epoch-params.sql")
 
 getCurrentEpochParams ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m) =>
   m (Maybe Value)
 getCurrentEpochParams = withPool $ \conn -> do
   result <- liftIO $ SQL.query_ conn getCurrentEpochParamsSql

govtool/backend/src/VVA/Network.hs

@@ -4,22 +4,23 @@
 
 module VVA.Network where
 
-import           Control.Monad.Except       (MonadError, throwError)
+import           Control.Monad.Except        (MonadError, throwError)
 import           Control.Monad.Reader
+import           Control.Monad.Trans.Control (MonadBaseControl)
 
-import           Data.Aeson                 (Value)
-import           Data.ByteString            (ByteString)
-import           Data.FileEmbed             (embedFile)
-import           Data.Has                   (Has)
-import           Data.String                (fromString)
-import           Data.Text                  (Text, unpack)
-import qualified Data.Text.Encoding         as Text
+import           Data.Aeson                  (Value)
+import           Data.ByteString             (ByteString)
+import           Data.FileEmbed              (embedFile)
+import           Data.Has                    (Has)
+import           Data.String                 (fromString)
+import           Data.Text                   (Text, unpack)
+import qualified Data.Text.Encoding          as Text
 import           Data.Time.Clock
 
-import qualified Database.PostgreSQL.Simple as SQL
+import qualified Database.PostgreSQL.Simple  as SQL
 
 import           VVA.Config
-import           VVA.Pool                   (ConnectionPool, withPool)
+import           VVA.Pool                    (ConnectionPool, withPool)
 import           VVA.Types
 
 sqlFrom :: ByteString -> SQL.Query
@@ -29,7 +30,7 @@ networkInfoSql :: SQL.Query
 networkInfoSql = sqlFrom $(embedFile "sql/get-network-info.sql")
 
 networkInfo ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadError AppError m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadError AppError m) =>
   m NetworkInfo
 networkInfo = withPool $ \conn -> do
   result <- liftIO $ SQL.query_ conn networkInfoSql
@@ -49,7 +50,7 @@ networkTotalStakeSql :: SQL.Query
 networkTotalStakeSql = sqlFrom $(embedFile "sql/get-network-total-stake.sql")
 
 networkTotalStake ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadError AppError m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadError AppError m) =>
   m NetworkTotalStake
 networkTotalStake = withPool $ \conn -> do
   result <- liftIO $ SQL.query_ conn networkTotalStakeSql
@@ -69,7 +70,7 @@ networkMetricsSql :: SQL.Query
 networkMetricsSql = sqlFrom $(embedFile "sql/get-network-metrics.sql")
 
 networkMetrics ::
-  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadError AppError m) =>
+  (Has ConnectionPool r, Has VVAConfig r, MonadReader r m, MonadIO m, MonadBaseControl IO m, MonadError AppError m) =>
   m NetworkMetrics
 networkMetrics = withPool $ \conn -> do
   result <- liftIO $ SQL.query_ conn networkMetricsSql

govtool/backend/src/VVA/Pool.hs

@@ -2,23 +2,21 @@
 
 module VVA.Pool where
 
-import Control.Monad.IO.Class     (MonadIO, liftIO)
-import Control.Monad.Reader       (MonadReader, asks)
+import Control.Monad.IO.Class      (MonadIO)
+import Control.Monad.Reader        (MonadReader, asks)
+import Control.Monad.Trans.Control (MonadBaseControl)
 
-import Data.Has                   (Has, getter)
-import Data.Pool                  (Pool, putResource, takeResource)
+import Data.Has                    (Has, getter)
+import Data.Pool                   (Pool, withResource)
 
-import Database.PostgreSQL.Simple (Connection)
+import Database.PostgreSQL.Simple  (Connection)
 
 type ConnectionPool = Pool Connection
 
 withPool
-  :: (Has ConnectionPool r, MonadReader r m, MonadIO m)
+  :: (Has ConnectionPool r, MonadReader r m, MonadIO m, MonadBaseControl IO m)
   => (Connection -> m a)
   -> m a
 withPool f = do
   pool <- asks getter
-  (conn,localPool) <- liftIO $ takeResource pool
-  result <- f conn
-  liftIO $ putResource localPool conn
-  return result
+  withResource pool f