crypton-pem (empty) → 0.2.4

raw patch · 8 files changed

+361/−0 lines, 8 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, basement, bytestring, crypton-pem, memory, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

Data/PEM.hs +18/−0
Data/PEM/Parser.hs +97/−0
Data/PEM/Types.hs +28/−0
Data/PEM/Writer.hs +48/−0
LICENSE +27/−0
Setup.hs +2/−0
Tests/pem.hs +83/−0
crypton-pem.cabal +58/−0

+ Data/PEM.hs view

@@ -0,0 +1,18 @@+-- |
+-- 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 view

@@ -0,0 +1,97 @@+{-# 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 view

@@ -0,0 +1,28 @@+-- |
+-- 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 view

@@ -0,0 +1,48 @@+{-# 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

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2010-2018 Vincent Hanquez <vincent@snarc.org>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ Tests/pem.hs view

@@ -0,0 +1,83 @@+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

@@ -0,0 +1,58 @@+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