Added Data-Size header

src/Walrus/Backend/Metadata.hs

@@ -28,21 +28,21 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as C8
 import qualified Data.List as List
 
-import Debug.Trace
-
 data BackendAction = DATA deriving (Show, Read, Eq, Ord, Bounded, Enum)
 data ClientIdentity = ClientIdentity {_clientIp :: IP, _clientPort :: Int} deriving (Show, Read, Ord, Eq)
 
 data MaybeMetadata = MaybeMetadata {_mclientId :: Maybe ClientIdentity, _mclientName :: Maybe ByteString,
                                     _mmailFrom :: Maybe Account, _mrcptTo :: [Address], _mrcptFailed :: [(Address, Response)],
                                     _mauth :: Maybe ByteString, _mrecvDate :: Maybe UTCTime, _mbodyEnc :: Mime.BodyEncoding,
-                                    _msmtpUtf8 :: Bool, _maction :: Maybe BackendAction, _munrecognized :: [ByteString]
+                                    _msmtpUtf8 :: Bool, _maction :: Maybe BackendAction, _munrecognized :: [ByteString],
+                                    _mdataSize :: Maybe Int
                                    } deriving (Show, Ord, Eq)
 
 data Metadata = Metadata {_clientId :: ClientIdentity, _clientName :: ByteString,
                           _mailFrom :: Account, _rcptTo :: [Address], _rcptFailed :: [(Address, Response)],
                           _auth :: Maybe ByteString, _recvDate :: UTCTime, _bodyEnc :: Mime.BodyEncoding,
-                          _smtpUtf8 :: Bool, _action :: BackendAction, _unrecognized :: [ByteString]
+                          _smtpUtf8 :: Bool, _action :: BackendAction, _unrecognized :: [ByteString],
+                          _dataSize :: Int
                          } deriving (Show, Ord, Eq)
 
 makeLenses ''ClientIdentity
@@ -50,7 +50,7 @@ makeLenses ''MaybeMetadata
 makeLenses ''Metadata
 
 instance Default MaybeMetadata where
-  def = MaybeMetadata Nothing Nothing Nothing [] [] Nothing Nothing Mime.B7BitEncoding False Nothing []
+  def = MaybeMetadata Nothing Nothing Nothing [] [] Nothing Nothing Mime.B7BitEncoding False Nothing [] Nothing
 
 metadataForClient :: IP -> Int -> MaybeMetadata
 metadataForClient c p = def & mclientId .~ (Just (ClientIdentity c p))
@@ -70,7 +70,8 @@ strictMetadata m = do
   let enc = m^.mbodyEnc
       utf = m^.msmtpUtf8
       unrq = m^.munrecognized
-  return $ Metadata cid cnm rfm rto rfail usr rcv enc utf act unrq
+  sz <- m^.mdataSize
+  return $ Metadata cid cnm rfm rto rfail usr rcv enc utf act unrq sz
 
 renderMetadata :: Metadata -> ByteString
 renderMetadata m = BS.concat serialize
@@ -87,11 +88,12 @@ renderMetadata m = BS.concat serialize
       rcv = m^.recvDate
       enc = m^.bodyEnc
       utf = m^.smtpUtf8
+      sz = m^.dataSize
       usrStr = case usr of
         Nothing -> []
         Just u -> ["Auth-User: ", u, "\r\n"]
       toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress $ x, "\r\n"]) rto
-      failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderResponse r, "\r\n"]) rfail
+      failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, renderLineResponse r, "\r\n"]) rfail
       unrec = m^.unrecognized
       h = [
         "Action: ", show act, "\r\n",
@@ -100,8 +102,9 @@ renderMetadata m = BS.concat serialize
         "Client-Name: ", fromTextual cnm, "\r\n",
         "Return-Path: ", fromTextual . normalAccountName $ rfm, "\r\n",
         "Recv-Date: ", formatISO8601 $ rcv, "\r\n",
-        "Body-Encoding: ", show $ enc, "\r\n",
-        "SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n"
+        "Body-Encoding: ", show enc, "\r\n",
+        "SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n",
+        "Data-Size: ", show sz, "\r\n"
         ] :: [String]
       in map fromTextual h ++ toStr ++ failStr ++ usrStr ++ unrec
 
@@ -123,56 +126,46 @@ parseMetadata = do
       A.choice [
         do
           act <- hdr "Action" parseEnumCI
-          trace "Action" $ return ()
           return $ \(m, ip, p) -> (set maction (Just act) m, ip, p),
         do
           ip <- hdr "Client-Ip" parseRead
-          trace "Client-Ip" $ return ()
           return $ \(m, _, p) -> (m, Just ip, p),
         do
           p <- hdr "Client-Port" parseRead
-          trace "Client-Port" $ return ()
           return $ \(m, ip, _) -> (m, ip, Just p),
         do
           nm <- hdr "Client-Name" (A.takeTill A.isSpace)
-          trace "Client-Name" $ return ()
           return $ \(m, ip, p) -> (set mclientName (Just nm) m, ip, p),
         do
           frm <- hdr "Return-Path" parseAccount
-          trace "Return-Path" $ return ()
           return $ \(m, ip, p) -> (set mmailFrom (Just frm) m, ip, p),
         do
           rtp <- hdr "To" parseAddress
-          trace "To" $ return ()
           return $ \(m, ip, p) -> let
             crtp = m^.mrcptTo
             in (set mrcptTo (rtp:crtp) m, ip, p),
         do
           rfl <- hdr "Failed" parseAddressingReason
-          trace "Failed" $ return ()
           return $ \(m, ip, p) -> let
             fld = m^.mrcptFailed
             in (set mrcptFailed (rfl:fld) m, ip, p),
         do
           recv <- hdr "Recv-Date" parseISO8601Val
-          trace "Recv-Date" $ return ()
           return $ \(m, ip, p) -> (set mrecvDate (Just recv) m, ip, p),
         do
           enc <- hdr "Body-Encoding" Mime.parseBodyEncoding
-          trace "Body-Encoding" $ return ()
           return $ \(m, ip, p) -> (set mbodyEnc enc m, ip, p),
         do
           utf <- hdr "SMTP-UTF8" parseMetadataBool
-          trace "SMTP-UTF8" $ return ()
           return $ \(m, ip, p) -> (set msmtpUtf8 utf m, ip, p),
         do
           usr <- hdr "Auth-User" bsval
-          trace "Auth-User" $ return ()
           return $ \(m, ip, p) -> (set mauth (Just usr) m, ip, p),
+        do
+          sz <- hdr "Data-Size" A.decimal
+          return $ \(m, ip, p) -> (set mdataSize (Just sz) m, ip, p),
         do
           u <- entireHdr
-          trace "Unknown" $ return ()
-          trace (show u) $ return ()
           return $ \(m, ip, p) -> let
             uu = m^.munrecognized
             in (set munrecognized (u:uu) m, ip, p)
@@ -198,19 +191,15 @@ parseMetadata = do
                    else return ""
     hdr :: ByteString -> Parser a -> Parser a
     hdr pt f = do
-      trace ("testing " ++ show pt) $ return ()
       skipHorizontalSpace
       A.stringCI pt
-      trace ("it's it") $ return ()
       skipHorizontalSpace
       A.char ':'
       skipHorizontalSpace
       t <- bsval
-      trace ("Will now parse value: " ++ show t) $ return ()
       r <- case A.parseOnly f t of
         Left _ -> failParser
         Right v -> return v
-      trace "Got value" $ return ()
       skipHorizontalSpace
       return r
     bsval :: Parser ByteString