demo-fake-smtp-server: works to send and check an email

demos/demo-fake-smtp-server/app/Main.hs

@@ -4,11 +4,20 @@
 module Main where
 
 import Control.Concurrent
+import Control.Monad
 import Control.Monad.IO.Class
+import Control.Monad.Logger
+import qualified Data.ByteString.Lazy as BL
 import Data.String.Interpolate
+import Data.Text
+import Network.HTTP.Client
+import Network.HaskellNet.SMTP
+import Network.Mail.Mime
+import Network.Socket (PortNumber)
 import Sandwich.Contexts.FakeSmtpServer
 import Sandwich.Contexts.Files
 import Sandwich.Contexts.Nix
+import Sandwich.Contexts.Waits
 import Test.Sandwich
 import UnliftIO.Process
 
@@ -17,8 +26,39 @@ spec :: TopSpec
 spec = describe "Introducing a fake SMTP server" $
   introduceNixContext nixpkgsReleaseDefault $ introduceFakeSmtpServerNix defaultFakeSmtpServerOptions $ do
     it "prints the SMTP server port" $ do
-      server <- getContext fakeSmtpServer
-      info [i|Got fake SMTP server on port: #{fakeSmtpServerSmtpPort server}|]
+      FakeSmtpServer {..} <- getContext fakeSmtpServer
+      info [i|Got fake SMTP server on port: #{fakeSmtpServerSmtpPort}|]
+
+      sendSampleEmail "localhost" fakeSmtpServerSmtpPort
+      waitUntil 60 $ do
+        fakeSmtpServerGetEmails >>= \case
+          [x] -> debug [i|Got email: #{x}|]
+          xs -> expectationFailure [i|Unexpected emails result: #{xs}|]
+
+sendSampleEmail :: (MonadLoggerIO m) => String -> PortNumber -> m ()
+sendSampleEmail smtpHostname smtpPort = do
+  manager <- liftIO $ newManager defaultManagerSettings
+
+  mail <- liftIO $ simpleMailWithImages [Address (Just "To User") "to@codedown.io"] "from@codedown.io" "Subject" "Text body" "HTML body" [] []
+
+  let shouldAuth = False
+  -- let disableCertValidation = False
+
+  let smtpUsername = "username"
+  let smtpPassword = "password"
+
+  let doSMTPFn = doSMTPPort smtpHostname (fromIntegral smtpPort)
+  -- let doSMTPFn = doSMTPSSLWithSettings smtpHostname (defaultSettingsSMTPSSL {sslPort=(fromIntegral smtpPort), sslDisableCertificateValidation=disableCertValidation})
+  -- let doSMTPFn = doSMTPSTARTTLSWithSettings smtpHostname (defaultSettingsSMTPSTARTTLS {sslPort=(fromIntegral smtpPort), sslDisableCertificateValidation=disableCertValidation})
+
+  liftIO $ doSMTPFn $ \smtpConn -> do
+    authSucceed <- if shouldAuth then authenticate PLAIN smtpUsername smtpPassword smtpConn else return True
+    case authSucceed of
+      True -> do
+        forM_ (mailTo mail) $ \(Address _ to) -> do
+          let Address _ from = mailFrom mail
+          sendMail mail smtpConn
+      False -> expectationFailure [i|Failed to authenticate to SMTP server #{smtpHostname} (port #{smtpPort}) with username #{smtpUsername}|]
 
 main :: IO ()
 main = runSandwichWithCommandLineArgs defaultOptions spec

demos/demo-fake-smtp-server/demo-fake-smtp-server.cabal

@@ -27,9 +27,16 @@ executable demo-fake-smtp-server
       LambdaCase
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base
+      HaskellNet
+    , base
+    , bytestring
+    , http-client
+    , mime-mail
+    , monad-logger
+    , network
     , sandwich
     , sandwich-contexts
     , string-interpolate
+    , text
     , unliftio
   default-language: Haskell2010

demos/demo-fake-smtp-server/package.yaml

@@ -4,9 +4,16 @@ license:             BSD3
 
 dependencies:
 - base
+- bytestring
+- HaskellNet
+- http-client
+- mime-mail
+- monad-logger
+- network
 - sandwich
 - sandwich-contexts
 - string-interpolate
+- text
 - unliftio
 
 default-extensions:

sandwich-contexts/lib/Sandwich/Contexts/FakeSmtpServer/Derivation.hs

@@ -12,7 +12,7 @@ fakeSmtpServerDerivation = [i|
 { callPackage
 , fetchFromGitHub
 , node2nix
-, nodejs
+, nodejs_18
 , stdenv
 }:
 
@@ -25,8 +25,8 @@ let
     src = fetchFromGitHub {
       owner = "codedownio";
       repo = "fake-smtp-server";
-      rev = "102b72c1ec852d88309b290b6b68ff5b4f50a431";
-      sha256 = "sha256-uTcYGs5OOQ/uKfKYdmgnGYvBPfTALDoZsytqJEDTwHA=";
+      rev = "1adbffb35d6c90bcb2ad9fac3049fa2028a34d2f";
+      sha256 = "sha256-zXaNM7sp2c3IEvmoZ81M+7LrcC1I0JhlqG0A+gOA38E=";
     };
 
     dontConfigure = true;
@@ -34,7 +34,7 @@ let
     buildInputs = [node2nix];
 
     buildPhase = ''
-      node2nix -- --nodejs-14 --lock package-lock.json
+      node2nix -- --nodejs-18 --lock package-lock.json
     '';
 
     installPhase = ''
@@ -44,5 +44,5 @@ let
 
 in
 
-(callPackage nixified { inherit nodejs; }).package
+(callPackage nixified { nodejs = nodejs_18; }).package
 |]