chan-delorean.cabal

@@ -68,13 +68,10 @@ executable chan-delorean
     other-modules:
                       JSONParsing
                       DataClient
-                      JSONSettings
+                      Types
                       SitesType
                       BoardsType
                       ThreadType
-                      JSONPost
-                      JSONCommonTypes
-                      PostsType
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

shell.nix

@@ -9,7 +9,7 @@ let
       }:
       mkDerivation {
         pname = "chan-delorean";
-        version = "0.0.2";
+        version = "0.0.0.0";
         src = ./.;
         isLibrary = false;
         isExecutable = true;

sql/initialize.sql

@@ -110,69 +110,6 @@ CREATE INDEX attachments_post_id_idx        ON attachments (post_id);
 CREATE INDEX attachments_md5_hash_idx       ON attachments (md5_hash);
 CREATE INDEX attachments_phash_bktree_index ON attachments USING spgist (phash bktree_ops);
 
-
-/*
- * Function Definitions
- */
-
-/*
-CREATE OR REPLACE FUNCTION insert_posts_and_return_ids(new_posts posts[])
-RETURNS TABLE (post_id bigint, board_post_id bigint) AS $$
-WITH inserted AS (
-    INSERT INTO posts (board_post_id, creation_time, body, thread_id)
-    SELECT np.board_post_id, np.creation_time, np.body, np.thread_id
-    FROM unnest(new_posts) AS np
-    ON CONFLICT (thread_id, board_post_id) DO NOTHING
-    RETURNING post_id, board_post_id
-),
-selected AS (
-    SELECT post_id, board_post_id
-    FROM posts
-    WHERE (thread_id, board_post_id) IN (SELECT thread_id, board_post_id FROM unnest(new_posts))
-)
-SELECT * FROM inserted
-UNION ALL
-SELECT * FROM selected WHERE (post_id, board_post_id) NOT IN (SELECT post_id, board_post_id FROM inserted);
-$$ LANGUAGE sql;
-
--- 3m37s for clean db
--- 1m34s for full db (nothing inserted)
-
-*/
-
-CREATE OR REPLACE FUNCTION insert_posts_and_return_ids(new_posts posts[])
-RETURNS TABLE (post_id bigint, board_post_id bigint, thread_id bigint) AS $$
-WITH 
-selected AS (
-    SELECT post_id, board_post_id, thread_id
-    FROM posts
-    WHERE (thread_id, board_post_id) IN (SELECT thread_id, board_post_id FROM unnest(new_posts))
-),
-to_insert AS (
-    SELECT np.*
-    FROM unnest(new_posts) AS np
-    LEFT OUTER JOIN selected s ON np.thread_id = s.thread_id AND np.board_post_id = s.board_post_id
-    WHERE s.post_id IS NULL
-),
-inserted AS (
-    INSERT INTO posts (board_post_id, creation_time, body, thread_id)
-    SELECT board_post_id, creation_time, body, thread_id
-    FROM to_insert
-    RETURNING post_id, board_post_id, thread_id
-)
-SELECT * FROM inserted
-UNION ALL
-SELECT * FROM selected;
-$$ LANGUAGE sql;
-
--- 1:51 for clean db (this varies a lot)
--- 1:21 for full db (nothing inserted)
-
-
-/*
- * Permissions
- */
-
 CREATE ROLE chan_archive_anon nologin;
 GRANT CONNECT ON DATABASE chan_archives TO chan_archive_anon;
 GRANT SELECT ON sites                   TO chan_archive_anon;
@@ -193,12 +130,9 @@ GRANT ALL ON threads                    TO chan_archiver;
 GRANT ALL ON posts                      TO chan_archiver;
 GRANT ALL ON attachments                TO chan_archiver;
 GRANT EXECUTE ON FUNCTION update_post_body_search_index TO chan_archiver;
-GRANT EXECUTE ON FUNCTION insert_posts_and_return_ids   TO chan_archiver;
 GRANT usage, select ON SEQUENCE sites_site_id_seq TO chan_archiver;
 GRANT usage, select ON SEQUENCE boards_board_id_seq TO chan_archiver;
 GRANT usage, select ON SEQUENCE threads_thread_id_seq TO chan_archiver;
-GRANT usage, select ON SEQUENCE posts_post_id_seq       TO chan_archiver;
-
 GRANT chan_archiver TO admin;
 
 COMMIT;

src/Backfill.hs

@@ -1,3 +1,7 @@
+-- {-# LANGUAGE DeriveDataTypeable #-}
+-- {-# LANGUAGE DeriveGeneric #-}
+-- {-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
 import System.Exit
@@ -12,14 +16,13 @@ import qualified Data.Set as Set
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Data.Time.Clock (UTCTime)
 
+
 import JSONParsing
-import JSONSettings
+import Types
-import qualified JSONPost   as JSONPosts
 import qualified DataClient as Client
 import qualified SitesType as Sites
 import qualified BoardsType as Boards
 import qualified ThreadType as Threads
-import qualified PostsType  as Posts
 
 data SettingsCLI = SettingsCLI
   { jsonFile :: FilePath
@@ -28,7 +31,7 @@ data SettingsCLI = SettingsCLI
 settingsCLI :: SettingsCLI
 settingsCLI = SettingsCLI
     { jsonFile = def &= args &= typ "settings-jsonfile-path"
-    } &= summary "Backfill v0.0.2"
+    } &= summary "Backfill v0.0.1"
 
 
 listCatalogDirectories :: JSONSettings -> IO [FilePath]
@@ -161,107 +164,21 @@ ensureThreads settings board all_threads = do
             return $ archived_threads ++ new_threads
 
 
-readPosts
-    :: JSONSettings
-    -> Boards.Board
-    -> Threads.Thread
-    -> IO (Threads.Thread, [ JSONPosts.Post ])
-readPosts settings board thread = do
-    result <- parsePosts thread_filename
-
-    case result of
-        Left err -> do
-            putStrLn $ "Failed to parse the JSON file " ++ thread_filename ++ " error: " ++ err
-            exitFailure
-        Right posts_wrapper -> return $ (thread, JSONPosts.posts posts_wrapper)
-
-    where
-        thread_filename :: FilePath
-        thread_filename = backupDir </> "res" </> ((show $ Threads.board_thread_id thread) ++ ".json")
-
-        backupDir :: FilePath
-        backupDir = backup_read_root settings </> (Boards.pathpart board)
-
-
-ensurePosts
-    :: JSONSettings
-    -> Boards.Board
-    -> [(Threads.Thread, [ Posts.Post ])]
-    -> IO [(Threads.Thread, [ Posts.Post ])]
-ensurePosts = undefined
-
-
--- Convert Post to DbPost
-apiPostToArchivePost :: Threads.Thread -> JSONPosts.Post -> Posts.Post
-apiPostToArchivePost thread post = 
-    Posts.Post
-    { Posts.post_id         = Nothing
-    , Posts.board_post_id   = JSONPosts.no post
-    , Posts.creation_time   = posixSecondsToUTCTime (realToFrac $ JSONPosts.time post)
-    , Posts.body            = JSONPosts.com post
-    , Posts.thread_id       = Threads.thread_id thread
-    }
-
--- | A version of 'concatMap' that works with a monadic predicate.
--- Stolen from package extra Control.Monad.Extra
-concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
-{-# INLINE concatMapM #-}
-concatMapM op = foldr f (pure [])
-    where f x xs = do
-            x_ <- op x
-
-            if null x_
-            then xs
-            else do
-                xs_ <- xs
-                pure $ x_ ++ xs_
-
-
 processBoard :: JSONSettings -> Boards.Board -> IO ()
 processBoard settings board = do
-    let catalogPath = backupDir </> "catalog.json"
+    let catalogPath = backupDir </> (Boards.pathpart board) </> "catalog.json"
     putStrLn $ "catalog file path: " ++ catalogPath
 
-    result <- parseJSONCatalog catalogPath
+    result <- parseJSONFile catalogPath
 
     case result of
         Right catalogs -> do
             let threads_on_board = concatMap threads catalogs
 
-            all_threads_for_board :: [ Threads.Thread ] <- ensureThreads settings board threads_on_board
+            new_threads <- ensureThreads settings board threads_on_board
-
+            -- catalogs can be turned into [ Thread ]
-            all_posts_on_board :: [(Threads.Thread, [ JSONPosts.Post ])] <- mapM (readPosts settings board) all_threads_for_board
+            -- ensureThreads :: ( Board, [ Thread ] ) -> IO ()
-
+            -- mapM_ (print . no) threads_on_board
-            -- putStrLn $ "Number of posts on /" ++ (Boards.pathpart board) ++ "/ " ++ (show $ length all_posts_on_board)
-            posts_result <- Client.postPosts settings (concatMap (\(t, posts) -> map (apiPostToArchivePost t) posts) all_posts_on_board) 
-
-            -- TODO: why doesn't it insert posts for threads that already exist? we can have new posts!
-
-            case posts_result of
-                Left err -> print err
-                Right new_ids -> do
-                    putStrLn "Sum of post_ids:"
-                    print $ sum $ map Client.post_id new_ids
-                    putStrLn "Sum of board_post_ids:"
-                    print $ sum $ map Client.board_post_id new_ids
-
-            -- max:   18,645
-            -- min:   147
-            -- total: 191,628
-            --
-            -- f :: Threads.Thread -> [ Posts.Post ]
-            -- for each thread we have to call a function that
-            --  - reads the thread under the board directory:
-            --      - t = backupDir </> "res' </> ((show $ no thread) ++ ".json")
-            --
-            -- do we want an ensurethreads?
-            --      - then for each thread, grab the posts from json and see if they exist
-            --      - this might have to be done 350 times per board
-            --
-            -- So we need a function (Threads.Thread, [ Posts.Post ]) -> ??? [ new Post type? ]
-            --      - why?
-            --          - well because the new post type will have a thread_id, which is known to be unique
-            --          - so we need to query the db for this same (thread_id (from Thread), no (from Post))
             return ()
         Left errMsg    ->
             putStrLn $ "Failed to parse the JSON file in directory: "
@@ -269,7 +186,7 @@ processBoard settings board = do
 
   where
     backupDir :: FilePath
-    backupDir = backup_read_root settings </> (Boards.pathpart board)
+    backupDir = backup_read_root settings
 
 
 processBackupDirectory :: JSONSettings -> IO ()
@@ -291,7 +208,6 @@ processBackupDirectory settings = do
             let boards :: [ Boards.Board ] = archived_boards ++ created_boards
             mapM_ (processBoard settings) boards
 
-
 main :: IO ()
 main = do
     settingsValue <- cmdArgs settingsCLI

src/DataClient.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveAnyClass #-}
 
 module DataClient
   ( HttpError(..)
-  , PostId (..)
   , get
   , getSiteBoards
   , getAllSites
@@ -12,10 +10,8 @@ module DataClient
   , postBoards
   , getThreads
   , postThreads
-  , postPosts
   ) where
 
-import Data.Int (Int64)
 import Network.HTTP.Simple
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy.Char8 as LC8
@@ -31,24 +27,17 @@ import Data.Aeson
   , encode
   , Value
   )
-import GHC.Generics
 
-import qualified JSONSettings as T
+import qualified Types as T
 import qualified SitesType as Sites
 import qualified BoardsType as Boards
 import qualified ThreadType as Threads
-import qualified PostsType  as Posts
 
 data HttpError
     = HttpException SomeException
     | StatusCodeError Int LBS.ByteString
     deriving (Show)
 
-data PostId = PostId
-    { post_id :: Int64
-    , board_post_id :: Int64
-    , thread_id :: Int64
-    } deriving (Show, Generic, FromJSON)
 
 get :: T.JSONSettings -> String -> IO (Either HttpError LBS.ByteString)
 get settings path = do
@@ -76,7 +65,6 @@ post settings path payload return_repr = do
             $ initReq
 
     putStrLn $ "posting to " ++ requestUrl
-    -- putStrLn $ "Payload: " ++ (LC8.unpack payload)
     handleHttp (httpLBS req)
 
     where
@@ -162,17 +150,6 @@ getThreads settings board_id board_thread_ids =
         path = "/threads?board_thread_id=in.(" ++ ids ++ ")&board_id=eq." ++ show board_id
         ids :: String = intercalate "," $ map show board_thread_ids
 
-postPosts
-    :: T.JSONSettings
-    -> [ Posts.Post ]
-    -> IO (Either HttpError [ PostId ])
-postPosts settings posts =
-    post settings "/rpc/insert_posts_and_return_ids" payload True >>= return . eitherDecodeResponse
-
-    where
-      payload = encode $ object [ "new_posts" .= posts ]
-
-
 eitherDecodeResponse :: (FromJSON a) => Either HttpError LBS.ByteString -> Either HttpError a
 eitherDecodeResponse (Left err) = Left err
 eitherDecodeResponse (Right bs) =

src/JSONCommonTypes.hs

@@ -1,39 +0,0 @@
-module JSONCommonTypes
-  ( File (..)
-  , Cyclical (..)
-  ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Aeson
-import Data.Aeson.Types (typeMismatch)
-import GHC.Generics
-
-data Cyclical = Cyclical Int deriving (Show, Generic)
-
-instance FromJSON Cyclical where
-    parseJSON (Number n) = return $ Cyclical (floor n)
-    parseJSON (String s) =
-      case reads (T.unpack s) :: [(Int, String)] of
-      [(n, "")] -> return $ Cyclical n
-      _         -> typeMismatch "Int or String containing Int" (String s)
-
-    parseJSON invalid    = typeMismatch "Int or String" invalid
-
-
-data File = File
-  { id         :: Text
-  , mime       :: Maybe Text
-  , ext        :: Text
-  , h          :: Maybe Int
-  , w          :: Maybe Int
-  , fsize      :: Int
-  , filename   :: Text
-  , spoiler    :: Maybe Bool
-  , md5        :: Text
-  , file_path  :: Text
-  , thumb_path :: Text
-  } deriving (Show, Generic)
-
-instance FromJSON File
---instance ToJSON File

src/JSONParsing.hs

@@ -1,27 +1,36 @@
 module JSONParsing
     ( Thread(..)
+    , File(..)
     , Catalog(..)
-    , parseJSONCatalog
+    , parseJSONFile
-    , parsePosts
     ) where
 
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-import Data.Text (Text)
+import Data.Aeson
 import GHC.Generics
 import qualified Data.ByteString.Lazy as B
-import Data.Aeson
+import qualified Data.Text as T
+import Data.Aeson.Types (typeMismatch)
 
-import qualified JSONPost as Post
+data Cyclical = Cyclical Int deriving (Show, Generic)
-import qualified JSONCommonTypes as J
+
+instance FromJSON Cyclical where
+    parseJSON (Number n) = return $ Cyclical (floor n)
+    parseJSON (String s) =
+      case reads (T.unpack s) :: [(Int, String)] of
+      [(n, "")] -> return $ Cyclical n
+      _         -> typeMismatch "Int or String containing Int" (String s)
+
+    parseJSON invalid    = typeMismatch "Int or String" invalid
 
 data Thread = Thread
   { no            :: Int
-  , sub           :: Maybe Text
+  , sub           :: Maybe String
-  , com           :: Maybe Text
+  , com           :: Maybe String
-  , name          :: Maybe Text
+  , name          :: Maybe String
-  , capcode       :: Maybe Text
+  , capcode       :: Maybe String
   , time          :: Int
   , omitted_posts :: Maybe Int
   , omitted_images:: Maybe Int
@@ -29,27 +38,42 @@ data Thread = Thread
   , images        :: Maybe Int
   , sticky        :: Maybe Int
   , locked        :: Maybe Int
-  , cyclical      :: Maybe J.Cyclical
+  , cyclical      :: Maybe Cyclical
   , last_modified :: Int
-  , board         :: Text
+  , board         :: String
-  , files         :: Maybe [J.File]
+  , files         :: Maybe [File]
   , resto         :: Int
   , unique_ips    :: Maybe Int
   } deriving (Show, Generic)
 
-instance FromJSON Thread
+data File = File
---instance ToJSON Thread
+  { id         :: String
+  , mime       :: String
+  , ext        :: String
+  , h          :: Maybe Int
+  , w          :: Maybe Int
+  , fsize      :: Int
+  , filename   :: String
+  , spoiler    :: Maybe Bool
+  , md5        :: String
+  , file_path  :: String
+  , thumb_path :: String
+  } deriving (Show, Generic)
 
 data Catalog = Catalog
   { threads :: [Thread]
   , page    :: Int
   } deriving (Show, Generic)
 
+instance FromJSON Thread
+--instance ToJSON Thread
+instance FromJSON File
+--instance ToJSON File
 instance FromJSON Catalog
 --instance ToJSON Catalog
 
-parseJSONCatalog :: FilePath -> IO (Either String [Catalog])
-parseJSONCatalog path = B.readFile path >>= return . eitherDecode
 
-parsePosts :: FilePath -> IO (Either String Post.PostWrapper)
+parseJSONFile :: FilePath -> IO (Either String [Catalog])
-parsePosts path = B.readFile path >>= return . eitherDecode
+parseJSONFile path = do
+    jsonData <- B.readFile path
+    return $ eitherDecode jsonData

src/JSONPost.hs

@@ -1,35 +0,0 @@
-module JSONPost
-  ( Post (..)
-  , PostWrapper (..)
-  ) where
-
-import Data.Text (Text)
-import Data.Int (Int64)
-import Data.Aeson (FromJSON)
-import GHC.Generics
-import qualified JSONCommonTypes as J
-
-data Post = Post
-    { no             :: Int64
-    , com            :: Maybe Text
-    , name           :: Maybe Text
-    , time           :: Int
-    , omitted_posts  :: Maybe Int
-    , omitted_images :: Maybe Int
-    , sticky         :: Maybe Int
-    , locked         :: Maybe Int
-    , cyclical       :: Maybe J.Cyclical
-    , last_modified  :: Int
-    , board          :: String
-    , files          :: Maybe [J.File]
-    , resto          :: Int
-    , unique_ips     :: Maybe Int
-    } deriving (Show, Generic)
-
-instance FromJSON Post
-
-data PostWrapper = PostWrapper
-    { posts :: [Post]
-    } deriving (Show, Generic)
-
-instance FromJSON PostWrapper

src/PostsType.hs

@@ -1,19 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
-module PostsType
-    ( Post (..) )
-    where
-
-import GHC.Generics
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Time.Clock (UTCTime) -- Required for timestamp with time zone
-import Data.Int (Int64)
-import Data.Text (Text)
-
-data Post = Post
-    { post_id         :: Maybe Int64
-    , board_post_id   :: Int64
-    , creation_time   :: UTCTime
-    , body            :: Maybe Text
-    , thread_id       :: Int
-    } deriving (Show, Generic, FromJSON, ToJSON)

src/Types.hs

@@ -1,4 +1,4 @@
-module JSONSettings
+module Types
   ( JSONSettings(..)
   ) where