add: Read some basic stats from the database

KeyInfoService/src/KeyDB.hs

@@ -50,6 +50,17 @@ kdb_query_key_id_from_fp_sha3_512 = "SELECT id FROM crypto_key WHERE fp_sha3_512
 kdb_query_key_id_from_fp_whirlpool :: Query
 kdb_query_key_id_from_fp_whirlpool = "SELECT id FROM crypto_key WHERE fp_whirlpool = ?"
 
+kdb_query_stats_count_collection_group :: Query
+kdb_query_stats_count_collection_group = "SELECT COUNT(*) FROM collection_group"
+kdb_query_stats_count_collection_archive :: Query
+kdb_query_stats_count_collection_archive = "SELECT COUNT(*) FROM collection_archive"
+kdb_query_stats_count_document_bundle :: Query
+kdb_query_stats_count_document_bundle = "SELECT COUNT(*) FROM crypto_docbundle"
+kdb_query_stats_count_document_info :: Query
+kdb_query_stats_count_document_info = "SELECT COUNT(*) FROM crypto_document"
+kdb_query_stats_count_key_info :: Query
+kdb_query_stats_count_key_info = "SELECT COUNT(*) FROM crypto_key"
+
 kdb_query_key_id_from_FP :: Text -> IO Integer
 kdb_query_key_id_from_FP fp = do
     conn <- kdb_connect_default
@@ -73,3 +84,24 @@ kdb_list_collections_archives = do
     where
         row2kca :: (a -> b -> c -> KeyCollectionArchive) -> ((a, b, c) -> KeyCollectionArchive)
         row2kca f (a, b, c) = f a b c
+
+kdb_stats_query :: IO (Integer, Integer, Integer, Integer, Integer)
+kdb_stats_query = do
+    conn <- kdb_connect_default
+    cg <- run_one_int_query conn kdb_query_stats_count_collection_group
+    ca <- run_one_int_query conn kdb_query_stats_count_collection_archive
+    db <- run_one_int_query conn kdb_query_stats_count_document_bundle
+    di <- run_one_int_query conn kdb_query_stats_count_document_info
+    ki <- run_one_int_query conn kdb_query_stats_count_key_info
+    return (cg, ca, db, di, ki)
+    where
+        run_one_int_query :: Connection -> Query -> IO Integer
+        run_one_int_query conn query = do
+            result <- real_run_one_int_query conn query
+            let sanitized = Prelude.head $ result ++ [0]
+            return sanitized
+
+        real_run_one_int_query :: Connection -> Query -> IO [Integer]
+        real_run_one_int_query conn q = do
+            result <- query_ conn q
+            return $ fmap (\(Only x) -> x) $ result

KeyInfoService/src/kishttp.hs

@@ -123,7 +123,9 @@ ph_static_css = do
         -- "#337ab7"
 
 ph_homePage :: ServerPart Response
-ph_homePage =
+ph_homePage = do
+    (stats_cg, stats_ca, stats_db, stats_di, stats_ki) <- liftIO kdb_stats_query
+
     ok $ template_extra "Public Key Information Base" (link_canonical "/") $ do
         H.h1 "Welcome to the Public Key Information Database!"
         H.p "This interface provides you with condensed publically available information on public and private keys of various sources."
@@ -139,6 +141,28 @@ ph_homePage =
             "Is your key in the database? Use our "
             H.a ! A.href  "/search" $ "search"
             " to find out!."
+        H.p $ do
+            "Our database currently contains "
+            H.b ! A.class_ "stat count collections" $ do
+                H.toHtml $ show stats_ca
+                " collections"
+            " in "
+            H.b ! A.class_ "stat count collectiongroups" $ do
+                H.toHtml $ show stats_cg
+                " groups"
+            " with "
+            H.b ! A.class_ "stat count documents" $ do
+                H.toHtml $ show stats_di
+                " documents"
+            " in "
+            H.b ! A.class_ "stat count docbundles" $ do
+                H.toHtml $ show stats_db
+                " bundles"
+            " totalling "
+            H.b ! A.class_ "stat count keys" $ do
+                H.toHtml $ show stats_ki
+                " keys"
+            "."
 
 ph_submit :: ServerPart Response
 ph_submit = msum [ submit_get, submit_post, submit_fail ]