Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
I
iTasks-SDK
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
62
Issues
62
List
Boards
Labels
Milestones
Merge Requests
5
Merge Requests
5
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
iTasks-SDK
Commits
ddd8e2de
Commit
ddd8e2de
authored
Nov 27, 2019
by
Camil Staps
🍃
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'emailAttachments' into 'master'
make to possible to add attachments to emails See merge request
!361
parents
62fabb05
36bcb476
Pipeline
#33955
passed with stage
in 6 minutes and 57 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
64 additions
and
19 deletions
+64
-19
Libraries/iTasks/Extensions/Email.dcl
Libraries/iTasks/Extensions/Email.dcl
+10
-2
Libraries/iTasks/Extensions/Email.icl
Libraries/iTasks/Extensions/Email.icl
+54
-17
No files found.
Libraries/iTasks/Extensions/Email.dcl
View file @
ddd8e2de
...
...
@@ -14,8 +14,9 @@ import iTasks
* @param Recipients: The recipient addresses
* @param Subject: The subject line of the e-mail message
* @param Body: The body of the e-mail message
* @param Attachments: Attachments added to the e-mail message
*/
sendEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
String
->
Task
()
sendEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
String
![
Attachment
]
->
Task
()
/**
* Send an e-mail message with HTML body.
...
...
@@ -25,8 +26,9 @@ sendEmail :: ![EmailOpt] !String ![String] !String !String -> Task ()
* @param Recipients: The recipient addresses
* @param Subject: The subject line of the e-mail message
* @param Body: The HTML body of the e-mail message. Text has to be UTF-8 encoded.
* @param Attachments: Attachments added to the e-mail message.
*/
sendHtmlEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
HtmlTag
->
Task
()
sendHtmlEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
HtmlTag
![
Attachment
]
->
Task
()
//Options for sendEmail
::
EmailOpt
...
...
@@ -34,3 +36,9 @@ sendHtmlEmail :: ![EmailOpt] !String ![String] !String !HtmlTag -> Task ()
|
EmailOptSMTPServerPort
!
Int
//TCP port of the SMTP server to use. Default: 25
|
EmailOptExtraHeaders
![(
String
,
String
)]
//Additional headers to add before the body
|
EmailOptTimeout
!
Timeout
// TCP timeout
//* Email attachment.
::
Attachment
=
{
name
::
!
String
//* The attachment's filename.
,
content
::
!{#
Char
}
//* Content of the attachment, arbitrary binary data.
}
Libraries/iTasks/Extensions/Email.icl
View file @
ddd8e2de
implementation
module
iTasks
.
Extensions
.
Email
import
iTasks
import
StdEnv
import
Data
.
Functor
,
Data
.
Func
import
Text
,
Text
.
HTML
import
Text
,
Text
.
HTML
,
Text
.
Encodings
.
Base64
import
iTasks
sendEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
String
->
Task
()
sendEmail
opts
sender
recipients
subject
body
sendEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
String
![
Attachment
]
->
Task
()
sendEmail
opts
sender
recipients
subject
body
attachments
=
tcpconnect
server
port
timeout
(
constShare
())
{
ConnectionHandlers
|
onConnect
=
onConnect
,
onData
=
onData
,
onDisconnect
=
onDisconnect
,
onShareChange
=
\
l
_
=
(
Ok
l
,
Nothing
,
[],
False
),
onDestroy
=
\
s
->(
Ok
s
,
[])}
@!
()
where
...
...
@@ -25,7 +26,7 @@ where
((\
recipient
->
(
smtpTo
recipient
,
250
))
<$>
recipients
)
++
[(
smtpData
,
354
)
,(
smtpBody
sender
recipients
headers
subject
body
,
250
)
,(
smtpBody
sender
recipients
headers
subject
body
attachments
,
250
)
,(
smtpQuit
,
221
)
]
...
...
@@ -50,10 +51,15 @@ where
onDisconnect
_
_
=
(
Error
"SMTP server disconnected unexpectedly"
,
Nothing
)
sendHtmlEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
HtmlTag
->
Task
()
sendHtmlEmail
opts
sender
recipients
subject
body
=
sendHtmlEmail
::
![
EmailOpt
]
!
String
![
String
]
!
String
!
HtmlTag
![
Attachment
]
->
Task
()
sendHtmlEmail
opts
sender
recipients
subject
body
attachments
=
sendEmail
[
EmailOptExtraHeaders
[(
"content-type"
,
"text/html; charset=UTF8"
)]:
opts
]
sender
recipients
subject
htmlString
[
EmailOptExtraHeaders
[(
"content-type"
,
"text/html; charset=UTF8"
)]:
opts
]
sender
recipients
subject
htmlString
attachments
where
// avoid too long lines (SMTP allows a max length of 1000 characters only)
// by inserting a newline (\r\n is required for mails) after each tag
...
...
@@ -64,15 +70,36 @@ smtpHelo = "HELO localhost\r\n"
smtpFrom
email_from
=
"MAIL FROM:<"
+++
(
cleanupEmailString
email_from
)
+++
">
\r\n
"
smtpTo
email_to
=
"RCPT TO:<"
+++
(
cleanupEmailString
email_to
)
+++
">
\r\n
"
smtpData
=
"DATA
\r\n
"
smtpBody
email_from
email_to
email_headers
email_subject
email_body
=
concat
[
k
+++
":"
+++
v
+++
"
\r\n
"
\\
(
k
,
v
)
<-
[(
"From"
,
cleanupEmailString
email_from
)
:
(\
email_to
->
(
"To"
,
cleanupEmailString
email_to
))
<$>
email_to
]
++
[(
"Subject"
,
cleanupEmailString
email_subject
)
:
email_headers
]
]
+++
"
\r\n
"
+++
email_body
+++
"
\r\n
.
\r\n
"
smtpBody
email_from
email_to
bodyHeaders
email_subject
email_body
attachments
=
concat
$
flatten
$
[
[
k
,
":"
,
v
,
"
\r\n
"
]
\\
(
k
,
v
)
<-
[
(
"From"
,
cleanupEmailString
email_from
)
:
(\
email_to
->
(
"To"
,
cleanupEmailString
email_to
))
<$>
email_to
]
++
[(
"Subject"
,
cleanupEmailString
email_subject
)]
]
++
if
(
isEmpty
attachments
)
[]
[[
"Content-Type: multipart/mixed; boundary=sep
\r\n
--sep
\r\n
"
]]
++
[[
k
,
":"
,
v
,
"
\r\n
"
]
\\
(
k
,
v
)
<-
bodyHeaders
]
++
[[
"
\r\n
"
,
email_body
,
"
\r\n
"
],
if
(
isEmpty
attachments
)
[]
[
"--sep"
],
[
"
\r\n
"
]]
++
[
flatten
$
[
[
"content-type: application/octet-stream; name=
\"
"
,
attachment
.
Attachment
.
name
,
"
\"\r\n
"
,
"content-disposition: attachment; filename=
\"
"
,
attachment
.
Attachment
.
name
,
"
\"\r\n
"
,
"content-transfer-encoding: base64
\r\n
"
,
"
\r\n
"
]
,
withRestrictedLineLength
(
base64Encode
attachment
.
content
)
,
[
"
\r\n
--sep
\r\n
"
]
]
\\
attachment
<-
attachments
]
++
[[
".
\r\n
"
]]
smtpQuit
=
"QUIT
\r\n
"
//Utility functions
...
...
@@ -100,3 +127,13 @@ getHeadersOpt [x:xs] = getHeadersOpt xs
getTimeoutOpt
[]
=
Nothing
getTimeoutOpt
[
EmailOptTimeout
t
:
xs
]
=
Just
t
getTimeoutOpt
[
x
:
xs
]
=
getTimeoutOpt
xs
//* Cut into lines of 1000 character (including "\r\n"), to fulfil SMTP standard.
withRestrictedLineLength
::
!
String
->
[
String
]
withRestrictedLineLength
str
=
reverse
$
withRestrictedLineLength`
0
[]
where
withRestrictedLineLength`
i
acc
|
strSize
-
i
<=
998
=
[
str
%
(
i
,
strSize
-
1
):
acc
]
|
otherwise
=
withRestrictedLineLength`
(
i
+
998
)
[
"
\r\n
"
,
str
%
(
i
,
i
+
997
):
acc
]
strSize
=
size
str
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment