From 5ed645493e10190f7cddd753bb058e8487037549 Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Wed, 25 Apr 2012 16:38:48 -0400 Subject: Separate ASCII armor codec into its own package, change license to ISC, and change API toward Stephen Paul Weber's proposal. --- Codec/Encryption/OpenPGP/ASCIIArmor.hs | 2 +- Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 17 ++++++++--------- Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 25 +++++++++++-------------- Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs | 23 +++++++++++++++++++++++ 4 files changed, 43 insertions(+), 24 deletions(-) create mode 100644 Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs (limited to 'Codec') diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs index 62440ae..74c8c69 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs @@ -1,6 +1,6 @@ -- ASCIIArmor.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor ( diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index 64f7236..8c2a8a3 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( @@ -9,8 +9,7 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( , decodeArmor ) where -import Codec.Encryption.OpenPGP.Serialize () -import Codec.Encryption.OpenPGP.Types +import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Control.Applicative (many, (<|>), (<$>)) import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (), parse, IResult(..)) import Data.Attoparsec.ByteString.Char8 (isDigit_w8) @@ -39,9 +38,7 @@ parseArmor = do blankishLine "blank line" payload <- base64Data "base64 data" endLine atype "end line" - case runGet get payload of - Left err -> fail err - Right packets -> return $ Armor atype headers (unBlock packets) + return $ Armor atype headers payload beginLine :: (Integral a, Read a, Show a) => Parser (ArmorType a) beginLine = do @@ -64,16 +61,18 @@ beginLine = do lineEnding :: Parser ByteString lineEnding = string "\n" <|> string "\r\n" -armorHeaders :: Parser [ArmorHeader] +armorHeaders :: Parser [(String, String)] armorHeaders = many armorHeader -armorHeader :: Parser ArmorHeader +armorHeader :: Parser (String, String) armorHeader = do key <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) string ": " val <- many1 (satisfy (notInClass "\n\r")) lineEnding - return (B.pack key, B.pack val) + return (w8sToString key, w8sToString val) + where + w8sToString = BC8.unpack . B.pack blankishLine :: Parser ByteString blankishLine = many (satisfy (inClass " \t")) >> lineEnding diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index c9c9641..8853be3 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -1,14 +1,13 @@ -- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( armor ) where -import Codec.Encryption.OpenPGP.Serialize () -import Codec.Encryption.OpenPGP.Types +import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8 @@ -19,7 +18,7 @@ import Data.Serialize.Put (runPut, putWord32be) import Data.String (IsString, fromString) armor :: (Integral a, Show a) => Armor a -> ByteString -armor (Armor atype ahs ps) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData (opgpStream ps) `B.append` armorChecksum (opgpStream ps) `B.append` endLine atype +armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum bs `B.append` endLine atype blankLine :: ByteString blankLine = BC8.singleton '\n' @@ -38,22 +37,20 @@ aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x aType (ArmorSignature) = BC8.pack "SIGNATURE" -armorHeaders :: [ArmorHeader] -> ByteString +armorHeaders :: [(String, String)] -> ByteString armorHeaders ahs = BC8.unlines . map armorHeader $ ahs where - armorHeader :: ArmorHeader -> ByteString - armorHeader (k, v) = k `B.append` BC8.pack ": " `B.append` v - -opgpStream :: [Packet] -> ByteString -opgpStream = runPut . put . Block + armorHeader :: (String, String) -> ByteString + armorHeader (k, v) = BC8.pack k `B.append` BC8.pack ": " `B.append` BC8.pack v armorData :: ByteString -> ByteString -armorData = BC8.unlines . wrap76 . Base64.encode +armorData = BC8.unlines . wordWrap 64 . Base64.encode -wrap76 :: ByteString -> [ByteString] -wrap76 bs +wordWrap :: Int -> ByteString -> [ByteString] +wordWrap lw bs | B.null bs = [] - | otherwise = B.take 76 bs : wrap76 (B.drop 76 bs) + | lw < 1 || lw > 76 = wordWrap 76 bs + | otherwise = B.take lw bs : wordWrap lw (B.drop lw bs) armorChecksum :: ByteString -> ByteString armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24 diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs new file mode 100644 index 0000000..8c7ef6f --- /dev/null +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs @@ -0,0 +1,23 @@ +-- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation +-- Copyright Ⓒ 2012 Clint Adams +-- This software is released under the terms of the ISC license. +-- (See the LICENSE file). + +module Codec.Encryption.OpenPGP.ASCIIArmor.Types ( + Armor(..) + , ArmorType(..) +) where + +import Data.ByteString (ByteString) + +data Armor a = Armor (ArmorType a) [(String, String)] ByteString + | ClearSigned [(String, String)] String (Armor a) + deriving (Show, Eq) + +data ArmorType a = ArmorMessage + | ArmorPublicKeyBlock + | ArmorPrivateKeyBlock + | ArmorSplitMessage a a + | ArmorSplitMessageIndefinite a + | ArmorSignature + deriving (Show, Eq) -- cgit v1.2.3