From e02409e9caa0dfd41147e0faa585143cc40e331b Mon Sep 17 00:00:00 2001 From: ksaric Date: Tue, 13 Oct 2020 16:42:08 +0200 Subject: [PATCH] [CAD-1823] Stake pools with issues list. --- doc/getting-started/how-to-install-smash.md | 9 +-- src/Cardano/Db/Query.hs | 33 ++++++++-- src/DB.hs | 7 +- src/Lib.hs | 72 ++++++++++++--------- src/Types.hs | 46 +++++++++---- 5 files changed, 109 insertions(+), 58 deletions(-) diff --git a/doc/getting-started/how-to-install-smash.md b/doc/getting-started/how-to-install-smash.md index 36e957d..b01a51b 100644 --- a/doc/getting-started/how-to-install-smash.md +++ b/doc/getting-started/how-to-install-smash.md @@ -298,14 +298,15 @@ metadata for the stake pool. Currently there is a way to check if there are any errors while trying to download the pool metadata. It could be that the hash is wrong, that the server URL return 404, or something else. This is a nice way to check what went wrong. -So if you want to see all the errors that were recorded, you can simply query: +If you have a specific pool id you want to check, you can add that pool id (`c0b0e43213a8c898e373928fbfc3df81ee77c0df7dadc3ad6e5bae17`) in there: ``` -http://localhost:3100/api/v1/errors +http://localhost:3100/api/v1/errors/c0b0e43213a8c898e373928fbfc3df81ee77c0df7dadc3ad6e5bae17 ``` -If you have a specific pool id you want to check, you can add that pool id (`c0b0e43213a8c898e373928fbfc3df81ee77c0df7dadc3ad6e5bae17`) in there: +**This shows all the errors for the pool from a day ago**. +However, you can filter just the ones you want by using a date you want to filter from, like this (using DD.MM.YYYY): ``` -http://localhost:3100/api/v1/errors?poolId=c0b0e43213a8c898e373928fbfc3df81ee77c0df7dadc3ad6e5bae17 +http://localhost:3100/api/v1/errors/6b6164af70861c5537cc9c8e50fdae35139ca2c8c6fbb42e8b7e6bfb?fromDate=13.10.2020 ``` The returned list consists of objects that contain: diff --git a/src/Cardano/Db/Query.hs b/src/Cardano/Db/Query.hs index a94d954..deaf2a8 100644 --- a/src/Cardano/Db/Query.hs +++ b/src/Cardano/Db/Query.hs @@ -18,6 +18,7 @@ module Cardano.Db.Query , queryReservedTicker , queryAdminUsers , queryPoolMetadataFetchError + , queryPoolMetadataFetchErrorByTime , queryAllRetiredPools ) where @@ -30,13 +31,15 @@ import Control.Monad.Trans.Reader (ReaderT) import Data.ByteString.Char8 (ByteString) import Data.Maybe (catMaybes, listToMaybe) +import Data.Time.Clock (UTCTime) import Data.Word (Word64) -import Database.Esqueleto (Entity, PersistField, SqlExpr, ValueList, - Value, countRows, desc, entityVal, - from, isNothing, just, limit, subList_select, - notIn, not_, orderBy, select, - unValue, val, where_, (&&.), (==.), +import Database.Esqueleto (Entity, PersistField, SqlExpr, + Value, ValueList, countRows, desc, + entityVal, from, isNothing, just, + limit, notIn, not_, orderBy, + select, subList_select, unValue, + val, where_, (&&.), (==.), (>=.), (^.)) import Database.Persist.Sql (SqlBackend, selectList) @@ -190,6 +193,26 @@ queryPoolMetadataFetchError (Just poolId) = do pure $ poolMetadataFetchError pure $ fmap entityVal res +queryPoolMetadataFetchErrorByTime + :: MonadIO m + => Types.PoolId + -> Maybe UTCTime + -> ReaderT SqlBackend m [PoolMetadataFetchError] +queryPoolMetadataFetchErrorByTime poolId Nothing = do + res <- select . from $ \(poolMetadataFetchError :: SqlExpr (Entity PoolMetadataFetchError)) -> do + where_ (poolMetadataFetchError ^. PoolMetadataFetchErrorPoolId ==. val poolId) + + pure $ poolMetadataFetchError + pure $ fmap entityVal res + +queryPoolMetadataFetchErrorByTime poolId (Just fromTime) = do + res <- select . from $ \(poolMetadataFetchError :: SqlExpr (Entity PoolMetadataFetchError)) -> do + where_ (poolMetadataFetchError ^. PoolMetadataFetchErrorPoolId ==. val poolId + &&. poolMetadataFetchError ^. PoolMetadataFetchErrorFetchTime >=. val fromTime) + + pure $ poolMetadataFetchError + pure $ fmap entityVal res + ------------------------------------------------------------------------------------ maybeToEither :: e -> (a -> b) -> Maybe a -> Either e b diff --git a/src/DB.hs b/src/DB.hs index 83b179f..b141a99 100644 --- a/src/DB.hs +++ b/src/DB.hs @@ -19,6 +19,7 @@ import Cardano.Prelude import Data.IORef (IORef, modifyIORef, readIORef) import qualified Data.Map as Map +import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Types @@ -77,7 +78,7 @@ data DataLayer = DataLayer -- TODO(KS): Switch to PoolFetchError! , dlAddFetchError :: PoolMetadataFetchError -> IO (Either DBFail PoolMetadataFetchErrorId) - , dlGetFetchErrors :: Maybe PoolId -> IO (Either DBFail [PoolFetchError]) + , dlGetFetchErrors :: PoolId -> Maybe UTCTime -> IO (Either DBFail [PoolFetchError]) } deriving (Generic) -- | Simple stubbed @DataLayer@ for an example. @@ -189,8 +190,8 @@ postgresqlDataLayer = DataLayer , dlAddFetchError = \poolMetadataFetchError -> do poolMetadataFetchErrorId <- runDbAction Nothing $ insertPoolMetadataFetchError poolMetadataFetchError return $ Right poolMetadataFetchErrorId - , dlGetFetchErrors = \mPoolId -> do - poolMetadataFetchErrors <- runDbAction Nothing (queryPoolMetadataFetchError mPoolId) + , dlGetFetchErrors = \poolId mTimeFrom -> do + poolMetadataFetchErrors <- runDbAction Nothing (queryPoolMetadataFetchErrorByTime poolId mTimeFrom) pure $ sequence $ Right <$> map convertPoolMetadataFetchError poolMetadataFetchErrors } diff --git a/src/Lib.hs b/src/Lib.hs index ec349e4..f44b258 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Lib ( Configuration (..) @@ -22,6 +22,8 @@ import Data.Aeson (eitherDecode') import qualified Data.ByteString.Lazy as BL import Data.IORef (newIORef) import Data.Swagger (Info (..), Swagger (..)) +import Data.Time (UTCTime, addUTCTime, + getCurrentTime, nominalDay) import Network.Wai.Handler.Warp (defaultSettings, runSettings, setBeforeMainLoop, setPort) @@ -32,10 +34,9 @@ import Servant (Application, BasicAuth, BasicAuthData (..), BasicAuthResult (..), Capture, Context (..), Get, Handler (..), - HasServer (..), Header, Headers, - JSON, Patch, QueryParam, ReqBody, - Server, ServerT, err403, err404, - serveWithContext) + Header, Headers, JSON, Patch, + QueryParam, ReqBody, Server, + err403, err404, serveWithContext) import Servant.API.ResponseHeaders (addHeader) import Servant.Swagger @@ -46,28 +47,27 @@ import Types -- | Shortcut for common api result types. type ApiRes verb a = verb '[JSON] (ApiResult DBFail a) +-- The basic auth. +type BasicAuthURL = BasicAuth "smash" User + -- GET api/v1/metadata/{hash} type OfflineMetadataAPI = "api" :> "v1" :> "metadata" :> Capture "id" PoolId :> Capture "hash" PoolMetadataHash :> Get '[JSON] (Headers '[Header "Cache" Text] (ApiResult DBFail PoolMetadataWrapped)) -- GET api/v1/delisted type DelistedPoolsAPI = "api" :> "v1" :> "delisted" :> ApiRes Get [PoolId] +-- GET api/v1/errors +type FetchPoolErrorAPI = "api" :> "v1" :> "errors" :> Capture "poolId" PoolId :> QueryParam "fromDate" TimeStringFormat :> ApiRes Get [PoolFetchError] + #ifdef DISABLE_BASIC_AUTH -- POST api/v1/delist type DelistPoolAPI = "api" :> "v1" :> "delist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId type EnlistPoolAPI = "api" :> "v1" :> "enlist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId - -type FetchPoolErrorAPI = "api" :> "v1" :> "errors" :> QueryParam "poolId" PoolId :> ApiRes Get [PoolFetchError] #else --- The basic auth. -type BasicAuthURL = BasicAuth "smash" User - type DelistPoolAPI = BasicAuthURL :> "api" :> "v1" :> "delist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId type EnlistPoolAPI = BasicAuthURL :> "api" :> "v1" :> "enlist" :> ReqBody '[JSON] PoolId :> ApiRes Patch PoolId - -type FetchPoolErrorAPI = BasicAuthURL :> "api" :> "v1" :> "errors" :> QueryParam "poolId" PoolId :> ApiRes Get [PoolFetchError] #endif type RetiredPoolsAPI = "api" :> "v1" :> "retired" :> ApiRes Get [PoolId] @@ -288,8 +288,10 @@ getPoolOfflineMetadata dataLayer poolId poolHash = fmap (addHeader "always") . c -- |Get all delisted pools getDelistedPools :: DataLayer -> Handler (ApiResult DBFail [PoolId]) getDelistedPools dataLayer = convertIOToHandler $ do + let getAllDelisted = dlGetDelistedPools dataLayer allDelistedPools <- getAllDelisted + return . ApiResult . Right $ allDelistedPools @@ -320,7 +322,7 @@ enlistPool dataLayer poolId = convertIOToHandler $ do delistedPool' <- removeDelistedPool poolId case delistedPool' of - Left err -> throwIO err404 + Left err -> throwIO err404 Right poolId' -> return . ApiResult . Right $ poolId #else enlistPool :: DataLayer -> User -> PoolId -> Handler (ApiResult DBFail PoolId) @@ -330,40 +332,46 @@ enlistPool dataLayer user poolId = convertIOToHandler $ do delistedPool' <- removeDelistedPool poolId case delistedPool' of - Left err -> throwIO err404 + Left err -> throwIO err404 Right poolId' -> return . ApiResult . Right $ poolId' #endif - -#ifdef DISABLE_BASIC_AUTH -getPoolErrorAPI :: DataLayer -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError]) -getPoolErrorAPI dataLayer mPoolId = convertIOToHandler $ do +getPoolErrorAPI :: DataLayer -> PoolId -> Maybe TimeStringFormat -> Handler (ApiResult DBFail [PoolFetchError]) +getPoolErrorAPI dataLayer poolId mTimeInt = convertIOToHandler $ do let getFetchErrors = dlGetFetchErrors dataLayer - fetchErrors <- getFetchErrors mPoolId - return . ApiResult $ fetchErrors -#else -getPoolErrorAPI :: DataLayer -> User -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError]) -getPoolErrorAPI dataLayer _user mPoolId = convertIOToHandler $ do + -- Unless the user defines the date from which he wants to display the errors, + -- all the errors from the past day will be shown. We don't want to overwhelm + -- the operators. + fetchErrors <- case mTimeInt of + Nothing -> do + utcDayAgo <- getUTCTimeDayAgo + getFetchErrors poolId (Just utcDayAgo) - let getFetchErrors = dlGetFetchErrors dataLayer - fetchErrors <- getFetchErrors mPoolId + Just (TimeStringFormat time) -> getFetchErrors poolId (Just time) return . ApiResult $ fetchErrors -#endif + where + getUTCTimeDayAgo :: IO UTCTime + getUTCTimeDayAgo = + addUTCTime (-nominalDay) <$> getCurrentTime getRetiredPools :: DataLayer -> Handler (ApiResult DBFail [PoolId]) getRetiredPools dataLayer = convertIOToHandler $ do + let getRetiredPools = dlGetRetiredPools dataLayer retiredPools <- getRetiredPools + return . ApiResult $ retiredPools #ifdef TESTING_MODE retirePool :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId) retirePool dataLayer poolId = convertIOToHandler $ do + let addRetiredPool = dlAddRetiredPool dataLayer retiredPoolId <- addRetiredPool poolId + return . ApiResult $ retiredPoolId #endif diff --git a/src/Types.hs b/src/Types.hs index 36612b7..494e316 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -33,28 +33,30 @@ module Types -- * HTTP , FetchError (..) , PoolFetchError (..) + , TimeStringFormat (..) -- * Util , DBConversion (..) ) where import Cardano.Prelude -import Control.Monad.Fail (fail) +import Control.Monad.Fail (fail) -import Data.Aeson (FromJSON (..), ToJSON (..), object, - withObject, (.:), (.=)) -import qualified Data.Aeson as Aeson -import Data.Aeson.Encoding (unsafeToEncoding) -import qualified Data.Aeson.Types as Aeson -import Data.Time.Clock (UTCTime) +import Data.Aeson (FromJSON (..), ToJSON (..), object, + withObject, (.:), (.=)) +import qualified Data.Aeson as Aeson +import Data.Aeson.Encoding (unsafeToEncoding) +import qualified Data.Aeson.Types as Aeson +import Data.Time.Clock (UTCTime) import qualified Data.Time.Clock.POSIX as Time -import Data.Time.Format (formatTime, defaultTimeLocale) +import Data.Time.Format (defaultTimeLocale, formatTime, + parseTimeM) -import Data.Swagger (NamedSchema (..), ToParamSchema (..), - ToSchema (..)) -import Data.Text.Encoding (encodeUtf8Builder) +import Data.Swagger (NamedSchema (..), ToParamSchema (..), + ToSchema (..)) +import Data.Text.Encoding (encodeUtf8Builder) -import Servant (FromHttpApiData (..)) +import Servant (FromHttpApiData (..)) import Cardano.Db.Error import Cardano.Db.Types @@ -314,6 +316,22 @@ instance ToJSON PoolFetchError where formatTimeToNormal :: Time.POSIXTime -> Text formatTimeToNormal = toS . formatTime defaultTimeLocale "%d.%m.%Y. %T" . Time.posixSecondsToUTCTime +-- |Specific time string format. +newtype TimeStringFormat = TimeStringFormat { unTimeStringFormat :: UTCTime } + deriving (Eq, Show) + +instance FromHttpApiData TimeStringFormat where + --parseQueryParam :: Text -> Either Text a + parseQueryParam queryParam = + let timeFormat = "%d.%m.%Y" + + --parsedTime :: UTCTime <- parseTimeM False defaultTimeLocale "%d.%m.%Y %T" "04.03.2010 16:05:21" + parsedTime = parseTimeM False defaultTimeLocale timeFormat $ toS queryParam + in TimeStringFormat <$> parsedTime + +instance ToParamSchema TimeStringFormat where + toParamSchema _ = mempty + -- We need a "conversion" layer between custom DB types and the rest of the -- codebase se we can have a clean separation and replace them at any point. -- The natural place to have this conversion is in the types.