Lisää kätevämmät valitsimet lähetysosoitteelle

Aiemmin lähetysosoite piti kirjoittaa kometoriville muodossa, jossa
kaikki merkit on koodattu ASCIIksi. Nyt lähetysosoitteen nimen voi
määrittää --sender-name valitsimella, joka hyväksyy kaikki merkit
suoraan.

channels.scm

@@ -3,7 +3,7 @@
         (url "https://git.savannah.gnu.org/git/guix.git")
         (branch "master")
         (commit
-          "7309da3ba64a191f074807275d8c5661a25c035c")
+          "ee0cf3b9ff4cd5a9d3637d09677195ea9ee1a8c0")
         (introduction
           (make-channel-introduction
             "9edb3f66fd807b096b48283debdcddccfea34bad"

src/Main.hs

@@ -4,13 +4,14 @@
 
 module Main where
 
+import Control.Applicative (optional)
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (onException)
 import Control.Exception (throwIO)
 import Control.Monad (void, forever)
 import Data.Acid (AcidState(..), openLocalState, createCheckpoint, createArchive)
 import Data.Acid.Remote (skipAuthenticationCheck, acidServerSockAddr, openRemoteStateSockAddr, skipAuthenticationPerform)
-import Data.IMF (Mailbox, parse, mailbox)
+import Data.IMF (Mailbox(..), parse, mailbox)
 import Data.MIME.Charset (defaultCharsets)
 import Data.Text.Encoding (encodeUtf8)
 import Network.HostName (getHostName)
@@ -73,7 +74,7 @@ data RunMode = Server { repoPath :: FilePath, portNumber :: Int, checkpointDelay
 config :: Maybe Mailbox -> Parser Config
 config mail = Config
     <$> strOption (long "socket" <> short 's' <> metavar "FILE" <> value "/run/tiedote.md/acid.socket" <> showDefault <> help "Path for database socket")
-    <*> option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and receive mail")
+    <*> mailboxOption mail
     <*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> value "sendmail" <> help "Sendmail command")
     <*> hsubparser (command "server" (info serverCommand (progDesc "Run the server"))
         <> command "receive" (info (pure Receive) (progDesc "Receive an email"))
@@ -86,6 +87,14 @@ serverCommand = Server
     <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> showDefault <> help "TCP port number to listen on for webhook notifications")
     <*> option auto (long "checkpoint-delay" <> metavar "MINUTES" <> value (60 * 24 * 7) <> help "Number of minutes to wait between creating snapshots.")
 
+mailboxOption :: Maybe Mailbox -> Parser Mailbox
+mailboxOption mail = Mailbox
+    <$> optional (strOption (long "sender-name" <> metavar "NAME" <> help "Name to display as the mail's sender"))
+    -- XXX Data.IMF (as of purebred-email-0.6.0.2, 2023-10) doesn't expose the
+    -- addrSpec parser so we have to use this workaround
+    <*> ((\(Mailbox _ addrSpec) -> addrSpec) <$>
+        option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and receive mail"))
+
 readMailbox :: ReadM Mailbox
 readMailbox = eitherReader $ parse (mailbox defaultCharsets) . encodeUtf8 . T.pack