Implement remote acid-state support in blog

1 files changed, 24 insertions, 21 deletions

diff --git a/blog/Main.hs b/blog/Main.hs
index a50ca67ed17d..141a8e693c58 100644
--- a/blog/Main.hs
+++ b/blog/Main.hs
@@ -1,38 +1,41 @@
+-- | Main module for the blog's web server
 module Main where
 
-import           Control.Applicative          (pure, (<$>), (<*>))
-import           Control.Exception            (bracket)
+import           BlogDB              (initialBlogState)
+import           Control.Applicative (pure, (<$>), (<*>))
+import           Control.Exception   (bracket)
 import           Data.Acid
-import           Data.Acid.Local (createCheckpointAndClose)
+import           Data.Acid.Remote
+import           Data.Word           (Word16)
+import           Locales             (version)
+import           Network             (HostName, PortID (..))
 import           Options
-
-import           BlogDB                       (initialBlogState)
-import           Locales                      (version)
 import           Server
 
-{- Server -}
-
 data MainOptions = MainOptions {
-  optState :: String,
-  optPort  :: Int,
-  optRes   :: String
+  dbHost      :: String,
+  dbPort      :: Word16,
+  blogPort    :: Int,
+  resourceDir :: String
 }
 
 instance Options MainOptions where
   defineOptions = pure MainOptions
-    <*> simpleOption "statedir" "/var/tazblog/"
-        "Directory in which the BlogState is located."
-    <*> simpleOption "port" 8000
-        "Port to run on. Default is 8000."
-    <*> simpleOption "res" "/usr/share/tazblog/res"
+    <*> simpleOption "dbHost" "localhost"
+        "Remote acid-state database host. Default is localhost"
+    <*> simpleOption "dbPort" 8070
+        "Remote acid-state database port. Default is 8070"
+    <*> simpleOption "blogPort" 8000
+        "Port to serve the blog on. Default is 8000."
+    <*> simpleOption "resourceDir" "/opt/tazblog/res"
         "Resources folder location."
-        
+
 main :: IO()
 main = do
     putStrLn ("TazBlog " ++ version ++ " in Haskell starting")
-    runCommand $ \opts args ->
-      bracket (openLocalStateFrom (optState opts ++ "BlogState") initialBlogState)
-              createCheckpointAndClose
-              (\acid -> runBlog acid (optPort opts) (optRes opts))
+    runCommand $ \opts _ ->
+      let port = PortNumber $ fromIntegral $ dbPort opts
+      in openRemoteState skipAuthenticationPerform (dbHost opts) port >>=
+              (\acid -> runBlog acid (blogPort opts) (resourceDir opts))