Skip to content

Commit

Permalink
[#530] Apply the hlint and stylish-haskell hints
Browse files Browse the repository at this point in the history
To keep the repository clean this commit introduces all the changes that
apply the hlint and stylish-haskell hints. By introducing this change
developers will not need to do the chore of applying those hints in
future.
  • Loading branch information
placek committed Mar 28, 2024
1 parent 452c71f commit 6b40e80
Show file tree
Hide file tree
Showing 15 changed files with 686 additions and 653 deletions.
160 changes: 74 additions & 86 deletions govtool/backend/app/Main.hs
Original file line number Diff line number Diff line change
@@ -1,90 +1,77 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Control.Exception
( Exception,
SomeException,
fromException,
throw,
)
import Control.Lens.Operators ((.~))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Data.Aeson hiding (Error)
import Data.ByteString.Char8 (unpack)
import qualified Data.ByteString as BS
import Data.Function ((&))
import Data.Monoid (mempty)
import Data.OpenApi (OpenApi, Server (Server), servers, _openApiServers, _serverDescription, _serverUrl, _serverVariables)
import Data.Proxy
import Data.String (fromString)
import Data.String.Conversions
( cs,
)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import Network.Wai
import Network.Wai
( Request,
rawPathInfo,
requestHeaderHost,
)
import Network.Wai.Handler.Warp
import Network.Wai.Handler.Warp
( defaultOnException,
defaultSettings,
runSettings,
setOnException,
setPort,
)
import Network.Wai.Middleware.Cors
import Options.Applicative (execParser)
import Servant
import Servant.API.ContentTypes
import Servant.OpenApi (toOpenApi)
import qualified Servant.Server as Servant
import Servant.Swagger.UI
( SwaggerSchemaUI,
swaggerSchemaUIServer,
)
import System.IO (stderr)
import System.Log.Raven
( initRaven,
register,
silentFallback,
)
import System.Log.Raven.Transport.HttpConduit (sendRecord)
import System.Log.Raven.Types
( SentryLevel (Error),
SentryRecord (..),
)
import VVA.API
import VVA.CommandLine
import VVA.Config
import Data.Function ((&))
import Control.Lens.Operators ((.~))
import Data.Monoid (mempty)
import qualified Data.Cache as Cache
import VVA.API.Types
import System.Clock (TimeSpec(TimeSpec))
import Data.Pool (createPool)
import Database.PostgreSQL.Simple (connectPostgreSQL, close)
import Data.Text.Encoding (encodeUtf8)
import Data.Has (getter)
import VVA.Types (AppError(ValidationError, NotFoundError, CriticalError), CacheEnv(..), AppEnv(..))
import Control.Exception (Exception,
SomeException,
fromException, throw)
import Control.Lens.Operators ((.~))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader

import Data.Aeson hiding (Error)
import qualified Data.ByteString as BS
import Data.ByteString.Char8 (unpack)
import qualified Data.Cache as Cache
import Data.Function ((&))
import Data.Has (getter)
import Data.Monoid (mempty)
import Data.OpenApi (OpenApi,
Server (Server),
_openApiServers,
_serverDescription,
_serverUrl,
_serverVariables,
servers)
import Data.Pool (createPool)
import Data.Proxy
import Data.String (fromString)
import Data.String.Conversions (cs)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText

import Database.PostgreSQL.Simple (close,
connectPostgreSQL)

import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.Cors

import Options.Applicative (execParser)

import Servant
import Servant.API.ContentTypes
import Servant.OpenApi (toOpenApi)
import qualified Servant.Server as Servant
import Servant.Swagger.UI (SwaggerSchemaUI,
swaggerSchemaUIServer)

import System.Clock (TimeSpec (TimeSpec))
import System.IO (stderr)
import System.Log.Raven (initRaven, register,
silentFallback)
import System.Log.Raven.Transport.HttpConduit (sendRecord)
import System.Log.Raven.Types (SentryLevel (Error),
SentryRecord (..))

import VVA.API
import VVA.API.Types
import VVA.CommandLine
import VVA.Config
import VVA.Types (AppEnv (..),
AppError (CriticalError, NotFoundError, ValidationError),
CacheEnv (..))

proxyAPI :: Proxy (VVAApi :<|> SwaggerAPI)
proxyAPI = Proxy
Expand All @@ -94,7 +81,7 @@ main = do
commandLineConfig <- execParser cmdParser
vvaConfig <- loadVVAConfig (clcConfigPath commandLineConfig)
case clcCommand commandLineConfig of
StartApp -> startApp vvaConfig
StartApp -> startApp vvaConfig
ShowConfig -> Text.putStrLn $ vvaConfigToText vvaConfig

startApp :: VVAConfig -> IO ()
Expand Down Expand Up @@ -172,7 +159,7 @@ recordUpdate Nothing exception record = record
recordUpdate (Just request) exception record =
record
{ srCulprit = Just $ unpack $ rawPathInfo request,
srServerName = fmap unpack $ requestHeaderHost request
srServerName = unpack <$> requestHeaderHost request
}

shouldDisplayException :: SomeException -> Bool
Expand Down Expand Up @@ -243,7 +230,8 @@ mkVVAServer appEnv = do
(liftServer appEnv :<|> swagger)
)

newtype TextException = TextException Text.Text
newtype TextException
= TextException Text.Text

instance Show TextException where
show (TextException e) = show e
Expand Down
101 changes: 53 additions & 48 deletions govtool/backend/src/VVA/API.hs
Original file line number Diff line number Diff line change
@@ -1,38 +1,46 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

module VVA.API where

import Control.Monad.Reader
import Control.Monad.Except (throwError)
import Data.List (sortOn)
import Data.Maybe (fromMaybe, Maybe (Nothing))
import Data.Ord (Down (..))
import Data.Text hiding (elem, filter, map, null, take, drop, length)
import Servant.API
import Servant.Server
import Text.Read (readMaybe)
import VVA.API.Types
import qualified VVA.AdaHolder as AdaHolder
import VVA.Config
import qualified VVA.DRep as DRep
import qualified VVA.Proposal as Proposal
import qualified VVA.Epoch as Epoch
import qualified VVA.Transaction as Transaction
import Data.Bool (Bool)
import qualified Data.Map as Map
import VVA.Cache (cacheRequest)
import Control.Exception (throw)
import VVA.Types (CacheEnv(..), AppError(ValidationError, CriticalError), App, AppEnv(..))
import qualified VVA.Types as Types
import qualified Data.Text as Text
import VVA.Network as Network
import Numeric.Natural (Natural)
import Control.Exception (throw)
import Control.Monad.Except (throwError)
import Control.Monad.Reader

import Data.Bool (Bool)
import Data.List (sortOn)
import qualified Data.Map as Map
import Data.Maybe (Maybe (Nothing), fromMaybe)
import Data.Ord (Down (..))
import Data.Text hiding (drop, elem, filter, length, map,
null, take)
import qualified Data.Text as Text

import Numeric.Natural (Natural)

import Servant.API
import Servant.Server

import Text.Read (readMaybe)

import qualified VVA.AdaHolder as AdaHolder
import VVA.API.Types
import VVA.Cache (cacheRequest)
import VVA.Config
import qualified VVA.DRep as DRep
import qualified VVA.Epoch as Epoch
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.Types (App, AppEnv (..),
AppError (CriticalError, ValidationError),
CacheEnv (..))

type VVAApi =
"drep" :> "list" :> QueryParam "drepView" Text :> Get '[JSON] [DRep]
Expand Down Expand Up @@ -71,12 +79,12 @@ server = drepList


mapDRepType :: Types.DRepType -> DRepType
mapDRepType Types.DRep = NormalDRep
mapDRepType Types.DRep = NormalDRep
mapDRepType Types.SoleVoter = SoleVoter

mapDRepStatus :: Types.DRepStatus -> DRepStatus
mapDRepStatus Types.Retired = Retired
mapDRepStatus Types.Active = Active
mapDRepStatus Types.Retired = Retired
mapDRepStatus Types.Active = Active
mapDRepStatus Types.Inactive = Inactive

drepRegistrationToDrep :: Types.DRepRegistration -> DRep
Expand All @@ -99,9 +107,9 @@ drepList mDRepView = do
let filtered = flip filter dreps $ \Types.DRepRegistration {..} ->
case (dRepRegistrationType, mDRepView) of
(Types.SoleVoter, Just x) -> x == dRepRegistrationView
(Types.DRep, Just x) -> isInfixOf x dRepRegistrationView
(Types.DRep, Nothing) -> True
_ -> False
(Types.DRep, Just x) -> x `isInfixOf` dRepRegistrationView
(Types.DRep, Nothing) -> True
_ -> False
return $ map drepRegistrationToDrep filtered

getVotingPower :: App m => HexText -> m Integer
Expand Down Expand Up @@ -165,10 +173,10 @@ mapSortAndFilterProposals selectedTypes sortMode proposals =
)
mappedProposals
sortedProposals = case sortMode of
Nothing -> filteredProposals
Just NewestCreated -> sortOn (Down . proposalResponseCreatedDate) filteredProposals
Nothing -> filteredProposals
Just NewestCreated -> sortOn (Down . proposalResponseCreatedDate) filteredProposals
Just SoonestToExpire -> sortOn proposalResponseExpiryDate filteredProposals
Just MostYesVotes -> sortOn (Down . proposalResponseYesVotes) filteredProposals
Just MostYesVotes -> sortOn (Down . proposalResponseYesVotes) filteredProposals
in sortedProposals

getVotes :: App m => HexText -> [GovernanceActionType] -> Maybe GovernanceActionSortMode -> m [VoteResponse]
Expand All @@ -179,7 +187,7 @@ getVotes (unHexText -> dRepId) selectedTypes sortMode = do
let processedProposals = mapSortAndFilterProposals selectedTypes sortMode proposals
return $
[ VoteResponse
{ voteResponseVote = voteToResponse (voteMap Map.! (read $ unpack proposalResponseId))
{ voteResponseVote = voteToResponse (voteMap Map.! read (unpack proposalResponseId))
, voteResponseProposal = proposalResponse
}
| proposalResponse@ProposalResponse{proposalResponseId} <- processedProposals
Expand Down Expand Up @@ -209,7 +217,7 @@ getCurrentDelegation (unHexText -> stakeKey) = do
getStakeKeyVotingPower :: App m => HexText -> m Integer
getStakeKeyVotingPower (unHexText -> stakeKey) = do
CacheEnv {adaHolderVotingPowerCache} <- asks vvaCache
cacheRequest adaHolderVotingPowerCache stakeKey $ AdaHolder.getStakeKeyVotingPower $ stakeKey
cacheRequest adaHolderVotingPowerCache stakeKey $ AdaHolder.getStakeKeyVotingPower stakeKey


listProposals
Expand Down Expand Up @@ -255,10 +263,7 @@ listProposals selectedTypes sortMode mPage mPageSize mDrepRaw mSearchQuery = do
( \p@ProposalResponse {proposalResponseId} ->
proposalResponseId `notElem` proposalsToRemove
&& filterF p
)
<$>
mapSortAndFilterProposals selectedTypes sortMode
<$> cacheRequest proposalListCache () Proposal.listProposals
) . mapSortAndFilterProposals selectedTypes sortMode <$> cacheRequest proposalListCache () Proposal.listProposals

let total = length mappedAndSortedProposals :: Int

Expand All @@ -271,7 +276,7 @@ listProposals selectedTypes sortMode mPage mPageSize mDrepRaw mSearchQuery = do
, listProposalsResponseElements = elements
}

getProposal :: App m => GovActionId -> Maybe (HexText) -> m GetProposalResponse
getProposal :: App m => GovActionId -> Maybe HexText -> m GetProposalResponse
getProposal g@(GovActionId govActionTxHash govActionIndex) mDrepId' = do
let mDrepId = unHexText <$> mDrepId'
CacheEnv {getProposalCache} <- asks vvaCache
Expand Down Expand Up @@ -300,7 +305,7 @@ getTransactionStatus :: App m => HexText -> m GetTransactionStatusResponse
getTransactionStatus (unHexText -> transactionId) = do
x <- Transaction.getTransactionStatus transactionId
case x of
Types.TransactionConfirmed -> return $ GetTransactionStatusResponse True
Types.TransactionConfirmed -> return $ GetTransactionStatusResponse True
Types.TransactionUnconfirmed -> return $ GetTransactionStatusResponse False

throw500 :: App m => m ()
Expand Down
Loading

0 comments on commit 6b40e80

Please sign in to comment.