[CAD-1823] Stake pools with issues list.

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:

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

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
     }
 

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
 

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.