skypelogexport-0.1: Skype/LogParser.hs

module Skype.LogParser (
    LogParser(parseSkypeLog)
) where

import Data.ByteString.Lazy as L
import Data.ByteString as S

import Data.Attoparsec as AP

import Data.Binary.Get

import Data.Bits

import Data.Maybe

import Data.List as DL

import Data.Map as DM

import Data.Word

import Data.DateTime

import Control.Monad

import Skype.Entry
import Skype.Util

class LogParser s where
    parseSkypeLog :: s -> [SkypeEntry]

extractResults ::  Parser [a] -> S.ByteString -> [a]
extractResults = ((either (const []) id . AP.eitherResult) .) . (flip AP.feed S.empty .) . AP.parse

instance LogParser S.ByteString where
    parseSkypeLog = extractResults (many parsecLogParser)

headerSign' = [0x6C,0x33,0x33,0x6C]

parsecLogParser ::  Parser SkypeEntry
parsecLogParser = do
    skipUntilString headerSign'
    recSz <- read4Bytes
    AP.take 9
    content <- AP.take $ fromIntegral recSz - 9
    return . extractResult $ parse (parseLogContent recSz) content
    where
        extractResult ( Fail _ _ msg ) = IncompleteEntry msg
        extractResult ( Partial f ) = extractResult $ f S.empty
        extractResult ( Done _ r ) = r

skipUntilString :: [Word8] -> Parser ()
skipUntilString start = go start
    where
        go [] = return ()
        go (x:xs) = do
            cur <- AP.take 1
            handleChar x xs (S.head cur)
        handleChar x xs cur | x == cur = go xs
                            | cur == DL.head start = go $ DL.tail start
                            | otherwise = go start

parseLogContent :: Word32 -> Parser SkypeEntry
parseLogContent recSz = do
    let skypeEntry = makeSEntry { recSize=recSz }
    records <- try $ many parseRecord
    return $ DL.foldl mkSkypeEntry skypeEntry records
    where
        mkSkypeEntry rec (TRecord Message val) = rec { message = val }
        mkSkypeEntry rec (TRecord Sender val) = rec { senderId = val }
        mkSkypeEntry rec (TRecord Members val) = rec { members = splitRec val }
        mkSkypeEntry rec (IRecord Date val) = rec { timeStamp = fromSeconds . fromIntegral $ val }
        mkSkypeEntry rec (TRecord Session val) = rec { sessionId = val }
        mkSkypeEntry rec fld = let recs = records rec 
                               in rec { records = fld:recs }
        splitRec = S.split 0x20


intMark = S.pack [0x00]
textMark = S.pack [0x03]
blobMark = S.pack [0x04]

parseRecord ::  Parser RawRecord
parseRecord = AP.take 1 >>= handleRecord 
    where
        handleRecord src | src == intMark = parseInt
                         | src == textMark = parseText
                         | src == blobMark =  parseBlob
                         | otherwise = parseUnknown

parseInt ::  Parser RawRecord
parseInt = do
    itemCode <- liftM deriveType readNumber
    itemValue <- readNumber
    return $ IRecord itemCode itemValue

parseText ::  Parser RawRecord
parseText = do
    itemCode <- liftM deriveType readNumber
    content <- AP.takeWhile ( /= 0x00 )
    AP.take 1
    return $ TRecord itemCode content

parseBlob ::  Parser RawRecord
parseBlob = do
    itemCode <- liftM deriveType readNumber
    itemSize <- readNumber
    content <- AP.take $ fromIntegral itemSize
    return $ BRecord itemCode content ( fromIntegral itemSize )

parseUnknown = do
    itemCode <- liftM deriveType readNumber
    content <- AP.takeWhile ( > 0x04 )
    return $ URecord itemCode content


deriveType :: Word64 -> RecordType
deriveType 15 = VoicemailFile
deriveType 16 = Call
deriveType 20 = Summary
deriveType 36 = Language
deriveType 40 = Country
deriveType 48 = City
deriveType 51 = File
deriveType 55 = Message
deriveType 508 = Message
deriveType 64 = Email
deriveType 68 = URL
deriveType 72 = Description
deriveType 116 = Country
deriveType 184 = Phone
deriveType 296 = Type
deriveType 404 = User
deriveType 408 = User
deriveType 440 = Session
deriveType 456 = Members
deriveType 460 = Members
deriveType 468 = User
deriveType 472 = Name
deriveType 480 = Session
deriveType 488 = Sender
deriveType 492 = Sender
deriveType 500 = Recipient
deriveType 584 = Session
deriveType 588 = Member
deriveType 565 = Date
deriveType 485 = Date
deriveType 828 = Sender
deriveType 840 = User
deriveType 868 = Number
deriveType 920 = Screenname
deriveType 924 = Fullname
deriveType 3160 = LogBy
deriveType num = Unknown num

skipGarbage = AP.skipWhile ( /= 0x03 )

skipDelimiter = AP.skipWhile ( == 0x03 )

read4Bytes = liftM ( runGet getWord32le . L.fromChunks . (:[]) ) $ AP.take 4