Skip to content
This repository has been archived by the owner on Dec 8, 2022. It is now read-only.

[CAD-1744] Easily query reason for pool metadata lookup failure. #67

Merged
merged 1 commit into from
Sep 4, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 26 additions & 1 deletion doc/getting-started/how-to-install-smash.md
Original file line number Diff line number Diff line change
Expand Up @@ -284,4 +284,29 @@ curl -X GET -v http://localhost:3100/api/v1/metadata/062693863e0bcf9f619238f0207
curl -X GET -v http://localhost:3100/api/v1/metadata/062693863e0bcf9f619238f020741381d4d3748aae6faf1c012e80e7/3b842358a698119a4b0c0f4934d26cff69190552bf47a85f40f5d1d646c82699 | jq .
```

This assumes that you have a file called "test_pool.json" in your current directory that contains the JSON metadata for the stake pool.
This assumes that you have a file called "test_pool.json" in your current directory that contains the JSON
metadata for the stake pool.

## Checking the pool rejection errors

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:
```
http://localhost:3100/api/v1/errors
```

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?poolId=c0b0e43213a8c898e373928fbfc3df81ee77c0df7dadc3ad6e5bae17
```

The returned list consists of objects that contain:
- time - the time formatted in `DD.MM.YYYY. HH:MM:SS` which I claim, is the only sane choice
- utcTime - the time formatted in the standard UTCTime format for any clients
- poolId - the pool id of the owner of the pool
- poolHash - the hash of the pool metadata
- cause - what is the cause of the error and why is it failing
- retryCount - the number of times we retried to fetch the offline metadata

31 changes: 31 additions & 0 deletions schema/migration-2-0002-20200904.sql
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
-- Persistent generated migration.

CREATE FUNCTION migrate() RETURNS void AS $$
DECLARE
next_version int ;
BEGIN
SELECT stage_two + 1 INTO next_version FROM schema_version ;
IF next_version = 2 THEN
ALTER TABLE "pool_metadata_reference" ALTER COLUMN "pool_id" TYPE text;
ALTER TABLE "pool_metadata_reference" ALTER COLUMN "url" TYPE text;
ALTER TABLE "pool_metadata_reference" ALTER COLUMN "hash" TYPE text;
ALTER TABLE "pool_metadata" ALTER COLUMN "pool_id" TYPE text;
ALTER TABLE "pool_metadata" ALTER COLUMN "ticker_name" TYPE text;
ALTER TABLE "pool_metadata" ALTER COLUMN "hash" TYPE text;
ALTER TABLE "pool_metadata" ALTER COLUMN "metadata" TYPE text;
CREATe TABLE "pool_metadata_fetch_error"("id" SERIAL8 PRIMARY KEY UNIQUE,"fetch_time" timestamp NOT NULL,"pool_id" text NOT NULL,"pool_hash" text NOT NULL,"pmr_id" INT8 NOT NULL,"fetch_error" VARCHAR NOT NULL,"retry_count" uinteger NOT NULL);
ALTER TABLE "pool_metadata_fetch_error" ADD CONSTRAINT "unique_pool_metadata_fetch_error" UNIQUE("fetch_time","pool_id");
ALTER TABLE "pool_metadata_fetch_error" ADD CONSTRAINT "pool_metadata_fetch_error_pmr_id_fkey" FOREIGN KEY("pmr_id") REFERENCES "pool_metadata_reference"("id");
ALTER TABLE "delisted_pool" ALTER COLUMN "pool_id" TYPE text;
ALTER TABLE "reserved_ticker" ALTER COLUMN "name" TYPE text;
ALTER TABLE "reserved_ticker" ALTER COLUMN "pool_hash" TYPE text;
-- Hand written SQL statements can be added here.
UPDATE schema_version SET stage_two = 2 ;
RAISE NOTICE 'DB has been migrated to stage_two version %', next_version ;
END IF ;
END ;
$$ LANGUAGE plpgsql ;

SELECT migrate() ;

DROP FUNCTION migrate() ;
2 changes: 1 addition & 1 deletion smash.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ source-repository head

Flag disable-basic-auth
description: Disable basic authentication scheme for other authentication mechanisms.
default: True
default: False

library

Expand Down
7 changes: 7 additions & 0 deletions src/Cardano/Db/Insert.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ module Cardano.Db.Insert
, insertReservedTicker
, insertDelistedPool
, insertAdminUser
, insertPoolMetadataFetchError

-- Export mainly for testing.
, insertByReturnKey
Expand Down Expand Up @@ -56,6 +57,12 @@ insertDelistedPool = insertByReturnKey
insertAdminUser :: (MonadIO m) => AdminUser -> ReaderT SqlBackend m AdminUserId
insertAdminUser = insertByReturnKey

insertPoolMetadataFetchError
:: (MonadIO m)
=> PoolMetadataFetchError
-> ReaderT SqlBackend m PoolMetadataFetchErrorId
insertPoolMetadataFetchError = insertByReturnKey

-------------------------------------------------------------------------------

-- | Insert a record (with a Unique constraint), and return 'Right key' if the
Expand Down
13 changes: 13 additions & 0 deletions src/Cardano/Db/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module Cardano.Db.Query
, queryDelistedPool
, queryReservedTicker
, queryAdminUsers
, queryPoolMetadataFetchError
) where

import Cardano.Prelude hiding (Meta, from, isJust,
Expand Down Expand Up @@ -154,6 +155,18 @@ queryAdminUsers = do
res <- selectList [] []
pure $ entityVal <$> res

-- | Query all the errors we have.
queryPoolMetadataFetchError :: MonadIO m => Maybe Types.PoolId -> ReaderT SqlBackend m [PoolMetadataFetchError]
queryPoolMetadataFetchError Nothing = do
res <- selectList [] []
pure $ entityVal <$> res

queryPoolMetadataFetchError (Just poolId) = do
res <- select . from $ \(poolMetadataFetchError :: SqlExpr (Entity PoolMetadataFetchError)) -> do
where_ (poolMetadataFetchError ^. PoolMetadataFetchErrorPoolId ==. val poolId)
pure $ poolMetadataFetchError
pure $ fmap entityVal res

------------------------------------------------------------------------------------

maybeToEither :: e -> (a -> b) -> Maybe a -> Either e b
Expand Down
18 changes: 14 additions & 4 deletions src/Cardano/Db/Schema.hs
Original file line number Diff line number Diff line change
Expand Up @@ -60,15 +60,15 @@ share
PoolMetadataReference
poolId Types.PoolId sqltype=text
url Types.PoolUrl sqltype=text
hash Types.PoolMetadataHash sqltype=base16type
hash Types.PoolMetadataHash sqltype=text
UniquePoolMetadataReference poolId hash

-- The table containing the metadata.

PoolMetadata
poolId Types.PoolId sqltype=text
tickerName Types.TickerName sqltype=text
hash Types.PoolMetadataHash sqltype=base16type
hash Types.PoolMetadataHash sqltype=text
metadata Types.PoolMetadataRaw sqltype=text
pmrId PoolMetadataReferenceId Maybe
UniquePoolMetadata poolId hash
Expand All @@ -79,6 +79,17 @@ share
poolId PoolId sqltype=text
UniquePoolId poolId

-- The pool metadata fetch error. We duplicate the poolId for easy access.

PoolMetadataFetchError
fetchTime UTCTime sqltype=timestamp
poolId Types.PoolId sqltype=text
poolHash Types.PoolMetadataHash sqltype=text
pmrId PoolMetadataReferenceId
fetchError Text
retryCount Word sqltype=uinteger
UniquePoolMetadataFetchError fetchTime poolId

-- We actually need the block table to be able to persist sync data

Block
Expand All @@ -88,7 +99,6 @@ share
blockNo Word64 Maybe sqltype=uinteger
UniqueBlock hash


-- A table containing metadata about the chain. There will probably only ever be one
-- row in this table.
Meta
Expand All @@ -110,7 +120,7 @@ share
-- For now they are grouped under the specific hash of the pool.
ReservedTicker
name Text sqltype=text
poolHash Types.PoolMetadataHash sqltype=base16type
poolHash Types.PoolMetadataHash sqltype=text
UniqueReservedTicker name

-- A table containin a list of administrator users that can be used to access the secure API endpoints.
Expand Down
9 changes: 5 additions & 4 deletions src/Cardano/Db/Types.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
Expand All @@ -14,26 +15,26 @@ import Database.Persist.Class
--
-- It may be rendered as hex or as bech32 using the @pool@ prefix.
--
newtype PoolId = PoolId { getPoolId :: ByteString }
newtype PoolId = PoolId { getPoolId :: Text }
deriving stock (Eq, Show, Ord, Generic)
deriving newtype PersistField

instance ToJSON PoolId where
toJSON (PoolId poolId) =
object
[ "poolId" .= decodeUtf8 poolId
[ "poolId" .= poolId
]

instance FromJSON PoolId where
parseJSON = withObject "PoolId" $ \o -> do
poolId <- o .: "poolId"
return $ PoolId $ encodeUtf8 poolId
return $ PoolId poolId

-- | The hash of a stake pool's metadata.
--
-- It may be rendered as hex.
--
newtype PoolMetadataHash = PoolMetadataHash { getPoolMetadataHash :: ByteString }
newtype PoolMetadataHash = PoolMetadataHash { getPoolMetadataHash :: Text }
deriving stock (Eq, Show, Ord, Generic)
deriving newtype PersistField

Expand Down
1 change: 1 addition & 0 deletions src/Cardano/SmashDbSync.hs
Original file line number Diff line number Diff line change
Expand Up @@ -407,6 +407,7 @@ dbSyncProtocols trce env plugin _version codecs _connectionId =
(metrics, server) <- registerMetricsServer 8080
race_
(race_
-- TODO(KS): Watch out! We pass the data layer here directly!
(runDbThread trce env plugin metrics actionQueue)
(runOfflineFetchThread $ modifyName (const "fetch") trce)
)
Expand Down
27 changes: 27 additions & 0 deletions src/DB.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,11 +19,13 @@ import Cardano.Prelude

import Data.IORef (IORef, modifyIORef, readIORef)
import qualified Data.Map as Map
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)

import Types

import Cardano.Db.Insert (insertDelistedPool,
insertPoolMetadata,
insertPoolMetadataFetchError,
insertPoolMetadataReference,
insertReservedTicker)
import Cardano.Db.Query (DBFail (..), queryPoolMetadata)
Expand All @@ -38,6 +40,8 @@ import Cardano.Db.Schema as X (AdminUser (..), Block (..),
DelistedPool (..),
Meta (..),
PoolMetadata (..),
PoolMetadataFetchError (..),
PoolMetadataFetchErrorId,
PoolMetadataReference (..),
PoolMetadataReferenceId,
ReservedTicker (..),
Expand All @@ -52,12 +56,20 @@ import qualified Cardano.Db.Types as Types
data DataLayer = DataLayer
{ dlGetPoolMetadata :: PoolId -> PoolMetadataHash -> IO (Either DBFail (Text, Text))
, dlAddPoolMetadata :: Maybe PoolMetadataReferenceId -> PoolId -> PoolMetadataHash -> Text -> PoolTicker -> IO (Either DBFail Text)

, dlAddMetaDataReference :: PoolId -> PoolUrl -> PoolMetadataHash -> IO PoolMetadataReferenceId

, dlAddReservedTicker :: Text -> PoolMetadataHash -> IO (Either DBFail ReservedTickerId)
, dlCheckReservedTicker :: Text -> IO (Maybe ReservedTicker)

, dlCheckDelistedPool :: PoolId -> IO Bool
, dlAddDelistedPool :: PoolId -> IO (Either DBFail PoolId)

, dlGetAdminUsers :: IO (Either DBFail [AdminUser])

-- TODO(KS): Switch to PoolFetchError!
, dlAddFetchError :: PoolMetadataFetchError -> IO (Either DBFail PoolMetadataFetchErrorId)
, dlGetFetchErrors :: Maybe PoolId -> IO (Either DBFail [PoolFetchError])
} deriving (Generic)

-- | Simple stubbed @DataLayer@ for an example.
Expand Down Expand Up @@ -96,6 +108,9 @@ stubbedDataLayer ioDataMap ioDelistedPool = DataLayer
return $ Right poolId

, dlGetAdminUsers = return $ Right []

, dlAddFetchError = \_ -> panic "!"
, dlGetFetchErrors = \_ -> panic "!"
}

-- The approximation for the table.
Expand Down Expand Up @@ -148,5 +163,17 @@ postgresqlDataLayer = DataLayer
adminUsers <- runDbAction Nothing $ queryAdminUsers
return $ Right adminUsers

, dlAddFetchError = \poolMetadataFetchError -> do
poolMetadataFetchErrorId <- runDbAction Nothing $ insertPoolMetadataFetchError poolMetadataFetchError
return $ Right poolMetadataFetchErrorId

, dlGetFetchErrors = \mPoolId -> do
poolMetadataFetchErrors <- runDbAction Nothing (queryPoolMetadataFetchError mPoolId)
pure $ sequence $ Right <$> map convertPoolMetadataFetchError poolMetadataFetchErrors

}

convertPoolMetadataFetchError :: PoolMetadataFetchError -> PoolFetchError
convertPoolMetadataFetchError (PoolMetadataFetchError timeUTC poolId poolHash _pMRId fetchError retryCount) =
PoolFetchError (utcTimeToPOSIXSeconds timeUTC) poolId poolHash fetchError retryCount

6 changes: 3 additions & 3 deletions src/DbSyncPlugin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,20 +127,20 @@ insertPoolRegister
-> ExceptT DbSyncNodeError (ReaderT SqlBackend m) ()
insertPoolRegister tracer params = do
let poolIdHash = B16.encode . Shelley.unKeyHashBS $ Shelley._poolPubKey params
let poolId = PoolId poolIdHash
let poolId = PoolId . decodeUtf8 $ poolIdHash

liftIO . logInfo tracer $ "Inserting pool register with pool id: " <> decodeUtf8 poolIdHash
case strictMaybeToMaybe $ Shelley._poolMD params of
Just md -> do

liftIO . logInfo tracer $ "Inserting metadata."
let metadataUrl = PoolUrl . Shelley.urlToText $ Shelley._poolMDUrl md
let metadataHash = PoolMetadataHash . B16.encode $ Shelley._poolMDHash md
let metadataHash = PoolMetadataHash . decodeUtf8 . B16.encode $ Shelley._poolMDHash md

-- Ah. We can see there is garbage all over the code. Needs refactoring.
refId <- lift . liftIO $ (dlAddMetaDataReference postgresqlDataLayer) poolId metadataUrl metadataHash

liftIO $ fetchInsertNewPoolMetadata tracer refId poolId md
liftIO $ fetchInsertNewPoolMetadata postgresqlDataLayer tracer refId poolId md

liftIO . logInfo tracer $ "Metadata inserted."

Expand Down
1 change: 1 addition & 0 deletions src/FetchQueue.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module FetchQueue
( FetchQueue -- opaque
, PoolFetchRetry (..)
, Retry -- opaque
, retryCount
, emptyFetchQueue
, lenFetchQueue
, nullFetchQueue
Expand Down
34 changes: 30 additions & 4 deletions src/Lib.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,9 @@ import Servant (Application, BasicAuth,
BasicAuthData (..),
BasicAuthResult (..), Capture,
Context (..), Get, Handler (..),
JSON, Patch, ReqBody, Server, err403,
err404, serveWithContext)
JSON, Patch, QueryParam, ReqBody,
Server, err403, err404,
serveWithContext)
import Servant.Swagger

import DB
Expand All @@ -48,13 +49,18 @@ type OfflineMetadataAPI = "api" :> "v1" :> "metadata" :> Capture "id" PoolId :>
-- POST api/v1/delist
#ifdef DISABLE_BASIC_AUTH
type DelistPoolAPI = "api" :> "v1" :> "delist" :> 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 FetchPoolErrorAPI = BasicAuthURL :> "api" :> "v1" :> "errors" :> QueryParam "poolId" PoolId :> ApiRes Get [PoolFetchError]
#endif

type SmashAPI = OfflineMetadataAPI :<|> DelistPoolAPI
type SmashAPI = OfflineMetadataAPI :<|> DelistPoolAPI :<|> FetchPoolErrorAPI

-- | Swagger spec for Todo API.
todoSwagger :: Swagger
Expand Down Expand Up @@ -112,7 +118,7 @@ runAppStubbed configuration = do
mkAppStubbed :: Configuration -> IO Application
mkAppStubbed configuration = do

ioDataMap <- newIORef stubbedInitialDataMap
ioDataMap <- newIORef stubbedInitialDataMap
ioDelistedPools <- newIORef stubbedDelistedPools

let dataLayer :: DataLayer
Expand Down Expand Up @@ -212,6 +218,25 @@ server configuration dataLayer
= return todoSwagger
:<|> getPoolOfflineMetadata dataLayer
:<|> postDelistPool dataLayer
:<|> fetchPoolErrorAPI dataLayer

#ifdef DISABLE_BASIC_AUTH
fetchPoolErrorAPI :: DataLayer -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError])
fetchPoolErrorAPI dataLayer mPoolId = convertIOToHandler $ do

let getFetchErrors = dlGetFetchErrors dataLayer
fetchErrors <- getFetchErrors mPoolId

return . ApiResult $ fetchErrors
#else
fetchPoolErrorAPI :: DataLayer -> User -> Maybe PoolId -> Handler (ApiResult DBFail [PoolFetchError])
fetchPoolErrorAPI dataLayer _user mPoolId = convertIOToHandler $ do

let getFetchErrors = dlGetFetchErrors dataLayer
fetchErrors <- getFetchErrors mPoolId

return . ApiResult $ fetchErrors
#endif

#ifdef DISABLE_BASIC_AUTH
postDelistPool :: DataLayer -> PoolId -> Handler (ApiResult DBFail PoolId)
Expand All @@ -231,6 +256,7 @@ postDelistPool dataLayer user poolId = convertIOToHandler $ do
return . ApiResult $ delistedPool'
#endif


-- throwError err404
getPoolOfflineMetadata :: DataLayer -> PoolId -> PoolMetadataHash -> Handler (ApiResult DBFail PoolMetadataWrapped)
getPoolOfflineMetadata dataLayer poolId poolHash = convertIOToHandler $ do
Expand Down
Loading