crypton-asn1-types 0.3.4 → 0.3.5
raw patch · 15 files changed
+609/−523 lines, 15 filesdep +base16dep −memoryPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: base16
Dependencies removed: memory
API changes (from Hackage documentation)
- Data.ASN1.BitArray: data BitArrayOutOfBound
+ Data.ASN1.BitArray: newtype BitArrayOutOfBound
+ Data.ASN1.Types: type OID = [Integer]
Files
- CHANGELOG.md +8/−0
- Data/ASN1/BitArray.hs +0/−82
- Data/ASN1/OID.hs +0/−27
- Data/ASN1/Pretty.hs +0/−78
- Data/ASN1/Types.hs +0/−69
- Data/ASN1/Types/Lowlevel.hs +0/−47
- Data/ASN1/Types/String.hs +0/−174
- README.md +2/−3
- crypton-asn1-types.cabal +46/−43
- src/Data/ASN1/BitArray.hs +86/−0
- src/Data/ASN1/OID.hs +27/−0
- src/Data/ASN1/Pretty.hs +104/−0
- src/Data/ASN1/Types.hs +76/−0
- src/Data/ASN1/Types/Lowlevel.hs +52/−0
- src/Data/ASN1/Types/String.hs +208/−0
CHANGELOG.md view
@@ -6,6 +6,14 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.3.5 + +* Move library modules to directory `src`. +* Change data type `BitArrayOutOfBound` (a single, unary data constructor + without strictness annotation) to `newtype`. +* Depend on the `base16` package, remove direct dependency on the `memory` + package and the indirect dependency on the `basement` package. + ## 0.3.4 * Rename `asn1-types-0.3.4` package as `crypton-asn1-types-0.3.4`.
− Data/ASN1/BitArray.hs
@@ -1,82 +0,0 @@--- | --- Module : Data.ASN1.BitArray --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown --- -{-# LANGUAGE DeriveDataTypeable #-} -module Data.ASN1.BitArray - ( BitArray(..) - , BitArrayOutOfBound(..) - , bitArrayLength - , bitArrayGetBit - , bitArraySetBitValue - , bitArraySetBit - , bitArrayClearBit - , bitArrayGetData - , toBitArray - ) where - -import Data.Bits -import Data.Word -import Data.Maybe -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Typeable -import Control.Exception (Exception, throw) - --- | throwed in case of out of bounds in the bitarray. -data BitArrayOutOfBound = BitArrayOutOfBound Word64 - deriving (Show,Eq,Typeable) -instance Exception BitArrayOutOfBound - --- | represent a bitarray / bitmap --- --- the memory representation start at bit 0 -data BitArray = BitArray Word64 ByteString - deriving (Show,Eq) - --- | returns the length of bits in this bitarray -bitArrayLength :: BitArray -> Word64 -bitArrayLength (BitArray l _) = l - -bitArrayOutOfBound :: Word64 -> a -bitArrayOutOfBound n = throw $ BitArrayOutOfBound n - --- | get the nth bits -bitArrayGetBit :: BitArray -> Word64 -> Bool -bitArrayGetBit (BitArray l d) n - | n >= l = bitArrayOutOfBound n - | otherwise = flip testBit (7-fromIntegral bitn) $ B.index d (fromIntegral offset) - where (offset, bitn) = n `divMod` 8 - --- | set the nth bit to the value specified -bitArraySetBitValue :: BitArray -> Word64 -> Bool -> BitArray -bitArraySetBitValue (BitArray l d) n v - | n >= l = bitArrayOutOfBound n - | otherwise = - let (before,after) = B.splitAt (fromIntegral offset) d in - -- array bound check before prevent fromJust from failing. - let (w,remaining) = fromJust $ B.uncons after in - BitArray l (before `B.append` (setter w (7-fromIntegral bitn) `B.cons` remaining)) - where - (offset, bitn) = n `divMod` 8 - setter = if v then setBit else clearBit - --- | set the nth bits -bitArraySetBit :: BitArray -> Word64 -> BitArray -bitArraySetBit bitarray n = bitArraySetBitValue bitarray n True - --- | clear the nth bits -bitArrayClearBit :: BitArray -> Word64 -> BitArray -bitArrayClearBit bitarray n = bitArraySetBitValue bitarray n False - --- | get padded bytestring of the bitarray -bitArrayGetData :: BitArray -> ByteString -bitArrayGetData (BitArray _ d) = d - --- | number of bit to skip at the end (padding) -toBitArray :: ByteString -> Int -> BitArray -toBitArray l toSkip = - BitArray (fromIntegral (B.length l * 8 - fromIntegral toSkip)) l
− Data/ASN1/OID.hs
@@ -1,27 +0,0 @@--- | --- Module : Data.ASN1.OID --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown --- -{-# LANGUAGE DeriveDataTypeable #-} -module Data.ASN1.OID - ( OID - -- * classes - , OIDable(..) - , OIDNameable(..) - ) where - --- | Standard ASN.1 Object ID (OID) -type OID = [Integer] - --- | Class of things that have an Object ID -class OIDable a where - -- | return the object ID of an Object from the ObjectIdentifiable class. - getObjectID :: a -> OID - --- | Class of things that can be named by Object ID -class OIDNameable a where - -- | Try to convert an OID into an Object - fromObjectID :: OID -> Maybe a
− Data/ASN1/Pretty.hs
@@ -1,78 +0,0 @@--- | --- Module : Data.ASN1.Pretty --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown --- -module Data.ASN1.Pretty - ( pretty - , PrettyType(..) - ) where - -import Data.ASN1.Types -import Data.ASN1.BitArray -import Data.ByteArray.Encoding (convertToBase, Base(..)) -import Data.ByteString (ByteString) -import Numeric (showHex) - -data PrettyType = Multiline Int -- Offset where to start - | SingleLine - deriving (Show,Eq) - --- | Pretty Print a list of ASN.1 element -pretty :: PrettyType -- ^ indent level in space character - -> [ASN1] -- ^ stream of ASN1 - -> String -pretty (Multiline at) = prettyPrint at - where - indent n = replicate n ' ' - - prettyPrint _ [] = "" - prettyPrint n (x@(Start _) : xs) = indent n ++ p id x ++ prettyPrint (n+1) xs - prettyPrint n (x@(End _) : xs) = indent (n-1) ++ p id x ++ prettyPrint (n-1) xs - prettyPrint n (x : xs) = indent n ++ p id x ++ prettyPrint n xs - -pretty SingleLine = prettyPrint - where - prettyPrint [] = "" - prettyPrint (x@(Start _) : xs) = p id x ++ "," ++ prettyPrint xs - prettyPrint (x@(End _) : xs) = p id x ++ "," ++ prettyPrint xs - prettyPrint (x : xs) = p id x ++ "," ++ prettyPrint xs - -p :: ([Char] -> t) -> ASN1 -> t -p put (Boolean b) = put ("bool: " ++ show b) -p put (IntVal i) = put ("int: " ++ showHex i "") -p put (BitString bits) = put ("bitstring: " ++ (hexdump $ bitArrayGetData bits)) -p put (OctetString bs) = put ("octetstring: " ++ hexdump bs) -p put (Null) = put "null" -p put (OID is) = put ("OID: " ++ show is) -p put (Real d) = put ("real: " ++ show d) -p put (Enumerated _) = put "enum" -p put (Start Sequence) = put "{" -p put (End Sequence) = put "}" -p put (Start Set) = put "[" -p put (End Set) = put "]" -p put (Start (Container x y)) = put ("< " ++ show x ++ " " ++ show y) -p put (End (Container x y)) = put ("> " ++ show x ++ " " ++ show y) -p put (ASN1String cs) = putCS put cs -p put (ASN1Time TimeUTC time tz) = put ("utctime: " ++ show time ++ " " ++ show tz) -p put (ASN1Time TimeGeneralized time tz) = put ("generalizedtime: " ++ show time ++ " " ++ show tz) -p put (Other tc tn x) = put ("other(" ++ show tc ++ "," ++ show tn ++ "," ++ show x ++ ")") - -putCS :: ([Char] -> t) -> ASN1CharacterString -> t -putCS put (ASN1CharacterString UTF8 t) = put ("utf8string:" ++ show t) -putCS put (ASN1CharacterString Numeric bs) = put ("numericstring:" ++ hexdump bs) -putCS put (ASN1CharacterString Printable t) = put ("printablestring: " ++ show t) -putCS put (ASN1CharacterString T61 bs) = put ("t61string:" ++ show bs) -putCS put (ASN1CharacterString VideoTex bs) = put ("videotexstring:" ++ hexdump bs) -putCS put (ASN1CharacterString IA5 bs) = put ("ia5string:" ++ show bs) -putCS put (ASN1CharacterString Graphic bs) = put ("graphicstring:" ++ hexdump bs) -putCS put (ASN1CharacterString Visible bs) = put ("visiblestring:" ++ hexdump bs) -putCS put (ASN1CharacterString General bs) = put ("generalstring:" ++ hexdump bs) -putCS put (ASN1CharacterString UTF32 t) = put ("universalstring:" ++ show t) -putCS put (ASN1CharacterString Character bs) = put ("characterstring:" ++ hexdump bs) -putCS put (ASN1CharacterString BMP t) = put ("bmpstring: " ++ show t) - -hexdump :: ByteString -> String -hexdump bs = show (convertToBase Base16 bs :: ByteString)
− Data/ASN1/Types.hs
@@ -1,69 +0,0 @@--- | --- Module : Data.ASN1.Types --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown --- -module Data.ASN1.Types - ( ASN1(..) - , ASN1S - , ASN1Class(..) - , ASN1Tag - , ASN1ConstructionType(..) - , ASN1StringEncoding(..) - , ASN1TimeType(..) - , ASN1Object(..) - , ASN1CharacterString(..) - , asn1CharacterString - , asn1CharacterToString - , module Data.ASN1.OID - ) where - -import Data.Hourglass -import Data.ASN1.BitArray -import Data.ASN1.OID -import Data.ASN1.Types.Lowlevel -import Data.ASN1.Types.String -import Data.ByteString (ByteString) - --- | Define the type of container -data ASN1ConstructionType = Sequence - | Set - | Container ASN1Class ASN1Tag - deriving (Show,Eq) - --- | Different ASN1 time representation -data ASN1TimeType = TimeUTC -- ^ ASN1 UTCTime Type: limited between 1950-2050 - | TimeGeneralized -- ^ ASN1 GeneralizedTime Type - deriving (Show,Eq,Ord) - --- | Define high level ASN1 object. -data ASN1 = - Boolean Bool - | IntVal Integer - | BitString BitArray - | OctetString ByteString - | Null - | OID OID - | Real Double - | Enumerated Integer - | ASN1String ASN1CharacterString - | ASN1Time ASN1TimeType DateTime (Maybe TimezoneOffset) - | Other ASN1Class ASN1Tag ByteString - | Start ASN1ConstructionType - | End ASN1ConstructionType - deriving (Show, Eq) - --- | represent a chunk of ASN1 Stream. --- this is equivalent to ShowS but for an ASN1 Stream. -type ASN1S = [ASN1] -> [ASN1] - --- | Define an object that can be converted to and from ASN.1 -class ASN1Object a where - -- | transform an object into a chunk of ASN1 stream. - toASN1 :: a -> ASN1S - - -- | returns either an object along the remaining ASN1 stream, - -- or an error. - fromASN1 :: [ASN1] -> Either String (a, [ASN1])
− Data/ASN1/Types/Lowlevel.hs
@@ -1,47 +0,0 @@--- | --- Module : Data.ASN1.Types.Lowlevel --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown --- -{-# LANGUAGE BangPatterns #-} -module Data.ASN1.Types.Lowlevel - ( - -- * Raw types - ASN1Class(..) - , ASN1Tag - , ASN1Length(..) - , ASN1Header(..) - -- * Events types - , ASN1Event(..) - ) where - -import Data.ByteString (ByteString) - --- | Element class -data ASN1Class = Universal - | Application - | Context - | Private - deriving (Show,Eq,Ord,Enum) - --- | ASN1 Tag -type ASN1Tag = Int - --- | ASN1 Length with all different formats -data ASN1Length = LenShort Int -- ^ Short form with only one byte. length has to be < 127. - | LenLong Int Int -- ^ Long form of N bytes - | LenIndefinite -- ^ Length is indefinite expect an EOC in the stream to finish the type - deriving (Show,Eq) - --- | ASN1 Header with the class, tag, constructed flag and length. -data ASN1Header = ASN1Header !ASN1Class !ASN1Tag !Bool !ASN1Length - deriving (Show,Eq) - --- | represent one event from an asn1 data stream -data ASN1Event = Header ASN1Header -- ^ ASN1 Header - | Primitive !ByteString -- ^ Primitive - | ConstructionBegin -- ^ Constructed value start - | ConstructionEnd -- ^ Constructed value end - deriving (Show,Eq)
− Data/ASN1/Types/String.hs
@@ -1,174 +0,0 @@--- | --- Module : Data.ASN1.Types.String --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown --- --- Different String types available in ASN1 --- -module Data.ASN1.Types.String - ( ASN1StringEncoding(..) - , ASN1CharacterString(..) - , asn1CharacterString - , asn1CharacterToString - ) where - -import Data.String -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import Data.Bits -import Data.Word - --- a note on T61 encodings. The actual specification of a T61 character set seems --- to be lost in time, as such it will be considered an ascii like encoding. --- --- <http://www.mail-archive.com/asn1@asn1.org/msg00460.html> --- "sizable volume of software in the world treats TeletexString (T61String) --- as a simple 8-bit string with mostly Windows Latin 1" - --- | Define all possible ASN1 String encoding. -data ASN1StringEncoding = - IA5 -- ^ 128 characters equivalent to the ASCII alphabet - | UTF8 -- ^ UTF8 - | General -- ^ all registered graphic and character sets (see ISO 2375) plus SPACE and DELETE. - | Graphic -- ^ all registered G sets and SPACE - | Numeric -- ^ encoding containing numeric [0-9] and space - | Printable -- ^ printable [a-z] [A-Z] [()+,-.?:/=] and space. - | VideoTex -- ^ CCITT's T.100 and T.101 character sets - | Visible -- ^ International ASCII printing character sets - | T61 -- ^ teletext - | UTF32 -- ^ UTF32 - | Character -- ^ Character - | BMP -- ^ UCS2 - deriving (Show,Eq,Ord) - --- | provide a way to possibly encode or decode character string based on character encoding -stringEncodingFunctions :: ASN1StringEncoding - -> Maybe (ByteString -> String, String -> ByteString) -stringEncodingFunctions encoding - | encoding == UTF8 = Just (decodeUTF8, encodeUTF8) - | encoding == BMP = Just (decodeBMP, encodeBMP) - | encoding == UTF32 = Just (decodeUTF32, encodeUTF32) - | encoding `elem` asciiLikeEncodings = Just (decodeASCII, encodeASCII) - | otherwise = Nothing - where asciiLikeEncodings = [IA5,Numeric,Printable,Visible,General,Graphic,T61] - --- | encode a string into a character string -asn1CharacterString :: ASN1StringEncoding -> String -> ASN1CharacterString -asn1CharacterString encoding s = - case stringEncodingFunctions encoding of - Just (_, e) -> ASN1CharacterString encoding (e s) - Nothing -> error ("cannot encode ASN1 Character String " ++ show encoding ++ " from string") - --- | try to decode an 'ASN1CharacterString' to a String -asn1CharacterToString :: ASN1CharacterString -> Maybe String -asn1CharacterToString (ASN1CharacterString encoding bs) = - case stringEncodingFunctions encoding of - Just (d, _) -> Just (d bs) - Nothing -> Nothing - --- | ASN1 Character String with encoding -data ASN1CharacterString = ASN1CharacterString - { characterEncoding :: ASN1StringEncoding - , getCharacterStringRawData :: ByteString - } deriving (Show,Eq,Ord) - -instance IsString ASN1CharacterString where - fromString s = ASN1CharacterString UTF8 (encodeUTF8 s) - -decodeUTF8 :: ByteString -> String -decodeUTF8 b = loop 0 $ B.unpack b - where loop :: Int -> [Word8] -> [Char] - loop _ [] = [] - loop pos (x:xs) - | x `isClear` 7 = toEnum (fromIntegral x) : loop (pos+1) xs - | x `isClear` 6 = error "continuation byte in heading context" - | x `isClear` 5 = uncont 1 (x .&. 0x1f) pos xs - | x `isClear` 4 = uncont 2 (x .&. 0xf) pos xs - | x `isClear` 3 = uncont 3 (x .&. 0x7) pos xs - | otherwise = error "too many byte" - uncont :: Int -> Word8 -> Int -> [Word8] -> [Char] - uncont 1 iniV pos xs = - case xs of - c1:xs' -> decodeCont iniV [c1] : loop (pos+2) xs' - _ -> error "truncated continuation, expecting 1 byte" - uncont 2 iniV pos xs = - case xs of - c1:c2:xs' -> decodeCont iniV [c1,c2] : loop (pos+3) xs' - _ -> error "truncated continuation, expecting 2 bytes" - uncont 3 iniV pos xs = - case xs of - c1:c2:c3:xs' -> decodeCont iniV [c1,c2,c3] : loop (pos+4) xs' - _ -> error "truncated continuation, expecting 3 bytes" - uncont _ _ _ _ = error "invalid number of bytes for continuation" - decodeCont :: Word8 -> [Word8] -> Char - decodeCont iniV l - | all isContByte l = toEnum $ foldl (\acc v -> (acc `shiftL` 6) + fromIntegral v) (fromIntegral iniV) $ map (\v -> v .&. 0x3f) l - | otherwise = error "continuation bytes invalid" - isContByte v = v `testBit` 7 && v `isClear` 6 - isClear v i = not (v `testBit` i) - -encodeUTF8 :: String -> ByteString -encodeUTF8 s = B.pack $ concatMap (toUTF8 . fromEnum) s - where toUTF8 e - | e < 0x80 = [fromIntegral e] - | e < 0x800 = [fromIntegral (0xc0 .|. (e `shiftR` 6)), toCont e] - | e < 0x10000 = [fromIntegral (0xe0 .|. (e `shiftR` 12)) - ,toCont (e `shiftR` 6) - ,toCont e] - | e < 0x200000 = [fromIntegral (0xf0 .|. (e `shiftR` 18)) - , toCont (e `shiftR` 12) - , toCont (e `shiftR` 6) - , toCont e] - | otherwise = error "not a valid value" - toCont v = fromIntegral (0x80 .|. (v .&. 0x3f)) - -decodeASCII :: ByteString -> String -decodeASCII = BC.unpack - -encodeASCII :: String -> ByteString -encodeASCII = BC.pack - -decodeBMP :: ByteString -> String -decodeBMP b - | odd (B.length b) = error "not a valid BMP string" - | otherwise = fromUCS2 $ B.unpack b - where fromUCS2 [] = [] - fromUCS2 (b0:b1:l) = - let v :: Word16 - v = (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1 - in toEnum (fromIntegral v) : fromUCS2 l - fromUCS2 _ = error "decodeBMP: internal error" -encodeBMP :: String -> ByteString -encodeBMP s = B.pack $ concatMap (toUCS2 . fromEnum) s - where toUCS2 v = [b0,b1] - where b0 = fromIntegral (v `shiftR` 8) - b1 = fromIntegral (v .&. 0xff) - -decodeUTF32 :: ByteString -> String -decodeUTF32 bs - | (B.length bs `mod` 4) /= 0 = error "not a valid UTF32 string" - | otherwise = fromUTF32 0 - where w32ToChar :: Word32 -> Char - w32ToChar = toEnum . fromIntegral - fromUTF32 ofs - | ofs == B.length bs = [] - | otherwise = - let a = B.index bs ofs - b = B.index bs (ofs+1) - c = B.index bs (ofs+2) - d = B.index bs (ofs+3) - v = (fromIntegral a `shiftL` 24) .|. - (fromIntegral b `shiftL` 16) .|. - (fromIntegral c `shiftL` 8) .|. - (fromIntegral d) - in w32ToChar v : fromUTF32 (ofs+4) -encodeUTF32 :: String -> ByteString -encodeUTF32 s = B.pack $ concatMap (toUTF32 . fromEnum) s - where toUTF32 v = [b0,b1,b2,b3] - where b0 = fromIntegral (v `shiftR` 24) - b1 = fromIntegral ((v `shiftR` 16) .&. 0xff) - b2 = fromIntegral ((v `shiftR` 8) .&. 0xff) - b3 = fromIntegral (v .&. 0xff)
README.md view
@@ -4,9 +4,8 @@ Originally forked from [asn1-types-0.3.4](https://hackage.haskell.org/package/asn1-types-0.3.4). -ASN.1 for Haskell - -* crypton-asn1-types : basic types for ASN.1 representation. +A library providing types representing the Abstract Syntax Notation One (ASN.1) +standard. History -------
crypton-asn1-types.cabal view
@@ -1,44 +1,47 @@ 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-asn1-types -version: 0.3.4 -synopsis: ASN.1 types -description: ASN.1 standard types -category: Data -stability: experimental -homepage: http://github.com/mpilgrem/crypton-asn1 -bug-reports: https://github.com/mpilgrem/crypton-asn1/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-asn1 - -library - exposed-modules: - Data.ASN1.BitArray - Data.ASN1.OID - Data.ASN1.Pretty - Data.ASN1.Types - Data.ASN1.Types.String - Data.ASN1.Types.Lowlevel - ghc-options: -Wall - build-depends: - base >=3 && <5 - , bytestring - , hourglass - , memory - default-language: Haskell98 ++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name: crypton-asn1-types+version: 0.3.5+synopsis: ASN.1 types+description: A library providing types representing the Abstract Syntax Notation One+ (ASN.1) standard.+category: Data+stability: experimental+homepage: http://github.com/mpilgrem/crypton-asn1+bug-reports: https://github.com/mpilgrem/crypton-asn1/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-asn1++library+ exposed-modules:+ Data.ASN1.BitArray+ Data.ASN1.OID+ Data.ASN1.Pretty+ Data.ASN1.Types+ Data.ASN1.Types.String+ Data.ASN1.Types.Lowlevel+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=3 && <5+ , base16+ , bytestring+ , hourglass+ default-language: Haskell98
+ src/Data/ASN1/BitArray.hs view
@@ -0,0 +1,86 @@+{- | +Module : Data.ASN1.BitArray +License : BSD-style +Copyright : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : unknown +-} + +module Data.ASN1.BitArray + ( BitArray (..) + , BitArrayOutOfBound (..) + , bitArrayLength + , bitArrayGetBit + , bitArraySetBitValue + , bitArraySetBit + , bitArrayClearBit + , bitArrayGetData + , toBitArray + ) where + +import Control.Exception ( Exception, throw ) +import Data.Bits ( clearBit, setBit, testBit ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as B +import Data.Maybe ( fromJust ) +import Data.Word ( Word64 ) + +-- | Thrown in case of out of bounds in the bitarray. +newtype BitArrayOutOfBound = BitArrayOutOfBound Word64 + deriving (Eq, Show) + +instance Exception BitArrayOutOfBound + +-- | Represent a bitarray / bitmap. +-- +-- The memory representation starts at bit 0. +data BitArray = BitArray Word64 ByteString + deriving (Eq, Show) + +-- | Returns the length of bits in this bitarray. +bitArrayLength :: BitArray -> Word64 +bitArrayLength (BitArray l _) = l + +bitArrayOutOfBound :: Word64 -> a +bitArrayOutOfBound n = throw $ BitArrayOutOfBound n + +-- | Get the nth bits. +bitArrayGetBit :: BitArray -> Word64 -> Bool +bitArrayGetBit (BitArray l d) n + | n >= l = bitArrayOutOfBound n + | otherwise = + flip testBit (7-fromIntegral bitn) $ B.index d (fromIntegral offset) + where + (offset, bitn) = n `divMod` 8 + +-- | Set the nth bit to the value specified. +bitArraySetBitValue :: BitArray -> Word64 -> Bool -> BitArray +bitArraySetBitValue (BitArray l d) n v + | n >= l = bitArrayOutOfBound n + | otherwise = + let (before, after) = B.splitAt (fromIntegral offset) d + in + -- array bound check before prevent fromJust from failing. + let (w, remaining) = fromJust $ B.uncons after + remaining' = setter w (7-fromIntegral bitn) `B.cons` remaining + in BitArray l (before `B.append` remaining') + where + (offset, bitn) = n `divMod` 8 + setter = if v then setBit else clearBit + +-- | Set the nth bit. +bitArraySetBit :: BitArray -> Word64 -> BitArray +bitArraySetBit bitarray n = bitArraySetBitValue bitarray n True + +-- | Clear the nth bit. +bitArrayClearBit :: BitArray -> Word64 -> BitArray +bitArrayClearBit bitarray n = bitArraySetBitValue bitarray n False + +-- | Get padded bytestring from the bitarray. +bitArrayGetData :: BitArray -> ByteString +bitArrayGetData (BitArray _ d) = d + +-- | Number of bits to skip at the end (padding). +toBitArray :: ByteString -> Int -> BitArray +toBitArray l toSkip = + BitArray (fromIntegral (B.length l * 8 - fromIntegral toSkip)) l
+ src/Data/ASN1/OID.hs view
@@ -0,0 +1,27 @@+{- | +Module : Data.ASN1.OID +License : BSD-style +Copyright : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : unknown +-} + +module Data.ASN1.OID + ( OID + -- * classes + , OIDable (..) + , OIDNameable (..) + ) where + +-- | Standard ASN.1 Object ID (OID). +type OID = [Integer] + +-- | Class of things that have an Object ID. +class OIDable a where + -- | Return the object ID of an Object from the ObjectIdentifiable class. + getObjectID :: a -> OID + +-- | Class of things that can be named by Object ID. +class OIDNameable a where + -- | Try to convert an OID into an Object. + fromObjectID :: OID -> Maybe a
+ src/Data/ASN1/Pretty.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE CPP #-} + +{- | +Module : Data.ASN1.Pretty +License : BSD-style +Copyright : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : unknown + +Types and functions to pretty print ASN.1 elements. +-} + +module Data.ASN1.Pretty + ( pretty + , PrettyType (..) + ) where + +import Data.ASN1.BitArray ( bitArrayGetData ) +import Data.ASN1.Types + ( ASN1 (..), ASN1CharacterString (..) + , ASN1ConstructionType (..), ASN1StringEncoding (..) + , ASN1TimeType (..) + ) +#if MIN_VERSION_base16(1,0,0) +import Data.Base16.Types ( extractBase16 ) +#endif +import Data.ByteString ( ByteString ) +import Data.ByteString.Base16 ( encodeBase16' ) +import Numeric ( showHex ) + +-- | A helper function while base16 < 1.0 is supported. +encodeBase16 :: ByteString -> ByteString +#if MIN_VERSION_base16(1,0,0) +encodeBase16 = extractBase16 . encodeBase16' +#else +encodeBase16 = encodeBase16' +#endif + +-- | Type representing approaches to formatting. +data PrettyType = + Multiline Int + -- ^ Increase indentation following each 'Start' object and decrease + -- following each 'End' object. The 'Int' is the initial indentation. + | SingleLine + -- ^ No indentation. + deriving (Eq, Show) + +-- | Pretty print a list of ASN.1 elements. +pretty :: + PrettyType -- ^ The approach to formatting. + -> [ASN1] -- ^ Stream of ASN.1. + -> String +pretty (Multiline at) = prettyPrint at + where + indent n = replicate n ' ' + + prettyPrint _ [] = "" + prettyPrint n (x@(Start _) : xs) = indent n ++ p id x ++ prettyPrint (n+1) xs + prettyPrint n (x@(End _) : xs) = indent (n-1) ++ p id x ++ prettyPrint (n-1) xs + prettyPrint n (x : xs) = indent n ++ p id x ++ prettyPrint n xs + +pretty SingleLine = prettyPrint + where + prettyPrint [] = "" + prettyPrint (x@(Start _) : xs) = p id x ++ "," ++ prettyPrint xs + prettyPrint (x@(End _) : xs) = p id x ++ "," ++ prettyPrint xs + prettyPrint (x : xs) = p id x ++ "," ++ prettyPrint xs + +p :: ([Char] -> t) -> ASN1 -> t +p put (Boolean b) = put ("bool: " ++ show b) +p put (IntVal i) = put ("int: " ++ showHex i "") +p put (BitString bits) = put ("bitstring: " ++ hexdump (bitArrayGetData bits)) +p put (OctetString bs) = put ("octetstring: " ++ hexdump bs) +p put Null = put "null" +p put (OID is) = put ("OID: " ++ show is) +p put (Real d) = put ("real: " ++ show d) +p put (Enumerated _) = put "enum" +p put (Start Sequence) = put "{" +p put (End Sequence) = put "}" +p put (Start Set) = put "[" +p put (End Set) = put "]" +p put (Start (Container x y)) = put ("< " ++ show x ++ " " ++ show y) +p put (End (Container x y)) = put ("> " ++ show x ++ " " ++ show y) +p put (ASN1String cs) = putCS put cs +p put (ASN1Time TimeUTC time tz) = put ("utctime: " ++ show time ++ " " ++ show tz) +p put (ASN1Time TimeGeneralized time tz) = put ("generalizedtime: " ++ show time ++ " " ++ show tz) +p put (Other tc tn x) = put ("other(" ++ show tc ++ "," ++ show tn ++ "," ++ show x ++ ")") + +putCS :: ([Char] -> t) -> ASN1CharacterString -> t +putCS put (ASN1CharacterString UTF8 t) = put ("utf8string:" ++ show t) +putCS put (ASN1CharacterString Numeric bs) = put ("numericstring:" ++ hexdump bs) +putCS put (ASN1CharacterString Printable t) = put ("printablestring: " ++ show t) +putCS put (ASN1CharacterString T61 bs) = put ("t61string:" ++ show bs) +putCS put (ASN1CharacterString VideoTex bs) = put ("videotexstring:" ++ hexdump bs) +putCS put (ASN1CharacterString IA5 bs) = put ("ia5string:" ++ show bs) +putCS put (ASN1CharacterString Graphic bs) = put ("graphicstring:" ++ hexdump bs) +putCS put (ASN1CharacterString Visible bs) = put ("visiblestring:" ++ hexdump bs) +putCS put (ASN1CharacterString General bs) = put ("generalstring:" ++ hexdump bs) +putCS put (ASN1CharacterString UTF32 t) = put ("universalstring:" ++ show t) +putCS put (ASN1CharacterString Character bs) = put ("characterstring:" ++ hexdump bs) +putCS put (ASN1CharacterString BMP t) = put ("bmpstring: " ++ show t) + +hexdump :: ByteString -> String +hexdump bs = show (encodeBase16 bs)
+ src/Data/ASN1/Types.hs view
@@ -0,0 +1,76 @@+{- | +Module : Data.ASN1.Types +License : BSD-style +Copyright : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : unknown +-} + +module Data.ASN1.Types + ( ASN1 (..) + , ASN1S + , ASN1Class (..) + , ASN1Tag + , ASN1ConstructionType (..) + , ASN1StringEncoding (..) + , ASN1TimeType (..) + , ASN1Object (..) + , ASN1CharacterString (..) + , asn1CharacterString + , asn1CharacterToString + , module Data.ASN1.OID + ) where + +import Data.ASN1.BitArray ( BitArray ) +import Data.ASN1.OID ( OID ) +import Data.ASN1.Types.Lowlevel ( ASN1Class (..), ASN1Tag ) +import Data.ASN1.Types.String + ( ASN1CharacterString (..), ASN1StringEncoding (..) + , asn1CharacterString, asn1CharacterToString + ) +import Data.ByteString ( ByteString ) +import Data.Hourglass ( DateTime, TimezoneOffset ) + +-- | Define the types of container. +data ASN1ConstructionType = + Sequence + | Set + | Container ASN1Class ASN1Tag + deriving (Eq, Show) + +-- | Different ASN.1 time representations. +data ASN1TimeType = + TimeUTC + -- ^ ASN.1 UTCTime Type: limited between 1950-2050. + | TimeGeneralized + -- ^ ASN.1 GeneralizedTime Type. + deriving (Eq, Ord, Show) + +-- | Define high level ASN.1 objects. +data ASN1 = + Boolean Bool + | IntVal Integer + | BitString BitArray + | OctetString ByteString + | Null + | OID OID + | Real Double + | Enumerated Integer + | ASN1String ASN1CharacterString + | ASN1Time ASN1TimeType DateTime (Maybe TimezoneOffset) + | Other ASN1Class ASN1Tag ByteString + | Start ASN1ConstructionType + | End ASN1ConstructionType + deriving (Eq, Show) + +-- | Represent a chunk of ASN.1 Stream. This is equivalent to ShowS but for an +-- ASN.1 Stream. +type ASN1S = [ASN1] -> [ASN1] + +-- | Define an object that can be converted to and from ASN.1. +class ASN1Object a where + -- | Transform an object into a chunk of ASN.1 stream. + toASN1 :: a -> ASN1S + + -- | Returns either an object along the remaining ASN.1 stream, or an error. + fromASN1 :: [ASN1] -> Either String (a, [ASN1])
+ src/Data/ASN1/Types/Lowlevel.hs view
@@ -0,0 +1,52 @@+{- | +Module : Data.ASN1.Types.Lowlevel +License : BSD-style +Copyright : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : unknown +-} + +module Data.ASN1.Types.Lowlevel + ( -- * Raw types + ASN1Class (..) + , ASN1Tag + , ASN1Length (..) + , ASN1Header (..) + -- * Events types + , ASN1Event (..) + ) where + +import Data.ByteString ( ByteString ) + +-- | Element class. +data ASN1Class = + Universal + | Application + | Context + | Private + deriving (Eq, Enum, Ord, Show) + +-- | ASN.1 Tag. +type ASN1Tag = Int + +-- | ASN.1 Length with all different formats. +data ASN1Length = + LenShort Int + -- ^ Short form with only one byte. Length has to be < 127. + | LenLong Int Int + -- ^ Long form of N bytes. + | LenIndefinite + -- ^ Length is indefinite. Expect an EOC in the stream to finish the type. + deriving (Eq, Show) + +-- | ASN.1 Header with the class, tag, constructed flag and length. +data ASN1Header = ASN1Header !ASN1Class !ASN1Tag !Bool !ASN1Length + deriving (Eq, Show) + +-- | Represent one event from an ASN.1 data stream. +data ASN1Event = + Header ASN1Header -- ^ ASN.1 Header. + | Primitive !ByteString -- ^ Primitive + | ConstructionBegin -- ^ Constructed value start. + | ConstructionEnd -- ^ Constructed value end. + deriving (Eq, Show)
+ src/Data/ASN1/Types/String.hs view
@@ -0,0 +1,208 @@+{- | +Module : Data.ASN1.Types.String +License : BSD-style +Copyright : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org> +Stability : experimental +Portability : unknown + +Different String types available in ASN.1. +-} + +module Data.ASN1.Types.String + ( ASN1StringEncoding (..) + , ASN1CharacterString (..) + , asn1CharacterString + , asn1CharacterToString + ) where + +import Data.Bits ( (.&.), (.|.), shiftL, shiftR, testBit ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.String ( IsString (..) ) +import Data.Word ( Word16, Word32, Word8 ) + +-- A note on T.61 encodings. The actual specification of a T.61 character set +-- seems to be lost in time. As such, it will be considered an ASCII-like +-- encoding. +-- +-- <http://www.mail-archive.com/asn1@asn1.org/msg00460.html> +-- "sizable volume of software in the world treats TeletexString (T61String) +-- as a simple 8-bit string with mostly Windows Latin 1" + +-- | Define all possible ASN.1 String encodings. +data ASN1StringEncoding = + IA5 + -- ^ 128 characters equivalent to the ASCII alphabet. + | UTF8 + -- ^ UTF8. + | General + -- ^ All registered graphic and character sets (see ISO 2375) plus SPACE and + -- DELETE. + | Graphic + -- ^ All registered G sets and SPACE. + | Numeric + -- ^ Encoding containing numeric [0-9] and space. + | Printable + -- ^ Printable [a-z] [A-Z] [()+,-.?:/=] and space. + | VideoTex + -- ^ CCITT's T.100 and T.101 character sets. + | Visible + -- ^ International ASCII printing character sets. + | T61 + -- ^ Teletext. + | UTF32 + -- ^ UTF32. + | Character + -- ^ Character. + | BMP + -- ^ UCS2. + deriving (Eq, Ord, Show) + +-- | Provide a way to possibly encode or decode character strings based on +-- character encoding. +stringEncodingFunctions :: + ASN1StringEncoding + -> Maybe (ByteString -> String, String -> ByteString) +stringEncodingFunctions encoding + | encoding == UTF8 = Just (decodeUTF8, encodeUTF8) + | encoding == BMP = Just (decodeBMP, encodeBMP) + | encoding == UTF32 = Just (decodeUTF32, encodeUTF32) + | encoding `elem` asciiLikeEncodings = Just (decodeASCII, encodeASCII) + | otherwise = Nothing + where + asciiLikeEncodings = [IA5,Numeric,Printable,Visible,General,Graphic,T61] + +-- | Encode a string into a character string. +asn1CharacterString :: ASN1StringEncoding -> String -> ASN1CharacterString +asn1CharacterString encoding s = + case stringEncodingFunctions encoding of + Just (_, e) -> ASN1CharacterString encoding (e s) + Nothing -> + error ("cannot encode ASN1 Character String " ++ show encoding ++ " from string") + +-- | Try to decode an 'ASN1CharacterString' to a String. +asn1CharacterToString :: ASN1CharacterString -> Maybe String +asn1CharacterToString (ASN1CharacterString encoding bs) = + case stringEncodingFunctions encoding of + Just (d, _) -> Just (d bs) + Nothing -> Nothing + +-- | ASN1 Character String with encoding +data ASN1CharacterString = ASN1CharacterString + { characterEncoding :: ASN1StringEncoding + , getCharacterStringRawData :: ByteString + } + deriving (Eq, Ord, Show) + +instance IsString ASN1CharacterString where + fromString s = ASN1CharacterString UTF8 (encodeUTF8 s) + +decodeUTF8 :: ByteString -> String +decodeUTF8 b = loop 0 $ B.unpack b + where + loop :: Int -> [Word8] -> [Char] + loop _ [] = [] + loop pos (x:xs) + | x `isClear` 7 = toEnum (fromIntegral x) : loop (pos+1) xs + | x `isClear` 6 = error "continuation byte in heading context" + | x `isClear` 5 = uncont 1 (x .&. 0x1f) pos xs + | x `isClear` 4 = uncont 2 (x .&. 0xf) pos xs + | x `isClear` 3 = uncont 3 (x .&. 0x7) pos xs + | otherwise = error "too many byte" + uncont :: Int -> Word8 -> Int -> [Word8] -> [Char] + uncont 1 iniV pos xs = + case xs of + c1:xs' -> decodeCont iniV [c1] : loop (pos+2) xs' + _ -> error "truncated continuation, expecting 1 byte" + uncont 2 iniV pos xs = + case xs of + c1:c2:xs' -> decodeCont iniV [c1,c2] : loop (pos+3) xs' + _ -> error "truncated continuation, expecting 2 bytes" + uncont 3 iniV pos xs = + case xs of + c1:c2:c3:xs' -> decodeCont iniV [c1,c2,c3] : loop (pos+4) xs' + _ -> error "truncated continuation, expecting 3 bytes" + uncont _ _ _ _ = error "invalid number of bytes for continuation" + decodeCont :: Word8 -> [Word8] -> Char + decodeCont iniV l + | all isContByte l = toEnum $ foldl + (\acc v -> (acc `shiftL` 6) + fromIntegral v) + (fromIntegral iniV) + (map (.&. 0x3f) l) + | otherwise = error "continuation bytes invalid" + isContByte v = v `testBit` 7 && v `isClear` 6 + isClear v i = not (v `testBit` i) + +encodeUTF8 :: String -> ByteString +encodeUTF8 s = B.pack $ concatMap (toUTF8 . fromEnum) s + where + toUTF8 e + | e < 0x80 = [fromIntegral e] + | e < 0x800 = [fromIntegral (0xc0 .|. (e `shiftR` 6)), toCont e] + | e < 0x10000 = [ fromIntegral (0xe0 .|. (e `shiftR` 12)) + , toCont (e `shiftR` 6) + , toCont e + ] + | e < 0x200000 = [fromIntegral (0xf0 .|. (e `shiftR` 18)) + , toCont (e `shiftR` 12) + , toCont (e `shiftR` 6) + , toCont e + ] + | otherwise = error "not a valid value" + toCont v = fromIntegral (0x80 .|. (v .&. 0x3f)) + +decodeASCII :: ByteString -> String +decodeASCII = BC.unpack + +encodeASCII :: String -> ByteString +encodeASCII = BC.pack + +decodeBMP :: ByteString -> String +decodeBMP b + | odd (B.length b) = error "not a valid BMP string" + | otherwise = fromUCS2 $ B.unpack b + where + fromUCS2 [] = [] + fromUCS2 (b0:b1:l) = + let v :: Word16 + v = (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1 + in toEnum (fromIntegral v) : fromUCS2 l + fromUCS2 _ = error "decodeBMP: internal error" + +encodeBMP :: String -> ByteString +encodeBMP s = B.pack $ concatMap (toUCS2 . fromEnum) s + where + toUCS2 v = [b0, b1] + where + b0 = fromIntegral (v `shiftR` 8) + b1 = fromIntegral (v .&. 0xff) + +decodeUTF32 :: ByteString -> String +decodeUTF32 bs + | (B.length bs `mod` 4) /= 0 = error "not a valid UTF32 string" + | otherwise = fromUTF32 0 + where + w32ToChar :: Word32 -> Char + w32ToChar = toEnum . fromIntegral + fromUTF32 ofs + | ofs == B.length bs = [] + | otherwise = + let a = B.index bs ofs + b = B.index bs (ofs+1) + c = B.index bs (ofs+2) + d = B.index bs (ofs+3) + v = (fromIntegral a `shiftL` 24) + .|. (fromIntegral b `shiftL` 16) + .|. (fromIntegral c `shiftL` 8) + .|. fromIntegral d + in w32ToChar v : fromUTF32 (ofs+4) +encodeUTF32 :: String -> ByteString +encodeUTF32 s = B.pack $ concatMap (toUTF32 . fromEnum) s + where + toUTF32 v = [b0, b1, b2, b3] + where + b0 = fromIntegral (v `shiftR` 24) + b1 = fromIntegral ((v `shiftR` 16) .&. 0xff) + b2 = fromIntegral ((v `shiftR` 8) .&. 0xff) + b3 = fromIntegral (v .&. 0xff)