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 4671bb5

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

This never fails

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

Semantic diff summary

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

+5 -5 Email.hs #

......@@ -597,12 +597,12 @@ messageToMIME ::
	   (MIME.Boundary, MIME.Boundary)
	-> [Attachment]
	-> XMPP.Message
	-> Either XMPP.Message MIME.MIMEMessage
	-> MIME.MIMEMessage
messageToMIME
	(b1, b2)
	attachments
	message@XMPP.Message { XMPP.messagePayloads = payload }
	| [xdc] <- XML.isNamed (s"{urn:xmpp:webxdc:0}x") =<< payload = Right $
	| [xdc] <- XML.isNamed (s"{urn:xmpp:webxdc:0}x") =<< payload =
		MIME.createMultipartMixedMessage b1 (NonEmpty.fromList [
			createMultipartMessage b2
			(MIME.Report $ s"status-update")

......@@ -616,8 +616,8 @@ messageToMIME
		])
	| Just bodyTxt <- getBody message,
		null attachments =
		Right $ MIME.createTextPlainMessage bodyTxt
	| otherwise = Right $
		MIME.createTextPlainMessage bodyTxt
	| otherwise =
		MIME.createMultipartMixedMessage b1 $ NonEmpty.fromList $
		justZ (MIME.createTextPlainMessage <$> getBody message) ++
		map (\(Attachment mime name bytes) ->

......@@ -635,7 +635,7 @@ messageToEmailIO domain message = do
	now <- fromIO_ getCurrentTime
	let mime = messageToMIME boundaries attachments message
	let xdc = any (matchWebXDC . mimeType) attachments
	return $ messageToEmail domain now xdc message =<< mime
	return $ messageToEmail domain now xdc message mime

matchWebXDC :: MIME.ContentType -> Bool
matchWebXDC = MIME.matchContentType (s"application") (Just $ s"webxdc+zip")

+1 -1 test/EmailTest.hs #

......@@ -70,7 +70,7 @@ messageToEmailTest ::
	-> Either XMPP.Message EmailWithEnvelope
messageToEmailTest d now as m =
	messageToEmail d now xdc m =<<
	messageToMIME (boundary1, boundary2) as m
	pure (messageToMIME (boundary1, boundary2) as m)
	where
	xdc = any (matchWebXDC . mimeType) as

...	...		@@ -597,12 +597,12 @@ messageToMIME ::
597	597		(MIME.Boundary, MIME.Boundary)
598	598		-> [Attachment]
599	599		-> XMPP.Message
600		-	-> Either XMPP.Message MIME.MIMEMessage
	600	+	-> MIME.MIMEMessage
601	601		messageToMIME
602	602		(b1, b2)
603	603		attachments
604	604		message@XMPP.Message { XMPP.messagePayloads = payload }
605		-	\| [xdc] <- XML.isNamed (s"{urn:xmpp:webxdc:0}x") =<< payload = Right $
	605	+	\| [xdc] <- XML.isNamed (s"{urn:xmpp:webxdc:0}x") =<< payload =
606	606		MIME.createMultipartMixedMessage b1 (NonEmpty.fromList [
607	607		createMultipartMessage b2
608	608		(MIME.Report $ s"status-update")

...	...		@@ -616,8 +616,8 @@ messageToMIME
616	616		])
617	617		\| Just bodyTxt <- getBody message,
618	618		null attachments =
619		-	Right $ MIME.createTextPlainMessage bodyTxt
620		-	\| otherwise = Right $
	619	+	MIME.createTextPlainMessage bodyTxt
	620	+	\| otherwise =
621	621		MIME.createMultipartMixedMessage b1 $ NonEmpty.fromList $
622	622		justZ (MIME.createTextPlainMessage <$> getBody message) ++
623	623		map (\(Attachment mime name bytes) ->

...	...		@@ -635,7 +635,7 @@ messageToEmailIO domain message = do
635	635		now <- fromIO_ getCurrentTime
636	636		let mime = messageToMIME boundaries attachments message
637	637		let xdc = any (matchWebXDC . mimeType) attachments
638		-	return $ messageToEmail domain now xdc message =<< mime
	638	+	return $ messageToEmail domain now xdc message mime
639	639
640	640		matchWebXDC :: MIME.ContentType -> Bool
641	641		matchWebXDC = MIME.matchContentType (s"application") (Just $ s"webxdc+zip")

...	...		@@ -70,7 +70,7 @@ messageToEmailTest ::
70	70		-> Either XMPP.Message EmailWithEnvelope
71	71		messageToEmailTest d now as m =
72	72		messageToEmail d now xdc m =<<
73		-	messageToMIME (boundary1, boundary2) as m
	73	+	pure (messageToMIME (boundary1, boundary2) as m)
74	74		where
75	75		xdc = any (matchWebXDC . mimeType) as
76	76

cheogram-smtp

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

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