cheogram-smtp

Do not send empty emails for empty messages rss

created pr with cheogram-smtp/ignore-empty.1 on 2026-10-21T15:32:06Z · by 9e834e0d

changed pr name to Do not send empty emails for empty messages on 2026-10-21T15:32:32Z · by 9e834e0d

cmds

checkout latest patchset:

ssh pr.pico.sh pull cheogram-smtp:ignore-empty | git am -3

checkout specific patchset revision:

ssh pr.pico.sh pull cheogram-smtp:ignore-empty [rev] | git am -3

add changes to patch request:

git format-patch main --stdout | ssh pr.pico.sh cheogram-smtp:ignore-empty

add comment to patch request:

ssh pr.pico.sh comment cheogram-smtp:ignore-empty "lgtm!"

Patchset `cheogram-smtp/ignore-empty.1` on 2026-10-21T15:32:06Z · commit f3e3b55

Update version bounds for newer ghc

Stephen Paul Weber 2026-10-21T14:19:52Z

→ hlint clean

Stephen Paul Weber 2026-10-21T14:43:14Z

make test

Stephen Paul Weber 2026-10-21T14:43:29Z

This never fails

Stephen Paul Weber 2026-10-21T14:43:41Z

Do not send empty emails for empty messages

Stephen Paul Weber 2026-10-21T15:05:03Z

hlint clean

Stephen Paul Weber 2026-10-21T14:43:14Z

Semantic diff summary

0 added, 0 modified, 0 signature changed, 0 removed across 0 analyzed files (5 files skipped: unsupported file type)

+2 -1 IQManager.hs #

......@@ -2,6 +2,7 @@ module IQManager (iqManager, iqManager') where

import Prelude ()
import BasicPrelude
import Data.Functor                    (($>))
import Control.Concurrent.STM (
		STM, TMVar, TVar, modifyTVar', newEmptyTMVar, newTVar, orElse,
		readTVar, takeTMVar, tryPutTMVar, writeTVar

......@@ -38,7 +39,7 @@ iqSenderUnexceptional responseMapVar iqToSend = do
	atomicUIO $ modifyTVar' responseMapVar $
			Map.insert (XMPP.iqID iqToSend) iqResponseVar
	return (
			(waitDelay timeout *> pure Nothing)
			(waitDelay timeout $> Nothing)
			`orElse`
			fmap Just (takeTMVar iqResponseVar)
		)

+3 -3 MMS.hs #

......@@ -75,12 +75,12 @@ emailToMMS ::
	-> Maybe (MMS, [(CID.CID, ByteString)])
emailToMMS attachmentUrl ownerT email = do
		_ <- header "content-type"
		mid' <- fmap decodeUtf8 $ header "x-internal-message-id"
		mid' <- decodeUtf8 <$> header "x-internal-message-id"
		time' <- parseTimeM True defaultTimeLocale rfc822DateFormat .
			textToString . decodeUtf8 =<<
			header "date"
		from' <- addressTel =<<
			fmap (Address . MIME.Single) (fromMailbox email)
		from' <- addressTel . Address . MIME.Single =<<
			fromMailbox email
		owner' <- addressTel $ AddressLax ownerT
		return (MMS mid' time' to' from' owner' text' media', files)
	where

+3 -2 Util.hs #

......@@ -6,6 +6,7 @@ import Control.Concurrent.STM          (STM, atomically)
import Control.Applicative             (many)
import Control.Concurrent
	(ThreadId, forkFinally, myThreadId, throwTo)
import Data.Functor                    (($>))
import Data.Void                       (absurd)
import Control.Error                   (exceptT)
import Data.Time.Clock                 (UTCTime)

......@@ -46,7 +47,7 @@ escapeJid txt = mconcat result
			replace '@' "\\40" <|>
			fmap Text.singleton Atto.anyChar
		) <* Atto.endOfInput) txt
	replace c str = Atto.char c *> pure (fromString str)
	replace c str = Atto.char c $> fromString str

-- XEP-0106 says to only escape \ when absolutely necessary
slashEscape :: Atto.Parser Text

......@@ -66,7 +67,7 @@ unescapeJid txt = fromString result
			(Atto.char '\\' *> Atto.choice unescapes) <|>
			Atto.anyChar
		) <* Atto.endOfInput) txt
	unescapes = map (\(str, c) -> Atto.string (fromString str) *> pure c) [
	unescapes = map (\(str, c) -> Atto.string (fromString str) $> c) [
			("20", ' '), ("22", '"'), ("26", '&'), ("27", '\''),
			("2f", '/'), ("3a", ':'), ("3c", '<'), ("3e", '>'),
			("40", '@'), ("5c", '\\')

+2 -2 gateway.hs #

......@@ -60,7 +60,7 @@ iqSetHandler replyMap componentJid trustedJids iq@XMPP.IQ {
	} | to == componentJid && bareJid from `elem` trustedJids = do
		uuid <- liftIO UUID.nextRandom
		let Just sid =
			(XMPP.stanzaID =<< fmap RawComponentStanza payload) <|>
			(XMPP.stanzaID . RawComponentStanza =<< payload) <|>
			Just (UUID.toText uuid)
		atomicUIO $ STMMap.insert iq (Just sid) replyMap
		mapM_ XMPP.putStanza $

......@@ -199,7 +199,7 @@ iqGetHandler iq@XMPP.IQ {
				\Part of the Soprani.ca project.")
		]
	where
	nodeAttribute = fmap (\node -> (s"node", [XML.ContentText node])) $
	nodeAttribute = (\node -> (s"node", [XML.ContentText node])) <$>
		XML.attributeText (s"node") p
iqGetHandler iq = XMPP.putStanza $ iqError notImplemented iq

+1 -2 test/VCardTest.hs #

......@@ -29,8 +29,7 @@ data VCardResult = VCardResult VCard XMPP.IQ deriving (Show)
instance Arbitrary VCardResult where
	arbitrary = do
		vcard <- VCard <$> arbitrary <*> arbitrary <*> arbitrary
		iq <- XMPP.IQ <$>
			pure XMPP.IQResult <*>
		iq <- XMPP.IQ XMPP.IQResult <$>
			arbitrary <*>
			arbitrary <*>
			arbitrary <*>

...	...		@@ -2,6 +2,7 @@ module IQManager (iqManager, iqManager') where
2	2
3	3		import Prelude ()
4	4		import BasicPrelude
	5	+	import Data.Functor (($>))
5	6		import Control.Concurrent.STM (
6	7		STM, TMVar, TVar, modifyTVar', newEmptyTMVar, newTVar, orElse,
7	8		readTVar, takeTMVar, tryPutTMVar, writeTVar

...	...		@@ -38,7 +39,7 @@ iqSenderUnexceptional responseMapVar iqToSend = do
38	39		atomicUIO $ modifyTVar' responseMapVar $
39	40		Map.insert (XMPP.iqID iqToSend) iqResponseVar
40	41		return (
41		-	(waitDelay timeout *> pure Nothing)
	42	+	(waitDelay timeout $> Nothing)
42	43		`orElse`
43	44		fmap Just (takeTMVar iqResponseVar)
44	45		)

...	...		@@ -75,12 +75,12 @@ emailToMMS ::
75	75		-> Maybe (MMS, [(CID.CID, ByteString)])
76	76		emailToMMS attachmentUrl ownerT email = do
77	77		_ <- header "content-type"
78		-	mid' <- fmap decodeUtf8 $ header "x-internal-message-id"
	78	+	mid' <- decodeUtf8 <$> header "x-internal-message-id"
79	79		time' <- parseTimeM True defaultTimeLocale rfc822DateFormat .
80	80		textToString . decodeUtf8 =<<
81	81		header "date"
82		-	from' <- addressTel =<<
83		-	fmap (Address . MIME.Single) (fromMailbox email)
	82	+	from' <- addressTel . Address . MIME.Single =<<
	83	+	fromMailbox email
84	84		owner' <- addressTel $ AddressLax ownerT
85	85		return (MMS mid' time' to' from' owner' text' media', files)
86	86		where

...	...		@@ -6,6 +6,7 @@ import Control.Concurrent.STM (STM, atomically)
6	6		import Control.Applicative (many)
7	7		import Control.Concurrent
8	8		(ThreadId, forkFinally, myThreadId, throwTo)
	9	+	import Data.Functor (($>))
9	10		import Data.Void (absurd)
10	11		import Control.Error (exceptT)
11	12		import Data.Time.Clock (UTCTime)

...	...		@@ -46,7 +47,7 @@ escapeJid txt = mconcat result
46	47		replace '@' "\\40" <\|>
47	48		fmap Text.singleton Atto.anyChar
48	49		) <* Atto.endOfInput) txt
49		-	replace c str = Atto.char c *> pure (fromString str)
	50	+	replace c str = Atto.char c $> fromString str
50	51
51	52		-- XEP-0106 says to only escape \ when absolutely necessary
52	53		slashEscape :: Atto.Parser Text

...	...		@@ -66,7 +67,7 @@ unescapeJid txt = fromString result
66	67		(Atto.char '\\' *> Atto.choice unescapes) <\|>
67	68		Atto.anyChar
68	69		) <* Atto.endOfInput) txt
69		-	unescapes = map (\(str, c) -> Atto.string (fromString str) *> pure c) [
	70	+	unescapes = map (\(str, c) -> Atto.string (fromString str) $> c) [
70	71		("20", ' '), ("22", '"'), ("26", '&'), ("27", '\''),
71	72		("2f", '/'), ("3a", ':'), ("3c", '<'), ("3e", '>'),
72	73		("40", '@'), ("5c", '\\')

...	...		@@ -60,7 +60,7 @@ iqSetHandler replyMap componentJid trustedJids iq@XMPP.IQ {
60	60		} \| to == componentJid && bareJid from `elem` trustedJids = do
61	61		uuid <- liftIO UUID.nextRandom
62	62		let Just sid =
63		-	(XMPP.stanzaID =<< fmap RawComponentStanza payload) <\|>
	63	+	(XMPP.stanzaID . RawComponentStanza =<< payload) <\|>
64	64		Just (UUID.toText uuid)
65	65		atomicUIO $ STMMap.insert iq (Just sid) replyMap
66	66		mapM_ XMPP.putStanza $

...	...		@@ -199,7 +199,7 @@ iqGetHandler iq@XMPP.IQ {
199	199		\Part of the Soprani.ca project.")
200	200		]
201	201		where
202		-	nodeAttribute = fmap (\node -> (s"node", [XML.ContentText node])) $
	202	+	nodeAttribute = (\node -> (s"node", [XML.ContentText node])) <$>
203	203		XML.attributeText (s"node") p
204	204		iqGetHandler iq = XMPP.putStanza $ iqError notImplemented iq
205	205

...	...		@@ -29,8 +29,7 @@ data VCardResult = VCardResult VCard XMPP.IQ deriving (Show)
29	29		instance Arbitrary VCardResult where
30	30		arbitrary = do
31	31		vcard <- VCard <$> arbitrary <> arbitrary <> arbitrary
32		-	iq <- XMPP.IQ <$>
33		-	pure XMPP.IQResult <*>
	32	+	iq <- XMPP.IQ XMPP.IQResult <$>
34	33		arbitrary <*>
35	34		arbitrary <*>
36	35		arbitrary <*>

cheogram-smtp

Patchset cheogram-smtp/ignore-empty.1 on 2026-10-21T15:32:06Z · commit f3e3b55

Patchset `cheogram-smtp/ignore-empty.1` on 2026-10-21T15:32:06Z · commit f3e3b55