mirror of
https://github.com/codedownio/sandwich.git
synced 2024-09-19 07:37:25 +03:00
demo-fake-smtp-server: works to send and check an email
This commit is contained in:
parent
a6ab2942e7
commit
4378271c77
@ -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
|
||||
|
@ -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
|
||||
|
@ -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:
|
||||
|
@ -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
|
||||
|]
|
||||
|
Loading…
Reference in New Issue
Block a user