diff --git a/chan-delorean.cabal b/chan-delorean.cabal index 0f7b264..219af2c 100644 --- a/chan-delorean.cabal +++ b/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 diff --git a/src/Common b/src/Common index 0d85d44..88b5f0d 160000 --- a/src/Common +++ b/src/Common @@ -1 +1 @@ -Subproject commit 0d85d44cbb5a50b4751751d5ca61707cc1b75587 +Subproject commit 88b5f0df7ea5e83a65a6c6153f197da7cd1c6217 diff --git a/src/Lib.hs b/src/Lib.hs index a792cbf..43ea5b5 100644 --- a/src/Lib.hs +++ b/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_ diff --git a/src/Main.hs b/src/Main.hs index 3073f00..d38e75d 100644 --- a/src/Main.hs +++ b/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." diff --git a/src/Network/DataClient.hs b/src/Network/DataClient.hs index 163fbfe..7c86010 100644 --- a/src/Network/DataClient.hs +++ b/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 diff --git a/src/Sync.hs b/src/Sync.hs index a4528c8..a459432 100644 --- a/src/Sync.hs +++ b/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