|
@@ -28,9 +28,17 @@ import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Char8 as C8
|
|
import qualified Data.ByteString.Char8 as C8
|
|
import qualified Data.List as List
|
|
import qualified Data.List as List
|
|
|
|
|
|
-data BackendAction = DATA deriving (Show, Read, Eq, Ord, Bounded, Enum)
|
|
|
|
|
|
+-- | All the actions that walrus may request from a backend
|
|
|
|
+data BackendAction =
|
|
|
|
+ -- | Recieve new email
|
|
|
|
+ DATA |
|
|
|
|
+ -- | Verify if a backend will handle the addresses
|
|
|
|
+ WILLHANDLE deriving (Show, Read, Eq, Ord, Bounded, Enum)
|
|
|
|
+
|
|
|
|
+-- | The network data of a client (IP and port)
|
|
data ClientIdentity = ClientIdentity {_clientIp :: IP, _clientPort :: Int} deriving (Show, Read, Ord, Eq)
|
|
data ClientIdentity = ClientIdentity {_clientIp :: IP, _clientPort :: Int} deriving (Show, Read, Ord, Eq)
|
|
|
|
|
|
|
|
+-- | A possibly empty version of Metadata for iterative filling. Convert with strictMetadata.
|
|
data MaybeMetadata = MaybeMetadata {_mclientId :: Maybe ClientIdentity, _mclientName :: Maybe ByteString,
|
|
data MaybeMetadata = MaybeMetadata {_mclientId :: Maybe ClientIdentity, _mclientName :: Maybe ByteString,
|
|
_mmailFrom :: Maybe Account, _mrcptTo :: [Address], _mrcptFailed :: [(Address, Response)],
|
|
_mmailFrom :: Maybe Account, _mrcptTo :: [Address], _mrcptFailed :: [(Address, Response)],
|
|
_mauth :: Maybe ByteString, _mrecvDate :: Maybe UTCTime, _mbodyEnc :: Mime.BodyEncoding,
|
|
_mauth :: Maybe ByteString, _mrecvDate :: Maybe UTCTime, _mbodyEnc :: Mime.BodyEncoding,
|
|
@@ -38,6 +46,7 @@ data MaybeMetadata = MaybeMetadata {_mclientId :: Maybe ClientIdentity, _mclient
|
|
_mdataSize :: Maybe Int
|
|
_mdataSize :: Maybe Int
|
|
} deriving (Show, Ord, Eq)
|
|
} deriving (Show, Ord, Eq)
|
|
|
|
|
|
|
|
+-- | All the data of a backend metadata, as the walrus specification.
|
|
data Metadata = Metadata {_clientId :: ClientIdentity, _clientName :: ByteString,
|
|
data Metadata = Metadata {_clientId :: ClientIdentity, _clientName :: ByteString,
|
|
_mailFrom :: Account, _rcptTo :: [Address], _rcptFailed :: [(Address, Response)],
|
|
_mailFrom :: Account, _rcptTo :: [Address], _rcptFailed :: [(Address, Response)],
|
|
_auth :: Maybe ByteString, _recvDate :: UTCTime, _bodyEnc :: Mime.BodyEncoding,
|
|
_auth :: Maybe ByteString, _recvDate :: UTCTime, _bodyEnc :: Mime.BodyEncoding,
|
|
@@ -52,11 +61,14 @@ makeLenses ''Metadata
|
|
instance Default MaybeMetadata where
|
|
instance Default MaybeMetadata where
|
|
def = MaybeMetadata Nothing Nothing Nothing [] [] Nothing Nothing Mime.B7BitEncoding False Nothing [] Nothing
|
|
def = MaybeMetadata Nothing Nothing Nothing [] [] Nothing Nothing Mime.B7BitEncoding False Nothing [] Nothing
|
|
|
|
|
|
|
|
+-- | 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
|
|
resetMetadata :: MaybeMetadata -> MaybeMetadata
|
|
resetMetadata :: MaybeMetadata -> MaybeMetadata
|
|
resetMetadata d = def & mclientId .~ d^.mclientId & mclientName .~ d^.mclientName
|
|
resetMetadata d = def & mclientId .~ d^.mclientId & mclientName .~ d^.mclientName
|
|
|
|
|
|
|
|
+-- | Converts a fully filled MaybeMetadata into its strict version
|
|
strictMetadata :: MaybeMetadata -> Maybe Metadata
|
|
strictMetadata :: MaybeMetadata -> Maybe Metadata
|
|
strictMetadata m = do
|
|
strictMetadata m = do
|
|
act <- m^.maction
|
|
act <- m^.maction
|
|
@@ -73,6 +85,7 @@ strictMetadata m = do
|
|
sz <- m^.mdataSize
|
|
sz <- m^.mdataSize
|
|
return $ Metadata cid cnm rfm rto rfail usr rcv enc utf act unrq sz
|
|
return $ Metadata cid cnm rfm rto rfail usr rcv enc utf act unrq sz
|
|
|
|
|
|
|
|
+-- | Converts the metadata to text on the format required by walrus backends.
|
|
renderMetadata :: Metadata -> ByteString
|
|
renderMetadata :: Metadata -> ByteString
|
|
renderMetadata m = BS.concat serialize
|
|
renderMetadata m = BS.concat serialize
|
|
where
|
|
where
|
|
@@ -93,7 +106,7 @@ renderMetadata m = BS.concat serialize
|
|
Nothing -> []
|
|
Nothing -> []
|
|
Just u -> ["Auth-User: ", u, "\r\n"]
|
|
Just u -> ["Auth-User: ", u, "\r\n"]
|
|
toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress $ x, "\r\n"]) rto
|
|
toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress $ x, "\r\n"]) rto
|
|
- failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, renderLineResponse r, "\r\n"]) rfail
|
|
|
|
|
|
+ failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, ";", renderLineResponse r, "\r\n"]) rfail
|
|
unrec = m^.unrecognized
|
|
unrec = m^.unrecognized
|
|
h = [
|
|
h = [
|
|
"Action: ", show act, "\r\n",
|
|
"Action: ", show act, "\r\n",
|
|
@@ -106,8 +119,9 @@ renderMetadata m = BS.concat serialize
|
|
"SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n",
|
|
"SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n",
|
|
"Data-Size: ", show sz, "\r\n"
|
|
"Data-Size: ", show sz, "\r\n"
|
|
] :: [String]
|
|
] :: [String]
|
|
- in map fromTextual h ++ toStr ++ failStr ++ usrStr ++ unrec
|
|
|
|
|
|
+ in map fromTextual h ++ toStr ++ failStr ++ usrStr ++ unrec ++ ["\r\n"]
|
|
|
|
|
|
|
|
+-- | Reads a metadata from a textual representation on the format expected by the walrus backends
|
|
parseMetadata :: A.Parser Metadata
|
|
parseMetadata :: A.Parser Metadata
|
|
parseMetadata = do
|
|
parseMetadata = do
|
|
(m', h', p') <- parserFold parseField (def, Nothing, Nothing)
|
|
(m', h', p') <- parserFold parseField (def, Nothing, Nothing)
|
|
@@ -119,7 +133,7 @@ parseMetadata = do
|
|
m = set mclientId i m'
|
|
m = set mclientId i m'
|
|
case strictMetadata m of
|
|
case strictMetadata m of
|
|
Just s -> return s
|
|
Just s -> return s
|
|
- Nothing -> failParser
|
|
|
|
|
|
+ Nothing -> fail "missing required fields"
|
|
where
|
|
where
|
|
parseField :: Parser ((MaybeMetadata, Maybe IP, Maybe Int) -> (MaybeMetadata, Maybe IP, Maybe Int))
|
|
parseField :: Parser ((MaybeMetadata, Maybe IP, Maybe Int) -> (MaybeMetadata, Maybe IP, Maybe Int))
|
|
parseField = do
|
|
parseField = do
|