From 5862f87addaa123e43ad8d8851f416052c4f34fb Mon Sep 17 00:00:00 2001
From: Saku Laesvuori <saku@laesvuori.fi>
Date: Sat, 2 Sep 2023 13:59:06 +0300
Subject: [PATCH] =?UTF-8?q?Lis=C3=A4=C3=A4=20komento=20palvelimen=20tilan?=
 =?UTF-8?q?=20tulostamiseen?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Main.hs            | 14 ++++++++++++--
 src/TiedoteMD/Debug.hs |  8 ++++++++
 tiedote-md.cabal       |  1 +
 3 files changed, 21 insertions(+), 2 deletions(-)
 create mode 100644 src/TiedoteMD/Debug.hs

diff --git a/src/Main.hs b/src/Main.hs
index 0c9fd7f..8092977 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -30,6 +30,7 @@ import TiedoteMD.Review
 import TiedoteMD.Send
 import TiedoteMD.State
 import TiedoteMD.Types
+import TiedoteMD.Debug
 
 serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> IO ()
 serverMain socket mail repoPath sendmailPath = do
@@ -50,8 +51,15 @@ clientMain socket mail sendmailPath = do
         `onException` exitWith codeTempFail
     manageIncomingEmail acid mail sendmailPath
 
+printStateMain :: SockAddr -> IO ()
+printStateMain socket = do
+    acid <- openRemoteStateSockAddr skipAuthenticationPerform socket
+        `onException` openLocalState emptyState
+        `onException` exitWith codeTempFail
+    printState acid
+
 data Config = Config { socketPath :: FilePath, mail :: Mailbox, sendmailCommand :: String, runMode :: RunMode } deriving Show
-data RunMode = Server { repoPath :: FilePath } | Recieve deriving Show
+data RunMode = Server { repoPath :: FilePath } | Recieve | Print deriving Show
 
 config :: Maybe Mailbox -> Parser Config
 config mail = Config
@@ -59,7 +67,8 @@ config mail = Config
     <*> option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and recieve mail")
     <*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> value "sendmail" <> help "Sendmail command")
     <*> hsubparser (command "server" (info serverCommand (progDesc "Run the server"))
-        <> command "recieve" (info (pure Recieve) (progDesc "Recieve an email")))
+        <> command "recieve" (info (pure Recieve) (progDesc "Recieve an email"))
+        <> command "state" (info (pure Print) (progDesc "Print the server's current state")))
 
 serverCommand :: Parser RunMode
 serverCommand = Server <$> strOption (long "repository" <> short 'r' <> metavar "DIRECTORY" <> value "/var/lib/tiedote.md/git-repo" <> showDefault <> help "Path to git repository")
@@ -78,4 +87,5 @@ main = do
         findExecutable (sendmailCommand args)
     case args of
       Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
+      Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath)
       Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath
diff --git a/src/TiedoteMD/Debug.hs b/src/TiedoteMD/Debug.hs
new file mode 100644
index 0000000..cc714c8
--- /dev/null
+++ b/src/TiedoteMD/Debug.hs
@@ -0,0 +1,8 @@
+module TiedoteMD.Debug where
+
+import Data.Acid (AcidState, query)
+
+import TiedoteMD.State
+
+printState :: AcidState State -> IO ()
+printState acid = query acid GetState >>= print
diff --git a/tiedote-md.cabal b/tiedote-md.cabal
index aed9205..40a7c67 100644
--- a/tiedote-md.cabal
+++ b/tiedote-md.cabal
@@ -55,6 +55,7 @@ executable tiedote.md
     utf8-string
   main-is: Main.hs
   other-modules:
+    TiedoteMD.Debug
     TiedoteMD.Git
     TiedoteMD.Read
     TiedoteMD.Review