openpgp-asciiarmor-0.1.2/0000755000000000000000000000000013506152052013476 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Setup.hs0000644000000000000000000000005613506152052015133 0ustar0000000000000000import Distribution.Simple main = defaultMain openpgp-asciiarmor-0.1.2/LICENSE0000644000000000000000000000206613506152052014507 0ustar0000000000000000Copyright © 2012-2019 Clint Adams Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. openpgp-asciiarmor-0.1.2/openpgp-asciiarmor.cabal0000644000000000000000000000447013506152052020266 0ustar0000000000000000Name: openpgp-asciiarmor Version: 0.1.2 Synopsis: OpenPGP (RFC4880) ASCII Armor codec Description: OpenPGP (RFC4880) ASCII Armor codec Homepage: http://floss.scru.org/openpgp-asciiarmor License: MIT License-file: LICENSE Author: Clint Adams Maintainer: Clint Adams Copyright: 2012-2019 Clint Adams Category: Codec, Data Build-type: Simple Extra-source-files: tests/suite.hs , tests/data/msg1.asc , tests/data/msg1a.asc , tests/data/msg1b.asc , tests/data/msg1c.asc , tests/data/msg1.gpg , tests/data/msg2.asc , tests/data/msg2.pgp , tests/data/msg3 , tests/data/msg3.asc , tests/data/msg3.sig , tests/data/msg4 , tests/data/msg4.asc , tests/data/msg4.sig Cabal-version: >= 1.10 Library Exposed-modules: Codec.Encryption.OpenPGP.ASCIIArmor , Codec.Encryption.OpenPGP.ASCIIArmor.Decode , Codec.Encryption.OpenPGP.ASCIIArmor.Encode , Codec.Encryption.OpenPGP.ASCIIArmor.Types Other-Modules: Data.Digest.CRC24 , Codec.Encryption.OpenPGP.ASCIIArmor.Multipart , Codec.Encryption.OpenPGP.ASCIIArmor.Utils Ghc-options: -Wall Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring , binary , bytestring default-language: Haskell2010 Test-Suite tests type: exitcode-stdio-1.0 main-is: tests/suite.hs Ghc-options: -Wall Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring , binary , bytestring , tasty , tasty-hunit default-language: Haskell2010 Benchmark benchmark type: exitcode-stdio-1.0 main-is: bench/mark.hs Ghc-options: -Wall Build-depends: openpgp-asciiarmor , base , bytestring , criterion default-language: Haskell2010 source-repository head type: git location: https://salsa.debian.org/clint/openpgp-asciiarmor.git source-repository this type: git location: https://salsa.debian.org/clint/openpgp-asciiarmor.git tag: openpgp-asciiarmor/v0.1.1 openpgp-asciiarmor-0.1.2/Data/0000755000000000000000000000000013506152052014347 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Data/Digest/0000755000000000000000000000000013506152052015566 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Data/Digest/CRC24.hs0000644000000000000000000000161713506152052016704 0ustar0000000000000000-- CRC24.hs: OpenPGP (RFC4880) CRC24 implementation -- Copyright © 2012-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Digest.CRC24 ( crc24 , crc24Lazy ) where import Data.Bits (shiftL, (.&.), xor) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Word (Word8, Word32) crc24Init :: Word32 crc24Init = 0xB704CE crc24Poly :: Word32 crc24Poly = 0x1864CFB crc24Update :: Word32 -> Word8 -> Word32 crc24Update c b = (last . take 9 $ iterate (\x -> if shiftL x 1 .&. 0x1000000 == 0x1000000 then shiftL x 1 `xor` crc24Poly else shiftL x 1) (c `xor` shiftL (fromIntegral b) 16)) .&. 0xFFFFFF crc24 :: B.ByteString -> Word32 crc24 bs = crc24Lazy . BL.fromChunks $ [bs] crc24Lazy :: ByteString -> Word32 crc24Lazy = BL.foldl' crc24Update crc24Init openpgp-asciiarmor-0.1.2/Codec/0000755000000000000000000000000013506152052014513 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Codec/Encryption/0000755000000000000000000000000013506152052016645 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/0000755000000000000000000000000013506152052020115 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor.hs0000644000000000000000000000104613506152052022303 0ustar0000000000000000-- ASCIIArmor.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright © 2012 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor ( decode , decodeLazy , encode , encodeLazy , parseArmor , multipartMerge ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, decodeLazy, parseArmor) import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy) import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor/0000755000000000000000000000000013506152052021746 5ustar0000000000000000openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs0000644000000000000000000000146213506152052023405 0ustar0000000000000000-- ASCIIArmor/Utils.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright © 2012 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Utils ( crlfUnlines , crlfUnlinesLazy ) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.List (intersperse) crlfUnlines :: [ByteString] -> ByteString crlfUnlines [] = B.empty crlfUnlines ss = B.concat $ intersperse (BC8.pack "\r\n") ss crlfUnlinesLazy :: [BL.ByteString] -> BL.ByteString crlfUnlinesLazy [] = BL.empty crlfUnlinesLazy ss = BL.concat $ intersperse (BLC8.pack "\r\n") ss openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs0000644000000000000000000000134613506152052023412 0ustar0000000000000000-- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright © 2012 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Types ( Armor(..) , ArmorType(..) ) where import Data.ByteString.Lazy (ByteString) data Armor = Armor ArmorType [(String, String)] ByteString | ClearSigned [(String, String)] ByteString Armor deriving (Show, Eq) data ArmorType = ArmorMessage | ArmorPublicKeyBlock | ArmorPrivateKeyBlock | ArmorSplitMessage ByteString ByteString | ArmorSplitMessageIndefinite ByteString | ArmorSignature deriving (Show, Eq) openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs0000644000000000000000000000573013506152052023504 0ustar0000000000000000-- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( encode , encodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B 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.Binary.Put (runPut, putWord32be) encode :: [Armor] -> B.ByteString encode = B.concat . BL.toChunks . encodeLazy encodeLazy :: [Armor] -> ByteString encodeLazy = BL.concat . map armor armor :: Armor -> ByteString armor (Armor atype ahs bs) = beginLine atype `BL.append` armorHeaders ahs `BL.append` blankLine `BL.append` armorData bs `BL.append` armorChecksum bs `BL.append` endLine atype armor (ClearSigned chs ctxt csig) = BLC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `BL.append` armorHeaders chs `BL.append` blankLine `BL.append` dashEscape ctxt `BL.append` armor csig blankLine :: ByteString blankLine = BLC8.singleton '\n' beginLine :: ArmorType -> ByteString beginLine atype = BLC8.pack "-----BEGIN PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" endLine :: ArmorType -> ByteString endLine atype = BLC8.pack "-----END PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" aType :: ArmorType -> ByteString aType ArmorMessage = BLC8.pack "MESSAGE" aType ArmorPublicKeyBlock = BLC8.pack "PUBLIC KEY BLOCK" aType ArmorPrivateKeyBlock = BLC8.pack "PRIVATE KEY BLOCK" aType (ArmorSplitMessage x y) = BLC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y aType (ArmorSplitMessageIndefinite x) = BLC8.pack $ "MESSAGE, PART " ++ show x aType ArmorSignature = BLC8.pack "SIGNATURE" armorHeaders :: [(String, String)] -> ByteString armorHeaders = BLC8.unlines . map armorHeader where armorHeader :: (String, String) -> ByteString armorHeader (k, v) = BLC8.pack k `BL.append` BLC8.pack ": " `BL.append` BLC8.pack v armorData :: ByteString -> ByteString armorData = BLC8.unlines . wordWrap 64 . BL.fromChunks . return . Base64.encode . B.concat . BL.toChunks wordWrap :: Int -> ByteString -> [ByteString] wordWrap lw bs | BL.null bs = [] | lw < 1 || lw > 76 = wordWrap 76 bs | otherwise = BL.take (fromIntegral lw) bs : wordWrap lw (BL.drop (fromIntegral lw) bs) armorChecksum :: ByteString -> ByteString armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPut . putWord32be . crc24Lazy dashEscape :: ByteString -> ByteString dashEscape = BLC8.unlines . map escapeLine . BLC8.lines where escapeLine :: ByteString -> ByteString escapeLine l | BLC8.singleton '-' `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l | BLC8.pack "From " `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l | otherwise = l openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs0000644000000000000000000001541213506152052023470 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( parseArmor , decode , decodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Codec.Encryption.OpenPGP.ASCIIArmor.Utils import Control.Applicative (many, (<|>), (<$>), (<*), (<*>), (*>), optional) import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, ()) 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.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.Binary.Get (Get, runGetOrFail, getWord8) import Data.Functor (($>)) import Data.String (IsString, fromString) import Data.Word (Word32) decode :: IsString e => B.ByteString -> Either e [Armor] decode bs = go (AS.parse parseArmors bs) where go (AS.Fail _ _ e) = Left (fromString e) go (AS.Partial cont) = go (cont B.empty) go (AS.Done _ r) = Right r decodeLazy :: IsString e => BL.ByteString -> Either e [Armor] decodeLazy bs = go (AL.parse parseArmors bs) where go (AL.Fail _ _ e) = Left (fromString e) go (AL.Done _ r) = Right r parseArmors :: Parser [Armor] parseArmors = many parseArmor parseArmor :: Parser Armor parseArmor = prefixed (clearsigned <|> armor) "armor" clearsigned :: Parser Armor clearsigned = do _ <- string "-----BEGIN PGP SIGNED MESSAGE-----" "clearsign header" _ <- lineEnding "line ending" headers <- armorHeaders "clearsign headers" _ <- blankishLine "blank line" cleartext <- dashEscapedCleartext sig <- armor return $ ClearSigned headers cleartext sig armor :: Parser Armor armor = do atype <- beginLine "begin line" headers <- armorHeaders "headers" _ <- blankishLine "blank line" payload <- base64Data "base64 data" _ <- endLine atype "end line" return $ Armor atype headers payload beginLine :: Parser ArmorType beginLine = do _ <- string "-----BEGIN PGP " "leading minus-hyphens" atype <- pubkey <|> privkey <|> parts <|> message <|> signature _ <- string "-----" "trailing minus-hyphens" _ <- many (satisfy (inClass " \t")) "whitespace" _ <- lineEnding "line ending" return atype where message = string "MESSAGE" $> ArmorMessage pubkey = string "PUBLIC KEY BLOCK" $> ArmorPublicKeyBlock privkey = string "PRIVATE KEY BLOCK" $> ArmorPrivateKeyBlock signature = string "SIGNATURE" $> ArmorSignature parts = string "MESSAGE, PART " *> (partsdef <|> partsindef) partsdef = do firstnum <- num _ <- word8 (fromIntegral . fromEnum $ '/') secondnum <- num return $ ArmorSplitMessage (BL.pack firstnum) (BL.pack secondnum) partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num num = many1 (satisfy isDigit_w8) "number" lineEnding :: Parser B.ByteString lineEnding = string "\n" <|> string "\r\n" armorHeaders :: Parser [(String, String)] armorHeaders = many armorHeader armorHeader :: Parser (String, String) armorHeader = do key <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) _ <- string ": " val <- many1 (satisfy (notInClass "\n\r")) _ <- lineEnding return (w8sToString key, w8sToString val) where w8sToString = BC8.unpack . B.pack blankishLine :: Parser B.ByteString blankishLine = many (satisfy (inClass " \t")) *> lineEnding endLine :: ArmorType -> Parser B.ByteString endLine atype = do _ <- string $ "-----END PGP " `B.append` aType atype `B.append` "-----" lineEnding aType :: ArmorType -> B.ByteString aType ArmorMessage = BC8.pack "MESSAGE" aType ArmorPublicKeyBlock = BC8.pack "PUBLIC KEY BLOCK" aType ArmorPrivateKeyBlock = BC8.pack "PRIVATE KEY BLOCK" aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.append` BC8.singleton '/' `B.append` l2s y aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x aType ArmorSignature = BC8.pack "SIGNATURE" l2s :: BL.ByteString -> B.ByteString l2s = B.concat . BL.toChunks base64Data :: Parser ByteString base64Data = do ls <- many1 base64Line cksum <- checksumLine let payload = B.concat ls let ourcksum = crc24 payload 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 B.ByteString base64Line = do b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) pad <- many (word8 (fromIntegral . fromEnum $ '=')) _ <- lineEnding let line = B.pack b64 `B.append` B.pack pad case Base64.decode line of Left err -> fail err Right bs -> return bs checksumLine :: Parser B.ByteString checksumLine = do _ <- word8 (fromIntegral . fromEnum $ '=') b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) _ <- lineEnding let line = B.pack b64 case Base64.decode line of Left err -> fail err Right bs -> return bs d24 :: Get Word32 d24 = do a <- getWord8 b <- getWord8 c <- getWord8 return $ shiftL (fromIntegral a :: Word32) 16 + shiftL (fromIntegral b :: Word32) 8 + (fromIntegral c :: Word32) prefixed :: Parser a -> Parser a prefixed end = end <|> anyChar *> prefixed end dashEscapedCleartext :: Parser ByteString dashEscapedCleartext = do ls <- many1 ((deLine <|> unescapedLine) <* lineEnding) return . BL.fromStrict $ crlfUnlines ls where deLine :: Parser B.ByteString deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r"))) unescapedLine :: Parser B.ByteString unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r"))) openpgp-asciiarmor-0.1.2/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs0000644000000000000000000000203613506152052024264 0ustar0000000000000000-- ASCIIArmor/Multipart.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright © 2012 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Multipart ( multipartMerge ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL multipartMerge :: [Armor] -> Armor multipartMerge as' = go as' (Armor ArmorMessage [] BL.empty) where go :: [Armor] -> Armor -> Armor go [] state = state go (Armor at hs bs:as) state = go as (go' at hs bs state) go _ _ = error "This shouldn't happen." go' :: ArmorType -> [(String,String)] -> ByteString -> Armor -> Armor go' (ArmorSplitMessage _ _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `BL.append` bs) go' (ArmorSplitMessageIndefinite _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `BL.append` bs) go' _ _ _ state = state openpgp-asciiarmor-0.1.2/tests/0000755000000000000000000000000013506152052014640 5ustar0000000000000000openpgp-asciiarmor-0.1.2/tests/suite.hs0000644000000000000000000001276713506152052016342 0ustar0000000000000000import Test.Tasty (defaultMain, testGroup, TestTree) import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase) import Codec.Encryption.OpenPGP.ASCIIArmor (decode, decodeLazy, encode, encodeLazy, multipartMerge) import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Codec.Encryption.OpenPGP.ASCIIArmor.Utils import Data.ByteString (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.Lazy.Char8 as BLC8 import Data.Digest.CRC24 (crc24) import Data.Word (Word32) testCRC24 :: ByteString -> Word32 -> Assertion testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) testArmorDecode :: FilePath -> [FilePath] -> Assertion testArmorDecode fp targets = do bs <- BL.readFile $ "tests/data/" ++ fp tbss <- mapM (\target -> BL.readFile $ "tests/data/" ++ target) targets case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbss (map getPayload as) where getPayload (Armor _ _ pl) = pl getPayload _ = error "This should not happen." testArmorMultipartDecode :: FilePath -> FilePath -> Assertion testArmorMultipartDecode fp target = do bs <- BL.readFile $ "tests/data/" ++ fp tbs <- BL.readFile $ "tests/data/" ++ target case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbs (getPayload (multipartMerge as)) where getPayload (Armor _ _ pl) = pl getPayload _ = error "This should not happen." testClearsignedDecodeBody :: FilePath -> FilePath -> Assertion testClearsignedDecodeBody fp target = do bs <- BL.readFile $ "tests/data/" ++ fp tbs <- BL.readFile $ "tests/data/" ++ target case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right [a] -> assertEqual ("for " ++ fp) (convertEndings tbs) (getBody a) _ -> assertFailure "This shouldn't happen." where getBody (ClearSigned _ txt _) = txt getBody _ = error "This should not happen." convertEndings = crlfUnlinesLazy . BLC8.lines testClearsignedDecodeSig :: FilePath -> FilePath -> Assertion testClearsignedDecodeSig fp target = do bs <- BL.readFile $ "tests/data/" ++ fp tbs <- BL.readFile $ "tests/data/" ++ target case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right [a] -> assertEqual ("for " ++ fp) tbs (getSig a) _ -> assertFailure "This shouldn't happen." where getSig (ClearSigned _ _ (Armor _ _ sig)) = sig getSig _ = error "This should not happen." testArmorEncode :: [FilePath] -> FilePath -> Assertion testArmorEncode fps target = do bss <- mapM (\fp -> BL.readFile $ "tests/data/" ++ fp) fps tbs <- BL.readFile $ "tests/data/" ++ target assertEqual "literaldata" tbs (encodeLazy (map (Armor ArmorMessage [("Version","OpenPrivacy 0.99")]) bss)) testClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion testClearsignedEncode ftxt fsig ftarget = do txt <- BL.readFile $ "tests/data/" ++ ftxt sig <- BL.readFile $ "tests/data/" ++ fsig target <- BL.readFile $ "tests/data/" ++ ftarget assertEqual "clearsigned encode" target (encodeLazy [ClearSigned [("Hash","SHA1")] txt (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] sig)]) testStrictDecode :: FilePath -> Assertion testStrictDecode fp = do bs <- BL.readFile $ "tests/data/" ++ fp assertEqual "strict decode" (decodeLazy bs :: Either String [Armor]) (decode (B.concat . BL.toChunks $ bs) :: Either String [Armor]) testStrictEncode :: FilePath -> Assertion testStrictEncode fp = do bs <- BL.readFile $ "tests/data/" ++ fp let fakearmors = [Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs, ClearSigned [("Hash","SHA1")] bs (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] bs)] assertEqual "strict encode" (encodeLazy fakearmors) (BL.fromChunks [encode fakearmors]) tests :: TestTree tests = testGroup "openpgp-asciiarmor" [ testGroup "CRC24" [ testCase "CRC24: A" (testCRC24 (BC8.pack "A") 16680698) , testCase "CRC24: Haskell" (testCRC24 (BC8.pack "Haskell") 15612750) , testCase "CRC24: hOpenPGP and friends" (testCRC24 (BC8.pack "hOpenPGP and friends") 11940960) ] , testGroup "ASCII armor" [ testCase "Decode sample armor" (testArmorDecode "msg1.asc" ["msg1.gpg"]) , testCase "Decode sample armor with cruft" (testArmorDecode "msg1a.asc" ["msg1.gpg"]) , testCase "Decode multiple sample armors" (testArmorDecode "msg1b.asc" ["msg1.gpg","msg1.gpg","msg1.gpg"]) , testCase "Decode detached signature" (testArmorDecode "msg4.asc" ["msg4.sig"]) , testCase "Decode multi-part armor" (testArmorMultipartDecode "msg2.asc" "msg2.pgp") , testCase "Decode body of clear-signed" (testClearsignedDecodeBody "msg3.asc" "msg3") , testCase "Decode sig of clear-signed" (testClearsignedDecodeSig "msg3.asc" "msg3.sig") , testCase "Encode sample armor" (testArmorEncode ["msg1.gpg"] "msg1.asc") , testCase "Encode multiple sample armors" (testArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc") , testCase "Encode clear-signed sig" (testClearsignedEncode "msg3" "msg3.sig" "msg3.asc") , testCase "Decode from strict ByteString" (testStrictDecode "msg1.asc") , testCase "Encode to strict ByteString" (testStrictEncode "msg1.gpg") ] ] main :: IO () main = defaultMain tests openpgp-asciiarmor-0.1.2/tests/data/0000755000000000000000000000000013506152052015551 5ustar0000000000000000openpgp-asciiarmor-0.1.2/tests/data/msg30000644000000000000000000000036713506152052016353 0ustar0000000000000000This is a message that will be clearsigned. From RFC4880, we know that some of these lines should be dash-escaped. -Lines starting with a minus-hyphen MUST be escaped. - Lines starting with "From" SHOULD be escaped. Other lines MAY be escaped. openpgp-asciiarmor-0.1.2/tests/data/msg4.asc0000644000000000000000000000150413506152052017113 0ustar0000000000000000-----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.12 (GNU/Linux) iQIcBAABAgAGBQJPmZE0AAoJEN/7iwtcb1WC6EcQAK+NpDfsgTJgq+5nhZLZQcDC +b+8K5eDn+Z/btFZz1h2mF3Y+MpJdgG5fvSSHsYRWiGuT8OBK5wm3vSYnSr8BeA5 JUJDdhasF7LVosb0ToNiWLbtj9D9iiqmCaPW56Y2u3Ktv5Y4nOAWZw31OGv21B1c ptYVv2iy1qPGgnHxYgM5ib37hzKlkTEGKFNMpfYqsMBZyXiKuLpVhEWelawMnCPJ 3b7loOhYvR1Odmolg0dmcFsay7s3uXC/nze+xqTM0Z1HnMxQVW54aixhOoajDO6V p7OUUN5g/PBXHvx/gh7gPqgRCazo93rHSgoP//AoEuljrU4W9iNpCEcE5HTdYx0b xh10WxWE4VHI8BVt5qhSzPe8BmFRWz+g9CmsJdmhw45W8XxRJMJwoTWzGPcmHTFk JTOgJ9/MKcBvYGsBd0wGYq82DbDPdtwGgh5Aa3nz1dxzLCq7qIhOa3VEYKAhCjTx UHWnKZrdjSKz8U4D6CECyxlK5UApPc4jWzn3XYCX8s2F84YW7htduE57Yf60bXom aefIbDWef1Q4MOUV10h1gyjXtdSiIHvJ0ItvGKmRiXztjhq6+azYN+4RaXzpF5/N pqG/DNeTouzMRSzEoLTQ2oBHB8VIbCnP6J2Ck3wPfJZfc6FyCv0gMPQ5pTToll97 6toTAyOHl3pI/inp7IGj =TJqj -----END PGP SIGNATURE----- openpgp-asciiarmor-0.1.2/tests/data/msg2.asc0000644000000000000000000000056213506152052017114 0ustar0000000000000000-----BEGIN PGP MESSAGE, PART 01/02----- Version: ClosedPrivacy 0.99 pgAAAHnw/J+O5ibiYizWTVDTrl/FUe926aD7lhNS+qjFNASGRmSSvWqWyubVcW0Z YnVtKfpv03Y+zIUQv+TATmWcwpkzhQ9QeTk70ZBFFmNXsuM12dTQGkY8IDRsmUT9 =H7u4 -----END PGP MESSAGE, PART 01/02----- -----BEGIN PGP MESSAGE, PART 02/02----- m+f4GTQ2FwJzO0GeazzBV4ywKLqSnCQVFBNKhDnw =hLwC -----END PGP MESSAGE, PART 02/02----- openpgp-asciiarmor-0.1.2/tests/data/msg1a.asc0000644000000000000000000000041113506152052017245 0ustar0000000000000000This file contains an ASCII-armored PGP message enclosed between -----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- two lines of arbitrary text. openpgp-asciiarmor-0.1.2/tests/data/msg4.sig0000644000000000000000000000103713506152052017130 0ustar0000000000000000O4  \oUG72`gA+nYXv]Iv~Z!OÁ+&*9%BCvբNbX* 6r8g 8k\h֣Ƃqb921(SL*YxUE #ݾXNvj%Gfp[˻7p7ƤѝGPUnxj,a: P`W> zJ (cN#iGtct[QmRaQ[?)%١ÎV|Q$p5&1d%3')o`kwLb6 v@kys,*NkuD`! 4Pu)ݍ"N!J@)=#[9]ͅ]N{amz&il5T80Hu(׵Ԣ {Ћo|7i|ͦ דE,ĠڀGHl)蝂||_sr 094_{#zH)쁣openpgp-asciiarmor-0.1.2/tests/data/msg3.asc0000644000000000000000000000214713506152052017116 0ustar0000000000000000-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 This is a message that will be clearsigned. - From RFC4880, we know that some of these lines should be dash-escaped. - -Lines starting with a minus-hyphen MUST be escaped. - - Lines starting with "From" SHOULD be escaped. Other lines MAY be escaped. -----BEGIN PGP SIGNATURE----- Version: OpenPrivacy 0.99 iQIcBAEBAgAGBQJPmXqrAAoJEN/7iwtcb1WCG3AQAJ6TBeX12YDI1f/AdtV46quG augJYpYZvBbKESGXue1Nv22a7uH4h8LgWRsaEQxMBUwJvlMJfNkjEMAkXQbkj/Og J+78bAGMV1GtC5MuwPr8E+M8Z/uHhbzj3fWuUask0Q057u655YIEdlnY4OcZv9jW hT+/2kNcC8aw9+kg0I175XNxwBhRXoRKX6dhyAkRSnz7yuQtGXH7kQJAt7TOxxAb dud+u5IJixDPebG+NONPfuW5VB8erByW6UPIy4BQBnaxflSD8qJXxCDMWNzOBlYG whKXDmlcVgy3J7ghSh2zcFcZhM30Ng49t6k57HOXR9XnI5dskY45yns2nD4kt58/ 7anmscGGj0S3pzoUuFAdVIEvziYDhISs35CmTmNh4r4LVuh4R+Zurt3mbe8O6amm ZOWZzPsEDX/13B/DnL//70jVhTXUBqDj6MeNj5XHXVbIlfmIyeVLOIXiT/+u1FFt +0ERqwFI152GGJJWlikn5bR6P89Xz+04OeTBdxV1fCGt+hlvN6e5X9K15P16QDiq 4COHMZyIyHbtQr92BIj0P46WNsNZJDaoegHl6xtbq60eV3W+LRvgHNphjE+mdIp0 EV5lBqDGupGYpHkPjZBg0pqASs0Xd3P7SwkoVimtH7mXCPrL4K+o6X8IwsfEMCGY Ddej4NK0eolGoz/1sKB0 =ZShm -----END PGP SIGNATURE----- openpgp-asciiarmor-0.1.2/tests/data/msg1.gpg0000644000000000000000000000007213506152052017116 0ustar00000000000000008;mΉy% yy ٩ ũE@ҼԢT{.openpgp-asciiarmor-0.1.2/tests/data/msg1.asc0000644000000000000000000000025113506152052017106 0ustar0000000000000000-----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- openpgp-asciiarmor-0.1.2/tests/data/msg40000644000000000000000000000003713506152052016346 0ustar0000000000000000This message is detach-signed. openpgp-asciiarmor-0.1.2/tests/data/msg3.sig0000644000000000000000000000103713506152052017127 0ustar0000000000000000Oz  \oUpـvx꫆j b!MmY LL S |#$]'lWQ .$?D:PT/&ߐNca VxGnm驦d ÜHՅ5Ǎ]VȕK8OQmAHםV)'z?W89wu|!o7_ҵz@8#1vBv?6Y$6z[Wu-aOtt^eƺy`ҚJwsK (V)௨0! ףҴzF?topenpgp-asciiarmor-0.1.2/tests/data/msg1b.asc0000644000000000000000000000116713506152052017257 0ustar0000000000000000This file contains three ASCII-armored PGP messages interspersed -----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- -----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- with arbitrary text. -----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- All three messages are identical. openpgp-asciiarmor-0.1.2/tests/data/msg2.pgp0000644000000000000000000000017613506152052017135 0ustar0000000000000000y&b,MPӮ_QvR4Fdjqmbum)ov>̅Ne™3Py9;ѐEcW5F< 4lD46s;Ak