sync ensures sites

chan-delorean.cabal

@@ -136,6 +136,7 @@ executable chan-delorean-consoomer
                       Data.WordUtil
                       Network.DataClient
                       Network.DataClientTypes
+                      Network.GetLatestPostsPerBoardResponse
                       Common.Server.ConsumerSettings
                       Common.Server.JSONSettings
                       PriorityQueue
@@ -165,7 +166,8 @@ executable chan-delorean-consoomer
                       async,
                       temporary,
                       stm,
-                      random
+                      random,
+                      transformers
 
     -- Directories containing source files.
     hs-source-dirs:   src

src/Common

@@ -1 +1 @@
-Subproject commit 0d85d44cbb5a50b4751751d5ca61707cc1b75587
+Subproject commit 88b5f0df7ea5e83a65a6c6153f197da7cd1c6217

src/Lib.hs

@@ -36,7 +36,6 @@ import qualified Data.ByteString.Lazy as B
 import Data.Aeson (FromJSON)
 
 import JSONParsing
-import Common.Server.JSONSettings
 import qualified JSONCommonTypes as JS
 import qualified JSONPost   as JSONPosts
 import qualified Network.DataClient as Client
@@ -45,9 +44,10 @@ import qualified BoardsType as Boards
 import qualified ThreadType as Threads
 import qualified Common.AttachmentType as At
 import qualified Common.PostsType as Posts
-import qualified Hash as Hash
+import qualified Hash
 import qualified Data.WordUtil as Words
 import Common.Server.JSONSettings as J
+import Common.Network.HttpClient (HttpError)
 import qualified Common.Server.ConsumerSettings as CS
 
 newtype SettingsCLI = SettingsCLI
@@ -75,10 +75,8 @@ listCatalogDirectories settings = do
       doesFileExist catalogPath
 
 
-ensureSiteExists :: JSONSettings -> IO Sites.Site
-ensureSiteExists settings = do
-    sitesResult <- Client.getAllSites settings
-
+ensureSiteExists :: JSONSettings -> Either HttpError [ Sites.Site ] -> IO Sites.Site
+ensureSiteExists settings sitesResult = do
     case sitesResult of
         Right siteList ->
             case find (\site -> Sites.name site == site_name settings) siteList of
@@ -696,7 +694,9 @@ processBoard settings fgs@FileGetters {..} site board = do
 
 getBoards :: JSONSettings -> [ FilePath ] -> IO (Sites.Site, [ Boards.Board ])
 getBoards settings board_names = do
-    site :: Sites.Site <- ensureSiteExists settings
+    sitesResult <- Client.getAllSites settings
+    site :: Sites.Site <- ensureSiteExists settings sitesResult
+
     let boardsSet = Set.fromList board_names
     let site_id_ = Sites.site_id site
     boards_result <- Client.getSiteBoards settings site_id_

src/Main.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use when" #-}
 
 module Main (main) where
 
@@ -6,7 +8,7 @@ import System.Exit (exitFailure)
 import qualified Data.ByteString.Lazy as B
 import System.Console.CmdArgs (cmdArgs, Data, Typeable)
 import Data.Aeson (decode)
-import Control.Concurrent.Async (mapConcurrently)
+import Control.Concurrent.Async (mapConcurrently_)
 
 import Common.Server.ConsumerSettings
 import Lib
@@ -53,12 +55,15 @@ main = do
     _ <- if http_fill_all settings
     then do
         putStrLn "Starting web backfill"
-        mapConcurrently (processWebsite settings) (websites settings)
-    else return []
-
-    if http_sync_continously settings
-    then syncWebsites settings
+        mapConcurrently_ (processWebsite settings) (websites settings)
+        putStrLn "Finished web backfill"
     else return ()
 
-    putStrLn "Done"
+    if http_sync_continously settings
+    then do
+        putStrLn "Starting web sync loop"
+        syncWebsites settings
+    else return ()
+
+    putStrLn "Done. Quitting."
 

src/Network/DataClient.hs

@@ -222,7 +222,7 @@ eitherDecodeResponse (Left err) = Left err
 eitherDecodeResponse (Right bs) =
     case eitherDecode bs of
         Right val -> Right val
-        Left err -> Left $ StatusCodeError 500 $ LC8.pack $ "Failed to decode JSON: " ++ err ++ " " ++ (show bs)
+        Left err -> Left $ StatusCodeError 500 $ LC8.pack $ "Failed to decode JSON: " ++ err ++ " " ++ show bs
 
 
 getJSON :: (FromJSON a) => String -> IO (Either HttpError a)
@@ -250,7 +250,6 @@ getFile url = do
             return $ Just tmp_filepath
 
 
--- | Function to handle each chunk.
 getLatestPostsPerBoard :: T.JSONSettings -> IO (Either HttpError [ GLPPBR.GetLatestPostsPerBoardResponse ])
 getLatestPostsPerBoard settings =
     post settings "/rpc/get_latest_posts_per_board" mempty False >>= return . eitherDecodeResponse

src/Sync.hs

@@ -2,32 +2,40 @@
 
 module Sync where
 
-import Common.Server.ConsumerSettings as Settings
-import Common.Server.JSONSettings as JSONSettings
-import Network.DataClient (getLatestPostsPerBoard)
+import qualified Common.Server.ConsumerSettings as S
+import qualified Common.Server.JSONSettings as JS
+import qualified Network.DataClient as Client
+import qualified Lib
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 
-consumerSettingsToPartialJSONSettings :: Settings.ConsumerJSONSettings -> JSONSettings.JSONSettings
-consumerSettingsToPartialJSONSettings ConsumerJSONSettings {..} =
-    JSONSettings
-        { JSONSettings.postgrest_url = postgrest_url
-        , JSONSettings.jwt = jwt
+consumerSettingsToPartialJSONSettings :: S.ConsumerJSONSettings -> JS.JSONSettings
+consumerSettingsToPartialJSONSettings S.ConsumerJSONSettings {..} =
+    JS.JSONSettings
+        { JS.postgrest_url = postgrest_url
+        , JS.jwt = jwt
         , backup_read_root = undefined
-        , JSONSettings.media_root_path
+        , JS.media_root_path
         , site_name = undefined
         , site_url = undefined
         }
 
-syncWebsites :: ConsumerJSONSettings -> IO ()
+syncWebsites :: S.ConsumerJSONSettings -> IO ()
 syncWebsites consumer_settings = do
     putStrLn "Starting channel web synchronization."
 
     let json_settings = consumerSettingsToPartialJSONSettings consumer_settings
 
-    asdf <- getLatestPostsPerBoard json_settings
+    sitesResult <- Client.getAllSites json_settings
 
-    print asdf
-    -- first we need all the (Site, Board) tuples
-    -- perhaps we even want all (Site, Board, Thread) pairs
+    sites <- mapM (flip Lib.ensureSiteExists sitesResult . Lib.toClientSettings consumer_settings) (S.websites consumer_settings)
+
+    print sites
+
+    latest_posts_per_board <- Client.getLatestPostsPerBoard json_settings
+
+    print latest_posts_per_board
+    -- first we need all the (Site, Board) tuples ✓
+    -- perhaps we even want all (Site, Board, Thread) ✓
     -- But then we don't load the posts of each thread, instead only do
     -- that for threads which change,
     --    - which means after we get all the threads
@@ -37,3 +45,15 @@ syncWebsites consumer_settings = do
     --        - load only the changed/new ones
     --        - put board back
 
+
+    -- NEW TODO:
+    --  - ensure that sites in the settings exist in the database! ✓
+    --  - ensure that boards per site in the settings exist in the database!
+    --  - finish using ExceptT and use sites, latest_posts_per_board to populate
+    --    our PriorityQueue
+    --  - write event loop that
+    --       - get pq from stm shared value
+    --       - uses the pq (there was something about the timestamps in the pq having to be reversed btw)
+    --       - ensures threads
+    --       - has a value that should be added to the pq
+    --       - uses stm to update pq shared value