Merge pull request #1995 from input-output-hk/KtorZ/1867/pool-next-metadata-fetch

revised SQL query returning next pool metadata to fetch

Author: KtorZ

lib/core/src/Cardano/Pool/DB/Sqlite.hs

@@ -268,22 +268,32 @@ newDBLayer trace fp timeInterpreter = do
             let fetchAttempts = tableName (DBField PoolFetchAttemptsMetadataHash)
             let metadata      = tableName (DBField PoolMetadataHash)
             let query = T.unwords
-                    [ "SELECT"
-                    , metadataUrl, ",", metadataHash
-                    , "FROM", registrations
+                    [ "SELECT", "a." <> metadataUrl, ",", "a." <> metadataHash
+                    , "FROM", registrations, "AS a"
+                    , "LEFT JOIN", fetchAttempts, "AS b"
+                    , "ON"
+                        , "a." <> metadataUrl,  "=", "b." <> metadataUrl, "AND"
+                        , "a." <> metadataHash, "=", "b." <> metadataHash
                     , "WHERE"
-                    , metadataHash, "NOT", "IN" -- Successfully fetched metadata
+                        -- Successfully fetched metadata
+                        , "a." <> metadataHash, "NOT", "IN"
                         , "("
                         , "SELECT", metadataHash
                         , "FROM", metadata
                         , ")"
                     , "AND"
-                    , metadataHash, "NOT", "IN" -- Recently failed urls
+                        -- Discard recent failed attempts
                         , "("
-                        , "SELECT", metadataHash
-                        , "FROM", fetchAttempts
-                        , "WHERE", retryAfter, ">=", "datetime('now')"
+                        , retryAfter, "<", "datetime('now')"
+                        , "OR"
+                        , retryAfter, "IS NULL"
                         , ")"
+                    -- Important, since we have a limit, we order all results by
+                    -- earlist "retry_after", so that we are sure that all
+                    -- metadata gets _eventually_ processed.
+                    --
+                    -- Note that `NULL` is smaller than everything.
+                    , "ORDER BY", retryAfter, "ASC"
                     , "LIMIT", nLimit
                     , ";"
                     ]

lib/core/src/Cardano/Pool/Metadata.hs

@@ -169,7 +169,7 @@ fetchFromRemote tr builders manager url hash = runExceptTLog $ do
 
     getChunk :: URI -> ExceptT String IO (Maybe ByteString)
     getChunk uri = do
-        req <- requestFromURI uri
+        req <- withExceptT show $ except $ requestFromURI uri
         liftIO $ traceWith tr $ MsgFetchPoolMetadata hash uri
         ExceptT
             $ handle fromIOException