asn1-types-0.3.3/Data/0000755000000000000000000000000013503676037012572 5ustar0000000000000000asn1-types-0.3.3/Data/ASN1/0000755000000000000000000000000013503702163013262 5ustar0000000000000000asn1-types-0.3.3/Data/ASN1/Types/0000755000000000000000000000000013503677032014374 5ustar0000000000000000asn1-types-0.3.3/Data/ASN1/BitArray.hs0000644000000000000000000000506313503676037015351 0ustar0000000000000000-- | -- Module : Data.ASN1.BitArray -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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 asn1-types-0.3.3/Data/ASN1/OID.hs0000644000000000000000000000127513503676037014250 0ustar0000000000000000-- | -- Module : Data.ASN1.OID -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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 asn1-types-0.3.3/Data/ASN1/Pretty.hs0000644000000000000000000000743113503676037015124 0ustar0000000000000000-- | -- Module : Data.ASN1.Pretty -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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) asn1-types-0.3.3/Data/ASN1/Types.hs0000644000000000000000000000367313503676037014745 0ustar0000000000000000-- | -- Module : Data.ASN1.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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]) asn1-types-0.3.3/Data/ASN1/Types/String.hs0000644000000000000000000001657513503677032016214 0ustar0000000000000000-- | -- Module : Data.ASN1.Types.String -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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. -- -- -- "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 (0xc0 .&. (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) asn1-types-0.3.3/Data/ASN1/Types/Lowlevel.hs0000644000000000000000000000270413503676037016530 0ustar0000000000000000-- | -- Module : Data.ASN1.Types.Lowlevel -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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) asn1-types-0.3.3/LICENSE0000644000000000000000000000273113503676037012731 0ustar0000000000000000Copyright (c) 2010-2013 Vincent Hanquez 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. asn1-types-0.3.3/Setup.hs0000644000000000000000000000005613503676037013356 0ustar0000000000000000import Distribution.Simple main = defaultMain asn1-types-0.3.3/asn1-types.cabal0000644000000000000000000000200113503702276014675 0ustar0000000000000000Name: asn1-types Version: 0.3.3 Description: ASN.1 standard types License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: ASN.1 types Build-Type: Simple Category: Data stability: experimental Cabal-Version: >=1.6 Homepage: http://github.com/vincenthz/hs-asn1 Library Build-Depends: base >= 3 && < 5 , bytestring , memory , hourglass 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 source-repository head type: git location: git://github.com/vincenthz/hs-asn1