|
@@ -6,10 +6,10 @@ module Walrus.Backend.Metadata where
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString (ByteString)
|
|
import Data.Time.Clock (UTCTime)
|
|
import Data.Time.Clock (UTCTime)
|
|
|
|
|
|
-import SMTP.Address
|
|
|
|
-import SMTP.Account
|
|
|
|
-import qualified SMTP.Mime as Mime
|
|
|
|
-import SMTP.Response
|
|
|
|
|
|
+import Data.SMTP.Address
|
|
|
|
+import Data.SMTP.Account
|
|
|
|
+import qualified Data.SMTP.Mime as Mime
|
|
|
|
+import Data.SMTP.Response
|
|
import Text.StringConvert
|
|
import Text.StringConvert
|
|
|
|
|
|
import Data.Time.ISO8601
|
|
import Data.Time.ISO8601
|
|
@@ -33,7 +33,7 @@ data BackendAction =
|
|
DELIVER |
|
|
DELIVER |
|
|
-- | Verify if a backend will handle the rcpt to addresses
|
|
-- | Verify if a backend will handle the rcpt to addresses
|
|
WILLHANDLE |
|
|
WILLHANDLE |
|
|
- -- | Verifies if accounts exist as in the SMTP VRFY command
|
|
|
|
|
|
+ -- | Verifies if accounts exist as in the Data.SMTP.VRFY command
|
|
VERIFY |
|
|
VERIFY |
|
|
-- | Fetch a resource
|
|
-- | Fetch a resource
|
|
FETCH |
|
|
FETCH |
|
|
@@ -124,7 +124,7 @@ instance Default MaybeMetadata where
|
|
-- | Creates an empty metadata with just the client identity
|
|
-- | Creates an empty metadata with just the client identity
|
|
metadataForClient :: IP -> Int -> MaybeMetadata
|
|
metadataForClient :: IP -> Int -> MaybeMetadata
|
|
metadataForClient c p = def & mclientId .~ Just (ClientIdentity c p)
|
|
metadataForClient c p = def & mclientId .~ Just (ClientIdentity c p)
|
|
--- | Blanks the data as necessary for the RSET SMTP command
|
|
|
|
|
|
+-- | Blanks the data as necessary for the RSET Data.SMTP.command
|
|
resetMetadata :: MaybeMetadata -> MaybeMetadata
|
|
resetMetadata :: MaybeMetadata -> MaybeMetadata
|
|
resetMetadata d = def & mclientId .~ d^.mclientId & mclientName .~ d^.mclientName
|
|
resetMetadata d = def & mclientId .~ d^.mclientId & mclientName .~ d^.mclientName
|
|
|
|
|
|
@@ -226,9 +226,9 @@ renderMetadata m = BS.concat $ serializeDt ++ serializeMain ++ ["\r\n"]
|
|
failStr = List.concatMap (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderLineResponse r, "\r\n"]) rfail
|
|
failStr = List.concatMap (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderLineResponse r, "\r\n"]) rfail
|
|
h = [
|
|
h = [
|
|
"Client-Name: ", s cnm, "\r\n",
|
|
"Client-Name: ", s cnm, "\r\n",
|
|
- "Return-Path: ", s . normalAccountName $ rfm, "\r\n",
|
|
|
|
|
|
+ "Return-Path: ", s . normalize $ rfm, "\r\n",
|
|
"Body-Encoding: ", show enc, "\r\n",
|
|
"Body-Encoding: ", show enc, "\r\n",
|
|
- "SMTP-UTF8: ", serialBool utf, "\r\n"
|
|
|
|
|
|
+ "Data.SMTP.UTF8: ", serialBool utf, "\r\n"
|
|
] :: [String]
|
|
] :: [String]
|
|
in map s h ++ toStr ++ failStr
|
|
in map s h ++ toStr ++ failStr
|
|
serializeHandle (HandleAddress a) = ["To: ", renderMetadataAddress a, "\r\n"]
|
|
serializeHandle (HandleAddress a) = ["To: ", renderMetadataAddress a, "\r\n"]
|
|
@@ -236,14 +236,14 @@ renderMetadata m = BS.concat $ serializeDt ++ serializeMain ++ ["\r\n"]
|
|
serializeHandle HandleOk = []
|
|
serializeHandle HandleOk = []
|
|
serializeFetchResc (FetchRescData cnm rfm ofst sz hnd) =
|
|
serializeFetchResc (FetchRescData cnm rfm ofst sz hnd) =
|
|
["Client-Name: ", s cnm, "\r\n",
|
|
["Client-Name: ", s cnm, "\r\n",
|
|
- "Return-Path: ", s . normalAccountName $ rfm, "\r\n",
|
|
|
|
|
|
+ "Return-Path: ", s . normalize $ rfm, "\r\n",
|
|
"Headers: No\r\n",
|
|
"Headers: No\r\n",
|
|
"Offset: ", s . show $ ofst, "\r\n",
|
|
"Offset: ", s . show $ ofst, "\r\n",
|
|
"Block-Size: ", s . show $ sz, "\r\n"] ++
|
|
"Block-Size: ", s . show $ sz, "\r\n"] ++
|
|
serializeHandle hnd
|
|
serializeHandle hnd
|
|
serializeFetchHdr (FetchHdrData cnm rfm r q hnd) =
|
|
serializeFetchHdr (FetchHdrData cnm rfm r q hnd) =
|
|
["Client-Name: ", s cnm, "\r\n",
|
|
["Client-Name: ", s cnm, "\r\n",
|
|
- "Return-Path: ", s . normalAccountName $ rfm, "\r\n",
|
|
|
|
|
|
+ "Return-Path: ", s . normalize $ rfm, "\r\n",
|
|
"Headers: Yes\r\n",
|
|
"Headers: Yes\r\n",
|
|
"Recursive: ", serialBool r, "\r\n",
|
|
"Recursive: ", serialBool r, "\r\n",
|
|
"Query: ", serializeFtchQuery q, "\r\n"] ++
|
|
"Query: ", serializeFtchQuery q, "\r\n"] ++
|
|
@@ -304,7 +304,7 @@ parseMetadata = do
|
|
enc <- hdr "Body-Encoding" Mime.parseBodyEncoding
|
|
enc <- hdr "Body-Encoding" Mime.parseBodyEncoding
|
|
return $ \(m, ip, p) -> (set mbodyEnc enc m, ip, p),
|
|
return $ \(m, ip, p) -> (set mbodyEnc enc m, ip, p),
|
|
do
|
|
do
|
|
- utf <- hdr "SMTP-UTF8" parseMetadataBool
|
|
|
|
|
|
+ utf <- hdr "Data.SMTP.UTF8" parseMetadataBool
|
|
return $ \(m, ip, p) -> (set msmtpUtf8 utf m, ip, p),
|
|
return $ \(m, ip, p) -> (set msmtpUtf8 utf m, ip, p),
|
|
do
|
|
do
|
|
usr <- hdr "Auth-User" A.takeByteString
|
|
usr <- hdr "Auth-User" A.takeByteString
|