From f013f29b60a0549c300b0aab0c6e128cb28298e0 Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Wed, 28 Mar 2018 22:23:03 -0400 Subject: Switch from cereal to binary --- Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 38 +++++++++++++-------------- Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 6 ++--- openpgp-asciiarmor.cabal | 4 +-- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index 98934a0..08a951b 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation --- Copyright © 2012 Clint Adams +-- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -18,17 +18,17 @@ import qualified Data.Attoparsec.ByteString as AS import qualified Data.Attoparsec.ByteString.Lazy as AL import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) import Data.Bits (shiftL) -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Base64 as Base64 import Data.Digest.CRC24 (crc24) -import Data.Serialize.Get (Get, runGet, getWord8) +import Data.Binary.Get (Get, runGetOrFail, getWord8) import Data.String (IsString, fromString) import Data.Word (Word32) -decode :: IsString e => ByteString -> Either e [Armor] +decode :: IsString e => B.ByteString -> Either e [Armor] decode bs = go (AS.parse parseArmors bs) where go (AS.Fail _ _ e) = Left (fromString e) @@ -55,7 +55,7 @@ clearsigned = do _ <- blankishLine "blank line" cleartext <- dashEscapedCleartext sig <- armor - return $ ClearSigned headers (BL.fromChunks [cleartext]) sig + return $ ClearSigned headers cleartext sig armor :: Parser Armor armor = do @@ -64,7 +64,7 @@ armor = do _ <- blankishLine "blank line" payload <- base64Data "base64 data" _ <- endLine atype "end line" - return $ Armor atype headers (BL.fromChunks [payload]) + return $ Armor atype headers payload beginLine :: Parser ArmorType beginLine = do @@ -88,7 +88,7 @@ beginLine = do partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num num = many1 (satisfy isDigit_w8) "number" -lineEnding :: Parser ByteString +lineEnding :: Parser B.ByteString lineEnding = string "\n" <|> string "\r\n" armorHeaders :: Parser [(String, String)] @@ -104,15 +104,15 @@ armorHeader = do where w8sToString = BC8.unpack . B.pack -blankishLine :: Parser ByteString +blankishLine :: Parser B.ByteString blankishLine = many (satisfy (inClass " \t")) *> lineEnding -endLine :: ArmorType -> Parser ByteString +endLine :: ArmorType -> Parser B.ByteString endLine atype = do _ <- string $ "-----END PGP " `B.append` aType atype `B.append` "-----" lineEnding -aType :: ArmorType -> ByteString +aType :: ArmorType -> B.ByteString aType (ArmorMessage) = BC8.pack "MESSAGE" aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" @@ -120,7 +120,7 @@ aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.ap aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x aType (ArmorSignature) = BC8.pack "SIGNATURE" -l2s :: BL.ByteString -> ByteString +l2s :: BL.ByteString -> B.ByteString l2s = B.concat . BL.toChunks base64Data :: Parser ByteString @@ -129,11 +129,11 @@ base64Data = do cksum <- checksumLine let payload = B.concat ls let ourcksum = crc24 payload - case runGet d24 cksum of - Left err -> fail err - Right theircksum -> if theircksum == ourcksum then return payload else fail ("CRC24 mismatch: " ++ show (B.unpack cksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum) + case runGetOrFail d24 (BL.fromStrict cksum) of + Left (_,_,err) -> fail err + Right (_,_,theircksum) -> if theircksum == ourcksum then return (BL.fromStrict payload) else fail ("CRC24 mismatch: " ++ show (B.unpack cksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum) where - base64Line :: Parser ByteString + base64Line :: Parser B.ByteString base64Line = do b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) pad <- many (word8 (fromIntegral . fromEnum $ '=')) @@ -142,7 +142,7 @@ base64Data = do case Base64.decode line of Left err -> fail err Right bs -> return bs - checksumLine :: Parser ByteString + checksumLine :: Parser B.ByteString checksumLine = do _ <- word8 (fromIntegral . fromEnum $ '=') b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) @@ -166,9 +166,9 @@ prefixed end = end <|> anyChar *> prefixed end dashEscapedCleartext :: Parser ByteString dashEscapedCleartext = do ls <- many1 ((deLine <|> unescapedLine) <* lineEnding) - return $ crlfUnlines ls + return . BL.fromStrict $ crlfUnlines ls where - deLine :: Parser ByteString + deLine :: Parser B.ByteString deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r"))) - unescapedLine :: Parser ByteString + unescapedLine :: Parser B.ByteString unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r"))) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index c437439..fdb9961 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -1,5 +1,5 @@ -- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation --- Copyright © 2012 Clint Adams +-- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -15,7 +15,7 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.ByteString.Base64 as Base64 import Data.Digest.CRC24 (crc24Lazy) -import Data.Serialize.Put (runPutLazy, putWord32be) +import Data.Binary.Put (runPut, putWord32be) encode :: [Armor] -> B.ByteString encode = B.concat . BL.toChunks . encodeLazy @@ -60,7 +60,7 @@ wordWrap lw bs | otherwise = BL.take (fromIntegral lw) bs : wordWrap lw (BL.drop (fromIntegral lw) bs) armorChecksum :: ByteString -> ByteString -armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPutLazy . putWord32be . crc24Lazy +armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPut . putWord32be . crc24Lazy dashEscape :: ByteString -> ByteString dashEscape = BLC8.unlines . map escapeLine . BLC8.lines diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal index 0feac1d..0e1f9ca 100644 --- a/openpgp-asciiarmor.cabal +++ b/openpgp-asciiarmor.cabal @@ -40,8 +40,8 @@ Library Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring + , binary , bytestring - , cereal default-language: Haskell2010 @@ -52,8 +52,8 @@ Test-Suite tests Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring + , binary , bytestring - , cereal , tasty , tasty-hunit default-language: Haskell2010 -- cgit v1.2.3