crypton-pem 0.2.4 → 0.2.5
raw patch · 13 files changed
+424/−332 lines, 13 filesdep +deepseqPVP ok
version bump matches the API change (PVP)
Dependencies added: deepseq
API changes (from Hackage documentation)
Files
- CHANGELOG.md +24/−0
- Data/PEM.hs +0/−18
- Data/PEM/Parser.hs +0/−97
- Data/PEM/Types.hs +0/−28
- Data/PEM/Writer.hs +0/−48
- README.md +15/−0
- Tests/pem.hs +0/−83
- crypton-pem.cabal +63/−58
- src/Data/PEM.hs +19/−0
- src/Data/PEM/Parser.hs +108/−0
- src/Data/PEM/Types.hs +41/−0
- src/Data/PEM/Writer.hs +51/−0
- test/Main.hs +103/−0
+ CHANGELOG.md view
@@ -0,0 +1,24 @@+Change log for `crypton-pem` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## 0.2.5 + +* Move library modules to directory `src`. +* Rename test-suite module as `test/Main.hs`. +* Add `CHANGELOG.md` and `README.md` to package. +* Make `PEM` an instance of type class `NFData`. +* Deprecate `PEM` instance of type class `NormalForm`. + +## 0.2.4 + +* Rename `pem-0.2.4` package as `crypton-pem-0.2.4`. +* Change maintainer field to `Mike Pilgrem <public@pilgrem.com>` and + `Kazu Yamamoto <kazu@iij.ad.jp>`. +* Add `CHANGELOG.md`. +* Cabal file specifies `cabal-version: 1.12` (not `>= 1.8`). +* Cabal file specifies expressly `default-language: Haskell98`
− Data/PEM.hs
@@ -1,18 +0,0 @@--- | --- Module : Data.PEM --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : portable --- --- Read and write PEM files --- -module Data.PEM - ( module Data.PEM.Types - , module Data.PEM.Writer - , module Data.PEM.Parser - ) where - -import Data.PEM.Types -import Data.PEM.Writer -import Data.PEM.Parser
− Data/PEM/Parser.hs
@@ -1,97 +0,0 @@-{-# LANGUAGE OverloadedStrings #-} --- | --- Module : Data.PEM.Parser --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : portable --- --- Parse PEM content. --- --- A PEM contains contains from one to many PEM sections. --- Each section contains an optional key-value pair header --- and a binary content encoded in base64. --- -module Data.PEM.Parser - ( pemParseBS - , pemParseLBS - ) where - -import Data.Either (partitionEithers) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC - -import Data.PEM.Types -import Data.ByteArray.Encoding (Base(Base64), convertFromBase) -import qualified Data.ByteArray as BA - -type Line = L.ByteString - -parseOnePEM :: [Line] -> Either (Maybe String) (PEM, [Line]) -parseOnePEM = findPem - where beginMarker = "-----BEGIN " - endMarker = "-----END " - - findPem [] = Left Nothing - findPem (l:ls) = case beginMarker `prefixEat` l of - Nothing -> findPem ls - Just n -> getPemName getPemHeaders n ls - getPemName next n ls = - let (name, r) = L.break (== 0x2d) n in - case r of - "-----" -> next (LC.unpack name) ls - _ -> Left $ Just "invalid PEM delimiter found" - - getPemHeaders name lbs = - case getPemHeaderLoop lbs of - Left err -> Left err - Right (hdrs, lbs2) -> getPemContent name hdrs [] lbs2 - where getPemHeaderLoop [] = Left $ Just "invalid PEM: no more content in header context" - getPemHeaderLoop (r:rs) = -- FIXME doesn't properly parse headers yet - Right ([], r:rs) - - getPemContent :: String -> [(String,ByteString)] -> [BC.ByteString] -> [L.ByteString] -> Either (Maybe String) (PEM, [L.ByteString]) - getPemContent name hdrs contentLines lbs = - case lbs of - [] -> Left $ Just "invalid PEM: no end marker found" - (l:ls) -> case endMarker `prefixEat` l of - Nothing -> - case convertFromBase Base64 $ L.toStrict l of - Left err -> Left $ Just ("invalid PEM: decoding failed: " ++ err) - Right content -> getPemContent name hdrs (content : contentLines) ls - Just n -> getPemName (finalizePem name hdrs contentLines) n ls - finalizePem name hdrs contentLines nameEnd lbs - | nameEnd /= name = Left $ Just "invalid PEM: end name doesn't match start name" - | otherwise = - let pem = PEM { pemName = name - , pemHeader = hdrs - , pemContent = BA.concat $ reverse contentLines } - in Right (pem, lbs) - - prefixEat prefix x = - let (x1, x2) = L.splitAt (L.length prefix) x - in if x1 == prefix then Just x2 else Nothing - --- | parser to get PEM sections -pemParse :: [Line] -> [Either String PEM] -pemParse l - | null l = [] - | otherwise = case parseOnePEM l of - Left Nothing -> [] - Left (Just err) -> [Left err] - Right (p, remaining) -> Right p : pemParse remaining - --- | parse a PEM content using a strict bytestring -pemParseBS :: ByteString -> Either String [PEM] -pemParseBS b = pemParseLBS $ L.fromChunks [b] - --- | parse a PEM content using a dynamic bytestring -pemParseLBS :: L.ByteString -> Either String [PEM] -pemParseLBS bs = case partitionEithers $ pemParse $ map unCR $ LC.lines bs of - (x:_,_ ) -> Left x - ([] ,pems) -> Right pems - where unCR b | L.length b > 0 && L.last b == cr = L.init b - | otherwise = b - cr = fromIntegral $ fromEnum '\r'
− Data/PEM/Types.hs
@@ -1,28 +0,0 @@--- | --- Module : Data.PEM.Types --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : portable --- -module Data.PEM.Types where - -import Data.ByteString (ByteString) -import Basement.NormalForm - --- | Represent one PEM section --- --- for now headers are not serialized at all. --- this is just available here as a placeholder for a later implementation. -data PEM = PEM - { pemName :: String -- ^ the name of the section, found after the dash BEGIN tag. - , pemHeader :: [(String, ByteString)] -- ^ optionals key value pair header - , pemContent :: ByteString -- ^ binary content of the section - } deriving (Show,Eq) - -instance NormalForm PEM where - toNormalForm pem = - toNormalForm (pemName pem) `seq` nfLbs (pemHeader pem) `seq` pemContent pem `seq` () - where - nfLbs [] = () - nfLbs ((s,bs):l) = toNormalForm s `seq` bs `seq` nfLbs l
− Data/PEM/Writer.hs
@@ -1,48 +0,0 @@-{-# LANGUAGE OverloadedStrings #-} --- | --- Module : Data.PEM.Writer --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : portable --- -module Data.PEM.Writer - ( pemWriteLBS - , pemWriteBS - ) where - -import Data.PEM.Types -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy as L -import Data.ByteArray.Encoding (Base(Base64), convertToBase) - --- | write a PEM structure to a builder -pemWrite :: PEM -> L.ByteString -pemWrite pem = L.fromChunks $ ([begin,header]++section++[end]) - where begin = B.concat ["-----BEGIN ", sectionName, "-----\n"] - end = B.concat ["-----END ", sectionName, "-----\n" ] - section :: [ByteString] - section = map encodeLine $ splitChunks $ pemContent pem - header :: ByteString - header = if null $ pemHeader pem - then B.empty - else B.concat ((concatMap toHeader (pemHeader pem)) ++ ["\n"]) - toHeader :: (String, ByteString) -> [ByteString] - toHeader (k,v) = [ BC.pack k, ":", v, "\n" ] - -- expect only ASCII. need to find a type to represent it. - sectionName = BC.pack $ pemName pem - encodeLine l = convertToBase Base64 l `B.append` "\n" - - splitChunks b - | B.length b > 48 = let (x,y) = B.splitAt 48 b in x : splitChunks y - | otherwise = [b] - --- | convert a PEM structure to a bytestring -pemWriteBS :: PEM -> ByteString -pemWriteBS = B.concat . L.toChunks . pemWrite - --- | convert a PEM structure to a lazy bytestring -pemWriteLBS :: PEM -> L.ByteString -pemWriteLBS = pemWrite
+ README.md view
@@ -0,0 +1,15 @@+crypton-pem +=========== + +Originally forked from [pem-0.2.4](https://hackage.haskell.org/package/pem-0.2.4). + +Haskell library to read and write files in the Privacy Enhanced Message (PEM) +format. + +History +------- + +The [`pem`](https://hackage.haskell.org/package/pem) package was originated +and then maintained by Vincent Hanquez. For published reasons, he does not +intend to develop the package further after version 0.2.4 but he also does not +want to introduce other maintainers.
− Tests/pem.hs
@@ -1,83 +0,0 @@-module Main where - -import Control.Applicative -import Control.Monad - -import qualified Data.ByteString.Char8 as BC -import Test.QuickCheck hiding ((.&.)) -import Test.Framework (Test, defaultMain, testGroup) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit ((@=?)) - -import Data.PEM -import qualified Data.ByteString as B - -main :: IO () -main = defaultMain tests - -tests :: [Test] -tests = - [ testGroup "units" $ testUnits - , testDecodingMultiple - , testUnmatchingNames - , testProperty "marshall" testMarshall - ] - -testUnits = map (\(i, (p,bs)) -> testCase (show i) (pemWriteBS p @=? BC.pack bs)) - $ zip [0..] [ (p1, bp1), (p2, bp2) ] - where p1 = PEM { pemName = "abc", pemHeader = [], pemContent = B.replicate 64 0 } - bp1 = unlines - [ "-----BEGIN abc-----" - , "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" - , "AAAAAAAAAAAAAAAAAAAAAA==" - , "-----END abc-----" - ] - p2 = PEM { pemName = "xxx", pemHeader = [], pemContent = B.replicate 12 3 } - bp2 = unlines - [ "-----BEGIN xxx-----" - , "AwMDAwMDAwMDAwMD" - , "-----END xxx-----" - ] - -testDecodingMultiple = testCase ("multiple pems") (pemParseBS content @=? Right expected) - where expected = [ PEM { pemName = "marker", pemHeader = [], pemContent = B.replicate 12 3 } - , PEM { pemName = "marker2", pemHeader = [], pemContent = B.replicate 64 0 } - ] - content = BC.pack $ unlines - [ "some text that is not related to PEM" - , "and is just going to be ignored by the PEM parser." - , "" - , "even empty lines should be skip until the rightful marker" - , "-----BEGIN marker-----" - , "AwMDAwMDAwMDAwMD" - , "-----END marker-----" - , "some middle text" - , "-----BEGIN marker2-----" - , "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" - , "AAAAAAAAAAAAAAAAAAAAAA==" - , "-----END marker2-----" - , "and finally some trailing text." - ] - -testUnmatchingNames = testCase "unmatching name" (let r = pemParseBS content in case r of - Left _ -> True @=? True - _ -> r @=? Left "") - where content = BC.pack $ unlines - [ "-----BEGIN marker-----" - , "AAAA" - , "-----END marker2-----" - ] - -testMarshall pems = readPems == Right pems - where readPems = pemParseBS writtenPems - writtenPems = B.concat (map pemWriteBS pems) - -arbitraryName = choose (1, 30) >>= \i -> replicateM i arbitraryAscii - where arbitraryAscii = elements ['A'..'Z'] - -arbitraryContent = choose (1,100) >>= \i -> - (B.pack . map fromIntegral) `fmap` replicateM i (choose (0,255) :: Gen Int) - -instance Arbitrary PEM where - arbitrary = PEM <$> arbitraryName <*> pure [] <*> arbitraryContent
crypton-pem.cabal view
@@ -1,58 +1,63 @@-cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.38.1. --- --- see: https://github.com/sol/hpack - -name: crypton-pem -version: 0.2.4 -synopsis: Privacy Enhanced Mail (PEM) format reader and writer. -description: Privacy Enhanced Mail (PEM) format reader and writer. long description -category: Data -stability: experimental -homepage: http://github.com/mpilgrem/crypton-pem -bug-reports: https://github.com/mpilgrem/crypton-pem/issues -author: Vincent Hanquez <vincent@snarc.org> -maintainer: Mike Pilgrem <public@pilgrem.com>, - Kazu Yamamoto <kazu@iij.ad.jp> -copyright: Vincent Hanquez <vincent@snarc.org> -license: BSD3 -license-file: LICENSE -build-type: Simple -extra-source-files: - Tests/pem.hs - -source-repository head - type: git - location: https://github.com/mpilgrem/crypton-pem - -library - exposed-modules: - Data.PEM - other-modules: - Data.PEM.Parser - Data.PEM.Writer - Data.PEM.Types - ghc-options: -Wall - build-depends: - base >=3 && <5 - , basement - , bytestring - , memory - default-language: Haskell98 - -test-suite test-pem - type: exitcode-stdio-1.0 - main-is: pem.hs - hs-source-dirs: - Tests - build-depends: - HUnit - , QuickCheck >=2.4.0.1 - , base - , bytestring - , crypton-pem - , test-framework >=0.3.3 - , test-framework-hunit - , test-framework-quickcheck2 - default-language: Haskell98 +cabal-version: 1.18 ++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name: crypton-pem+version: 0.2.5+synopsis: Privacy Enhanced Mail (PEM) file format reader and writer.+description: A library to read and write files in the Privacy Enhanced Mail (PEM) format.+category: Data+stability: experimental+homepage: http://github.com/mpilgrem/crypton-pem+bug-reports: https://github.com/mpilgrem/crypton-pem/issues+author: Vincent Hanquez <vincent@snarc.org>+maintainer: Mike Pilgrem <public@pilgrem.com>,+ Kazu Yamamoto <kazu@iij.ad.jp>+copyright: Vincent Hanquez <vincent@snarc.org>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-doc-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/mpilgrem/crypton-pem++library+ exposed-modules:+ Data.PEM+ other-modules:+ Data.PEM.Parser+ Data.PEM.Types+ Data.PEM.Writer+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=3 && <5+ , basement+ , bytestring+ , deepseq+ , memory+ default-language: Haskell98++test-suite test-pem+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ test+ ghc-options: -Wall+ build-depends:+ HUnit+ , QuickCheck >=2.4.0.1+ , base+ , bytestring+ , crypton-pem+ , test-framework >=0.3.3+ , test-framework-hunit+ , test-framework-quickcheck2+ default-language: Haskell98
+ src/Data/PEM.hs view
@@ -0,0 +1,19 @@+{- | +Module : Data.PEM +License : BSD-style +Copyright : (c) 2010-2018 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : portable + +Read and write Privacy Enhanced Mail (PEM) files. +-} + +module Data.PEM + ( module Data.PEM.Types + , module Data.PEM.Writer + , module Data.PEM.Parser + ) where + +import Data.PEM.Parser +import Data.PEM.Types +import Data.PEM.Writer
+ src/Data/PEM/Parser.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-} + +{- | +Module : Data.PEM.Parser +License : BSD-style +Copyright : (c) 2010-2018 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : portable + +Parse PEM content. + +A PEM contains contains one or more PEM sections. Each section contains an +optional key-value pair header and binary content encoded in base64. +-} + +module Data.PEM.Parser + ( pemParseBS + , pemParseLBS + ) where + +import qualified Data.ByteArray as BA +import Data.ByteArray.Encoding ( Base(..), convertFromBase ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC +import Data.Either ( partitionEithers ) +import Data.PEM.Types ( PEM (..) ) + +type Line = L.ByteString + +parseOnePEM :: [Line] -> Either (Maybe String) (PEM, [Line]) +parseOnePEM = findPem + where + beginMarker = "-----BEGIN " + endMarker = "-----END " + + findPem [] = Left Nothing + findPem (l:ls) = case beginMarker `prefixEat` l of + Nothing -> findPem ls + Just n -> getPemName getPemHeaders n ls + getPemName next n ls = + let (name, r) = L.break (== 0x2d) n in + case r of + "-----" -> next (LC.unpack name) ls + _ -> Left $ Just "invalid PEM delimiter found" + + getPemHeaders name lbs = + case getPemHeaderLoop lbs of + Left err -> Left err + Right (hdrs, lbs2) -> getPemContent name hdrs [] lbs2 + where + getPemHeaderLoop [] = + Left $ Just "invalid PEM: no more content in header context" + getPemHeaderLoop (r:rs) = -- FIXME doesn't properly parse headers yet + Right ([], r:rs) + + getPemContent :: + String + -> [(String,ByteString)] + -> [BC.ByteString] + -> [L.ByteString] + -> Either (Maybe String) (PEM, [L.ByteString]) + getPemContent name hdrs contentLines lbs = + case lbs of + [] -> Left $ Just "invalid PEM: no end marker found" + (l:ls) -> case endMarker `prefixEat` l of + Nothing -> + case convertFromBase Base64 $ L.toStrict l of + Left err -> Left $ Just ("invalid PEM: decoding failed: " ++ err) + Right content -> getPemContent name hdrs (content : contentLines) ls + Just n -> getPemName (finalizePem name hdrs contentLines) n ls + finalizePem name hdrs contentLines nameEnd lbs + | nameEnd /= name = + Left $ Just "invalid PEM: end name doesn't match start name" + | otherwise = + let pem = PEM { pemName = name + , pemHeader = hdrs + , pemContent = BA.concat $ reverse contentLines } + in Right (pem, lbs) + + prefixEat prefix x = + let (x1, x2) = L.splitAt (L.length prefix) x + in if x1 == prefix then Just x2 else Nothing + +-- | parser to get PEM sections +pemParse :: [Line] -> [Either String PEM] +pemParse l + | null l = [] + | otherwise = case parseOnePEM l of + Left Nothing -> [] + Left (Just err) -> [Left err] + Right (p, remaining) -> Right p : pemParse remaining + +-- | Parse PEM content from a strict 'ByteString'. +pemParseBS :: ByteString -> Either String [PEM] +pemParseBS b = pemParseLBS $ L.fromChunks [b] + +-- | Parse PEM content from a lazy 'Data.ByteString.Lazy.ByteString'. +pemParseLBS :: L.ByteString -> Either String [PEM] +pemParseLBS bs = case partitionEithers $ pemParse $ map unCR $ LC.lines bs of + (x:_,_ ) -> Left x + ([] ,pems) -> Right pems + where + unCR b + | L.length b > 0 && L.last b == cr = L.init b + | otherwise = b + cr = fromIntegral $ fromEnum '\r'
+ src/Data/PEM/Types.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +{- | +Module : Data.PEM.Types +License : BSD-style +Copyright : (c) 2010-2018 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : portable +-} + +module Data.PEM.Types + ( PEM (..) + ) where + +import Basement.NormalForm ( NormalForm (..) ) +import Control.DeepSeq ( NFData (..) ) +import Data.ByteString ( ByteString ) +import GHC.Generics ( Generic ) + +-- | A type representing single PEM sections. +data PEM = PEM + { pemName :: String + -- ^ The name of the section, found after the dash BEGIN tag. + , pemHeader :: [(String, ByteString)] + -- ^ Optional key-value pairs header. The library does not currently + -- serialize headers. + , pemContent :: ByteString + -- ^ Binary content of the section. + } + deriving (Eq, Generic, NFData, Show) + +-- | The t'PEM' instance of 'NormalForm' is deprecated and will be removed from +-- a future version of this package. See the 'NFData' type class exported by +-- "Control.DeepSeq" of the @deepseq@ GHC boot package. +instance NormalForm PEM where + toNormalForm pem = + toNormalForm (pemName pem) `seq` nfLbs (pemHeader pem) `seq` pemContent pem `seq` () + where + nfLbs [] = () + nfLbs ((s,bs):l) = toNormalForm s `seq` bs `seq` nfLbs l
+ src/Data/PEM/Writer.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-} + +{- | +Module : Data.PEM.Writer +License : BSD-style +Copyright : (c) 2010-2018 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : portable +-} + +module Data.PEM.Writer + ( pemWriteBS + , pemWriteLBS + ) where + +import Data.ByteArray.Encoding ( Base (..), convertToBase ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as L +import Data.PEM.Types ( PEM (..) ) + +-- | Write a t'PEM' to a lazy 'Data.ByteString.Lazy.ByteString'. +pemWrite :: PEM -> L.ByteString +pemWrite pem = L.fromChunks ([begin, header] ++ section ++ [end]) + where + begin = B.concat ["-----BEGIN ", sectionName, "-----\n"] + end = B.concat ["-----END ", sectionName, "-----\n" ] + section :: [ByteString] + section = map encodeLine $ splitChunks $ pemContent pem + header :: ByteString + header = if null $ pemHeader pem + then B.empty + else B.concat (concatMap toHeader (pemHeader pem) ++ ["\n"]) + toHeader :: (String, ByteString) -> [ByteString] + toHeader (k,v) = [ BC.pack k, ":", v, "\n" ] + -- expect only ASCII. need to find a type to represent it. + sectionName = BC.pack $ pemName pem + encodeLine l = convertToBase Base64 l `B.append` "\n" + + splitChunks b + | B.length b > 48 = let (x,y) = B.splitAt 48 b in x : splitChunks y + | otherwise = [b] + +-- | Convert the specified t'PEM' to a strict 'ByteString'. +pemWriteBS :: PEM -> ByteString +pemWriteBS = B.concat . L.toChunks . pemWrite + +-- | Convert the specified t'PEM' to a lazy 'Data.ByteString.Lazy.ByteString'. +pemWriteLBS :: PEM -> L.ByteString +pemWriteLBS = pemWrite
+ test/Main.hs view
@@ -0,0 +1,103 @@+{-# OPTIONS_GHC -Wno-orphans #-} + +module Main + ( main + ) where + +import Control.Monad ( replicateM ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.PEM ( PEM (..), pemParseBS, pemWriteBS ) +import Test.Framework ( Test, defaultMain, testGroup ) +import Test.Framework.Providers.QuickCheck2 ( testProperty ) +import Test.Framework.Providers.HUnit ( testCase ) +import Test.HUnit ( (@=?) ) +import Test.QuickCheck ( Arbitrary (..), Gen, choose, elements ) + +main :: IO () +main = defaultMain tests + +tests :: [Test] +tests = + [ testGroup "units" testUnits + , testDecodingMultiple + , testUnmatchingNames + , testProperty "marshall" testMarshall + ] + +testUnits :: [Test] +testUnits = zipWith + (curry (\(i, (p, bs)) -> testCase (show i) (pemWriteBS p @=? BC.pack bs))) + [ 0 :: Int .. ] + [ (p1, bp1), (p2, bp2) ] + where + p1 = PEM { pemName = "abc", pemHeader = [], pemContent = B.replicate 64 0 } + bp1 = unlines + [ "-----BEGIN abc-----" + , "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + , "AAAAAAAAAAAAAAAAAAAAAA==" + , "-----END abc-----" + ] + p2 = PEM { pemName = "xxx", pemHeader = [], pemContent = B.replicate 12 3 } + bp2 = unlines + [ "-----BEGIN xxx-----" + , "AwMDAwMDAwMDAwMD" + , "-----END xxx-----" + ] + +testDecodingMultiple :: Test +testDecodingMultiple = + testCase "multiple pems" (pemParseBS content @=? Right expected) + where + expected = + [ PEM { pemName = "marker", pemHeader = [], pemContent = B.replicate 12 3 } + , PEM { pemName = "marker2", pemHeader = [], pemContent = B.replicate 64 0 } + ] + content = BC.pack $ unlines + [ "some text that is not related to PEM" + , "and is just going to be ignored by the PEM parser." + , "" + , "even empty lines should be skip until the rightful marker" + , "-----BEGIN marker-----" + , "AwMDAwMDAwMDAwMD" + , "-----END marker-----" + , "some middle text" + , "-----BEGIN marker2-----" + , "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" + , "AAAAAAAAAAAAAAAAAAAAAA==" + , "-----END marker2-----" + , "and finally some trailing text." + ] + +testUnmatchingNames :: Test +testUnmatchingNames = + testCase "unmatching name" + ( let r = pemParseBS content + in case r of + Left _ -> True @=? True + _ -> r @=? Left "" + ) + where + content = BC.pack $ unlines + [ "-----BEGIN marker-----" + , "AAAA" + , "-----END marker2-----" + ] + +testMarshall :: [PEM] -> Bool +testMarshall pems = readPems == Right pems + where + readPems = pemParseBS writtenPems + writtenPems = B.concat (map pemWriteBS pems) + +arbitraryName :: Gen [Char] +arbitraryName = choose (1, 30) >>= \i -> replicateM i arbitraryAscii + where + arbitraryAscii = elements ['A'..'Z'] + +arbitraryContent :: Gen B.ByteString +arbitraryContent = choose (1,100) >>= \i -> + (B.pack . map fromIntegral) `fmap` replicateM i (choose (0,255) :: Gen Int) + +instance Arbitrary PEM where + arbitrary = PEM <$> arbitraryName <*> pure [] <*> arbitraryContent