asn1-types 0.2.3 → 0.3.4
raw patch · 4 files changed
Files
- Data/ASN1/Pretty.hs +78/−0
- Data/ASN1/Types.hs +2/−3
- Data/ASN1/Types/String.hs +25/−5
- asn1-types.cabal +6/−4
+ Data/ASN1/Pretty.hs view
@@ -0,0 +1,78 @@+-- |+-- 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 view
@@ -20,8 +20,7 @@ , module Data.ASN1.OID ) where -import Data.Time.Clock (UTCTime)-import Data.Time.LocalTime (TimeZone)+import Data.Hourglass import Data.ASN1.BitArray import Data.ASN1.OID import Data.ASN1.Types.Lowlevel@@ -50,7 +49,7 @@ | Real Double | Enumerated Integer | ASN1String ASN1CharacterString- | ASN1Time ASN1TimeType UTCTime (Maybe TimeZone)+ | ASN1Time ASN1TimeType DateTime (Maybe TimezoneOffset) | Other ASN1Class ASN1Tag ByteString | Start ASN1ConstructionType | End ASN1ConstructionType
Data/ASN1/Types/String.hs view
@@ -123,7 +123,7 @@ , toCont (e `shiftR` 6) , toCont e] | otherwise = error "not a valid value"- toCont v = fromIntegral (0xc0 .&. (v .&. 0x3f))+ toCont v = fromIntegral (0x80 .|. (v .&. 0x3f)) decodeASCII :: ByteString -> String decodeASCII = BC.unpack@@ -134,7 +134,13 @@ decodeBMP :: ByteString -> String decodeBMP b | odd (B.length b) = error "not a valid BMP string"- | otherwise = undefined+ | 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]@@ -142,9 +148,23 @@ b1 = fromIntegral (v .&. 0xff) decodeUTF32 :: ByteString -> String-decodeUTF32 b- | (B.length b `mod` 4) /= 0 = error "not a valid UTF32 string"- | otherwise = undefined+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]
asn1-types.cabal view
@@ -1,5 +1,5 @@ Name: asn1-types-Version: 0.2.3+Version: 0.3.4 Description: ASN.1 standard types License: BSD3 License-file: LICENSE@@ -11,15 +11,17 @@ Category: Data stability: experimental Cabal-Version: >=1.6-Homepage: http://github.com/vincenthz/hs-asn1-types+Homepage: http://github.com/vincenthz/hs-asn1 Library Build-Depends: base >= 3 && < 5 , bytestring- , time+ , memory+ , hourglass Exposed-modules: Data.ASN1.BitArray Data.ASN1.OID+ Data.ASN1.Pretty Data.ASN1.Types Data.ASN1.Types.String Data.ASN1.Types.Lowlevel@@ -27,4 +29,4 @@ source-repository head type: git- location: git://github.com/vincenthz/hs-asn1-types+ location: git://github.com/vincenthz/hs-asn1