22 {- |
22 {- |
23 this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror |
23 this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror |
24 because standard 'catch' doesn't seem to catch decompression errors for some reason |
24 because standard 'catch' doesn't seem to catch decompression errors for some reason |
25 -} |
25 -} |
26 import qualified Codec.Compression.Zlib.Internal as Z |
26 import qualified Codec.Compression.Zlib.Internal as Z |
27 import Control.Arrow (right) |
|
28 |
27 |
29 decompressWithoutExceptions :: BL.ByteString -> Either Z.DecompressError BL.ByteString |
28 decompressWithoutExceptions :: BL.ByteString -> Either Z.DecompressError BL.ByteString |
30 decompressWithoutExceptions = finalise |
29 decompressWithoutExceptions = finalise |
31 . Z.foldDecompressStream cons nil err |
30 . Z.foldDecompressStream cons nil err |
32 . Z.decompressWithErrors Z.gzipFormat Z.defaultDecompressParams |
31 . Z.decompressWithErrors Z.gzipFormat Z.defaultDecompressParams |
33 where err errorCode errorString = Left errorCode |
32 where err errorCode _ = Left errorCode |
34 nil = Right [] |
33 nil = Right [] |
35 cons chunk = right (chunk :) |
34 cons chunk = right (chunk :) |
36 finalise = right BL.fromChunks |
35 finalise = right BL.fromChunks |
37 {- end snippet -} |
36 {- end snippet -} |
38 |
37 |
39 toEngineMsg :: B.ByteString -> B.ByteString |
38 toEngineMsg :: B.ByteString -> B.ByteString |
40 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
39 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
41 |
40 |
42 |
41 |
43 fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
42 {-fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
44 fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
43 fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
45 where |
44 where |
46 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
45 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
47 removeLength _ = Nothing |
46 removeLength _ = Nothing-} |
48 |
47 |
49 em :: B.ByteString -> B.ByteString |
48 em :: B.ByteString -> B.ByteString |
50 em = toEngineMsg |
49 em = toEngineMsg |
51 |
50 |
52 eml :: [B.ByteString] -> B.ByteString |
51 eml :: [B.ByteString] -> B.ByteString |