Can now update archive from url

src/Lib.hs

@@ -378,7 +378,6 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
             to_insert_ <- mapM ensureAttachmentExists to_insert
 
             let to_insert_exist = catMaybes to_insert_
-            -- to_insert_exist <- filterM attachmentFileExists to_insert
 
             with_hashes <- mapM computeAttachmentHash to_insert_exist
 
@@ -391,7 +390,7 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
 
                 Right saved -> do
                     putStrLn $ "Saved " ++ (show $ length saved) ++ " attachments!"
-                    mapM_ (copyOrMoveFiles settings fgs) attachments_on_board
+                    mapM_ (copyOrMoveFiles settings fgs) to_insert_exist
 
     where
         ensureAttachmentExists :: Details -> IO (Maybe Details)

src/Main.hs

@@ -9,7 +9,7 @@ import Data.Aeson (decode)
 import System.FilePath ((</>))
 import Control.Concurrent.Async (mapConcurrently)
 import Data.Aeson (FromJSON)
-import System.Directory (createDirectoryIfMissing, renameFile)
+import System.Directory (createDirectoryIfMissing, removeFile)
 
 import qualified SitesType as Sites
 import Common.Server.ConsumerSettings
@@ -54,6 +54,13 @@ getSettings = do
                 exitFailure
             Just settings -> return settings
 
+
+-- Move a file by reading, writing, and then deleting the original
+moveFile :: FilePath -> FilePath -> IO ()
+moveFile src dst =
+    B.readFile src >>= B.writeFile dst >> removeFile src
+
+
 httpFileGetters :: JSONSettings -> FileGetters
 httpFileGetters settings = FileGetters
     { getJSONCatalog = httpGetJSON
@@ -66,12 +73,14 @@ httpFileGetters settings = FileGetters
         thumbpath <- Client.getFile (At.thumbnail_path paths)
 
         return $ filepath >>= \fp ->
-            thumbpath >>= \tp ->
+            thumbpath >>= \tp -> do
                 return (At.Paths fp tp)
+
     , copyOrMove = \common_dest (src, dest) (thumb_src, thumb_dest) -> do
+        putStrLn $ "Copy Or Move (Move) src: " ++ src ++ " dest: " ++ dest
         createDirectoryIfMissing True common_dest
-        renameFile src dest
+        moveFile src dest
-        renameFile thumb_src thumb_dest
+        moveFile thumb_src thumb_dest
     }
 
 httpGetJSON :: (FromJSON a) => Sites.Site -> String -> IO (Either String a)

src/Network/DataClient.hs

@@ -39,6 +39,7 @@ import Data.Aeson
   )
 import GHC.Generics
 import System.IO.Temp (openBinaryTempFile, getCanonicalTemporaryDirectory)
+import System.IO (hClose)
 
 import qualified Common.Server.JSONSettings as T
 import qualified SitesType as Sites
@@ -226,15 +227,20 @@ getJSON url = get_ url [] >>= return . eitherDecodeResponse
 
 getFile :: String -> IO (Maybe String)
 getFile url = do
+    putStrLn $ "getFile " ++ url
     result <- get_ url []
 
     case result of
         Left (err :: HttpError) -> do
+            putStrLn $ "getFile " ++ url ++ " Error!"
             putStrLn $ show err
             return Nothing
         Right lbs -> do
+            putStrLn $ "getFile " ++ url ++ " SUCCESS!"
             tmp_root <- getCanonicalTemporaryDirectory
             (tmp_filepath, tmp_filehandle) <- openBinaryTempFile tmp_root "chan.attachment"
-            LBS.writeFile tmp_filepath lbs
+            putStrLn $ "Created " ++ tmp_filepath
+            putStrLn $ "Writing attachment..."
             LBS.hPut tmp_filehandle lbs
+            hClose tmp_filehandle
             return $ Just tmp_filepath