asn1-data 0.2.2 → 0.3.0

raw patch · 7 files changed

+128/−35 lines, 7 filesdep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: text

API changes (from Hackage documentation)

Files

• Data/ASN1/BER.hs +30/−6
• Data/ASN1/CER.hs +16/−14
• Data/ASN1/DER.hs +23/−1
• Data/ASN1/Prim.hs +30/−10
• Data/ASN1/Raw.hs +8/−0
• Tests.hs +19/−3
• asn1-data.cabal +2/−1

@@ -17,18 +17,26 @@  	-- * BER serial functions 	, decodeASN1Get+	, decodeASN1State 	, decodeASN1+	, decodeASN1s 	, encodeASN1Put+	, encodeASN1sPut 	, encodeASN1+	, encodeASN1s 	) where +import Data.Int import Data.ASN1.Raw import Data.ASN1.Prim import Data.Either import Data.Binary.Get import Data.Binary.Put+import Control.Monad (liftM)+import Control.Monad.Error (throwError) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B+import Data.Text.Lazy.Encoding (encodeUtf8, encodeUtf32BE)  ofRaws :: [Value] -> Either ASN1Err [ASN1] ofRaws x = if l == [] then Right r else Left $ ASN1Multiple l@@ -76,34 +84,50 @@ toRaw (OctetString b)        = Value Universal 0x4 (putString b) toRaw Null                   = Value Universal 0x5 (Primitive B.empty) toRaw (OID oid)              = Value Universal 0x6 (putOID oid)-toRaw (Real f)               = Value Universal 0x9 (Constructed []) -- not implemented+toRaw (Real _)               = Value Universal 0x9 (Constructed []) -- not implemented toRaw Enumerated             = Value Universal 0xa (Constructed []) -- not implemented-toRaw (UTF8String b)         = Value Universal 0xc (putString b)+toRaw (UTF8String b)         = Value Universal 0xc (putString $ encodeUtf8 b) toRaw (Sequence children)    = Value Universal 0x10 (Constructed $ map toRaw children) toRaw (Set children)         = Value Universal 0x11 (Constructed $ map toRaw children) toRaw (NumericString b)      = Value Universal 0x12 (putString b)-toRaw (PrintableString b)    = Value Universal 0x13 (putString b)+toRaw (PrintableString b)    = Value Universal 0x13 (putString $ encodeUtf8 b) toRaw (T61String b)          = Value Universal 0x14 (putString b) toRaw (VideoTexString b)     = Value Universal 0x15 (putString b)-toRaw (IA5String b)          = Value Universal 0x16 (putString b)+toRaw (IA5String b)          = Value Universal 0x16 (putString $ encodeUtf8 b) toRaw (UTCTime time)         = Value Universal 0x17 (putUTCTime time) toRaw (GeneralizedTime time) = Value Universal 0x18 (putGeneralizedTime time) toRaw (GraphicString b)      = Value Universal 0x19 (putString b) toRaw (VisibleString b)      = Value Universal 0x1a (putString b) toRaw (GeneralString b)      = Value Universal 0x1b (putString b)-toRaw (UniversalString b)    = Value Universal 0x1c (putString b)+toRaw (UniversalString b)    = Value Universal 0x1c (putString $ encodeUtf32BE b) toRaw (CharacterString b)    = Value Universal 0x1d (putString b)-toRaw (BMPString b)          = Value Universal 0x1e (putString b)+toRaw (BMPString b)          = Value Universal 0x1e (putString $ encodeUCS2BE b) toRaw (Other tc tn c)        = Value tc tn (either Primitive (Constructed . map toRaw) c)  decodeASN1Get :: Get (Either ASN1Err ASN1) decodeASN1Get = either Left ofRaw `fmap` runGetErrInGet getValue +decodeASN1State :: L.ByteString -> Either ASN1Err (ASN1, L.ByteString, Int64)+decodeASN1State b =+	runGetErrState (getValue >>= either throwError return . ofRaw) b 0+ decodeASN1 :: L.ByteString -> Either ASN1Err ASN1 decodeASN1 = either Left ofRaw . runGetErr getValue +decodeASN1s :: L.ByteString -> Either ASN1Err [ASN1]+decodeASN1s = loop where+	loop z = case decodeASN1State z of+		Left err -> throwError err+		Right (v, rest, _) -> if L.length rest > 0 then liftM (v :) (loop rest) else return [v]+ encodeASN1Put :: ASN1 -> Put encodeASN1Put = putValue . toRaw +encodeASN1sPut :: [ASN1] -> Put+encodeASN1sPut = mapM_ encodeASN1Put+ encodeASN1 :: ASN1 -> L.ByteString encodeASN1 = runPut . encodeASN1Put++encodeASN1s :: [ASN1] -> L.ByteString+encodeASN1s = runPut . encodeASN1sPut

@@ -25,6 +25,7 @@ import qualified Data.ASN1.BER as BER import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L+import Data.Text.Lazy.Encoding (encodeUtf8, encodeUtf32BE)  {- | check if the value is bounded by CER policies -} check :: (TagClass, Bool, TagNumber) -> ValLength -> Maybe ASN1Err@@ -42,10 +43,10 @@ The string fragments contained in the constructed encoding shall be encoded with a primitive encoding. The encoding of each fragment, except possibly the last, shall have 1000 contents octets. -}-putStringCER :: (L.ByteString -> ASN1) -> L.ByteString -> ValStruct-putStringCER obj l =+putStringCER :: Int -> L.ByteString -> ValStruct+putStringCER tn l = 	if L.length l > 1000-		then Constructed $ map (toRaw . obj) $ repack1000 l+		then Constructed $ map (Value Universal tn . (Primitive . B.concat . L.toChunks)) $ repack1000 l 		else Primitive $ B.concat $ L.toChunks l 	where 		repack1000 x =@@ -59,17 +60,18 @@ {- | toRaw create a CER encoded value ready -} toRaw :: ASN1 -> Value toRaw (BitString i bits)     = Value Universal 0x3 (putBitString i bits)-toRaw (OctetString b)        = Value Universal 0x4 (putStringCER OctetString b)-toRaw (UTF8String b)         = Value Universal 0xc (putStringCER UTF8String b)-toRaw (NumericString b)      = Value Universal 0x12 (putStringCER NumericString b)-toRaw (PrintableString b)    = Value Universal 0x13 (putStringCER PrintableString b)-toRaw (T61String b)          = Value Universal 0x14 (putStringCER T61String b)-toRaw (VideoTexString b)     = Value Universal 0x15 (putStringCER VideoTexString b)-toRaw (IA5String b)          = Value Universal 0x16 (putStringCER IA5String b)-toRaw (GraphicString b)      = Value Universal 0x19 (putStringCER GraphicString b)-toRaw (VisibleString b)      = Value Universal 0x1a (putStringCER VisibleString b)-toRaw (GeneralString b)      = Value Universal 0x1b (putStringCER GeneralString b)-toRaw (UniversalString b)    = Value Universal 0x1c (putStringCER UniversalString b)+toRaw (OctetString b)        = Value Universal 0x4 (putStringCER 0x4 b)+toRaw (UTF8String b)         = Value Universal 0xc (putStringCER 0xc (encodeUtf8 b))+toRaw (NumericString b)      = Value Universal 0x12 (putStringCER 0x12 b)+toRaw (PrintableString b)    = Value Universal 0x13 (putStringCER 0x13 (encodeUtf8 b))+toRaw (T61String b)          = Value Universal 0x14 (putStringCER 0x14 b)+toRaw (VideoTexString b)     = Value Universal 0x15 (putStringCER 0x15 b)+toRaw (IA5String b)          = Value Universal 0x16 (putStringCER 0x16 (encodeUtf8 b))+toRaw (GraphicString b)      = Value Universal 0x19 (putStringCER 0x19 b)+toRaw (VisibleString b)      = Value Universal 0x1a (putStringCER 0x1a b)+toRaw (GeneralString b)      = Value Universal 0x1b (putStringCER 0x1b b)+toRaw (UniversalString b)    = Value Universal 0x1c (putStringCER 0x1c (encodeUtf32BE b))+toRaw (BMPString b)          = Value Universal 0x1e (putStringCER 0x1e (encodeUCS2BE b)) toRaw v                      = BER.toRaw v  decodeASN1Get :: Get (Either ASN1Err ASN1)

@@ -13,16 +13,22 @@  	-- * DER serialize functions 	, decodeASN1Get+	, decodeASN1State 	, decodeASN1+	, decodeASN1s 	, encodeASN1Put+	, encodeASN1sPut 	, encodeASN1+	, encodeASN1s 	) where +import Data.Int import Data.ASN1.Raw import Data.ASN1.Prim import Data.Binary.Get import Data.Binary.Put-import Control.Monad (mplus)+import Control.Monad (mplus, liftM)+import Control.Monad.Error (throwError) import qualified Data.ASN1.BER as BER import qualified Data.ByteString.Lazy as L @@ -55,11 +61,27 @@ decodeASN1Get :: Get (Either ASN1Err ASN1) decodeASN1Get = runGetErrInGet (getValueCheck check) >>= return . either Left ofRaw +decodeASN1State :: L.ByteString -> Either ASN1Err (ASN1, L.ByteString, Int64)+decodeASN1State b =+	runGetErrState (getValueCheck check >>= either throwError return . BER.ofRaw) b 0+ decodeASN1 :: L.ByteString -> Either ASN1Err ASN1 decodeASN1 b = either Left BER.ofRaw $ runGetErr (getValueCheck check) b +decodeASN1s :: L.ByteString -> Either ASN1Err [ASN1]+decodeASN1s = loop where+	loop z = case decodeASN1State z of+		Left err -> throwError err+		Right (v, rest, _) -> if L.length rest > 0 then liftM (v :) (loop rest) else return [v]+ encodeASN1Put :: ASN1 -> Put encodeASN1Put d = putValue $ toRaw d +encodeASN1sPut :: [ASN1] -> Put+encodeASN1sPut = mapM_ encodeASN1Put+ encodeASN1 :: ASN1 -> L.ByteString encodeASN1 = runPut . encodeASN1Put++encodeASN1s :: [ASN1] -> L.ByteString+encodeASN1s = runPut . encodeASN1sPut

@@ -43,6 +43,7 @@ 	, putBitString 	, putString 	, putOID+	, encodeUCS2BE 	) where  import Data.ASN1.Internal@@ -55,6 +56,9 @@ import Data.Char (ord) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import Data.Text.Lazy.Encoding (decodeASCII, decodeUtf8, decodeUtf32BE)  data ASN1 = 	  EOC@@ -66,25 +70,41 @@ 	| OID [Integer] 	| Real Double 	| Enumerated-	| UTF8String L.ByteString+	| UTF8String Text 	| Sequence [ASN1] 	| Set [ASN1] 	| NumericString L.ByteString-	| PrintableString L.ByteString+	| PrintableString Text 	| T61String L.ByteString 	| VideoTexString L.ByteString-	| IA5String L.ByteString+	| IA5String Text 	| UTCTime (Int, Int, Int, Int, Int, Int, Bool) 	| GeneralizedTime (Int, Int, Int, Int, Int, Int, Bool) 	| GraphicString L.ByteString 	| VisibleString L.ByteString 	| GeneralString L.ByteString-	| UniversalString L.ByteString+	| UniversalString Text 	| CharacterString L.ByteString-	| BMPString L.ByteString+	| BMPString Text 	| Other TagClass TagNumber (Either ByteString [ASN1]) 	deriving (Show, Eq) +encodeUCS2BE :: Text -> L.ByteString+encodeUCS2BE t =+	L.pack $ concatMap (\c -> let (d,m) = (fromEnum c) `divMod` 256 in [fromIntegral m,fromIntegral d] ) $ T.unpack t++decodeUCS2BE :: L.ByteString -> Text+decodeUCS2BE l = T.pack $ loop l+	where+		loop x+			| L.null x  = []+			| otherwise = +				let (h, r) = L.splitAt 2 l in+				case L.unpack h of+					[a,b] -> (toEnum $ (fromIntegral a) + (fromIntegral b) * 256) : loop r+					_     -> loop r+	+ getEOC :: ByteString -> Either ASN1Err ASN1 getEOC s = 	if B.length s == 0@@ -147,10 +167,10 @@ getNumericString = either Left (Right . NumericString) . getString (\_ -> Nothing)  getPrintableString :: ValStruct -> Either ASN1Err ASN1-getPrintableString = either Left (Right . PrintableString) . getString (\_ -> Nothing)+getPrintableString = either Left (Right . PrintableString . decodeASCII) . getString (\_ -> Nothing)  getUTF8String :: ValStruct -> Either ASN1Err ASN1-getUTF8String = either Left (Right . UTF8String) . getString (\_ -> Nothing)+getUTF8String = either Left (Right . UTF8String . decodeUtf8) . getString (\_ -> Nothing)  getT61String :: ValStruct -> Either ASN1Err ASN1 getT61String = either Left (Right . T61String) . getString (\_ -> Nothing)@@ -159,7 +179,7 @@ getVideoTexString = either Left (Right . VideoTexString) . getString (\_ -> Nothing)  getIA5String :: ValStruct -> Either ASN1Err ASN1-getIA5String = either Left (Right . IA5String) . getString (\_ -> Nothing)+getIA5String = either Left (Right . IA5String . decodeASCII) . getString (\_ -> Nothing)  getGraphicString :: ValStruct -> Either ASN1Err ASN1 getGraphicString = either Left (Right . GraphicString) . getString (\_ -> Nothing)@@ -171,13 +191,13 @@ getGeneralString = either Left (Right . GeneralString) . getString (\_ -> Nothing)  getUniversalString :: ValStruct -> Either ASN1Err ASN1-getUniversalString = either Left (Right . UniversalString) . getString (\_ -> Nothing)+getUniversalString = either Left (Right . UniversalString . decodeUtf32BE) . getString (\_ -> Nothing)  getCharacterString :: ValStruct -> Either ASN1Err ASN1 getCharacterString = either Left (Right . CharacterString) . getString (\_ -> Nothing)  getBMPString :: ValStruct -> Either ASN1Err ASN1-getBMPString = either Left (Right . BMPString) . getString (\_ -> Nothing)+getBMPString = either Left (Right . BMPString . decodeUCS2BE) . getString (\_ -> Nothing)  getNull :: ByteString -> Either ASN1Err ASN1 getNull s = if B.length s == 0 then Right Null else Left $ ASN1Misc "Null: data length not within bound"

@@ -12,6 +12,7 @@ 	( GetErr 	-- * get structure 	, runGetErr+	, runGetErrState 	, runGetErrInGet 	-- * ASN1 definitions 	, ASN1Err(..)@@ -30,6 +31,7 @@ 	) where  import Data.Bits+import Data.Int import Data.ASN1.Internal import Data.Binary.Get import Data.Binary.Put@@ -86,6 +88,12 @@  runGetErr :: GetErr a -> L.ByteString -> Either ASN1Err a runGetErr = runGet . runErrorT . runGE++runGetErrState :: GetErr a -> L.ByteString -> Int64 -> Either ASN1Err (a, L.ByteString, Int64)+runGetErrState g l o =+	case runGetState (runErrorT $ runGE g) l o of+		(Left err, _, _)           -> Left err+		(Right v, datarem, parsed) -> Right (v, datarem, parsed)  runGetErrInGet :: GetErr a -> Get (Either ASN1Err a) runGetErrInGet = runErrorT . runGE

@@ -11,6 +11,7 @@  import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L+import qualified Data.Text.Lazy as T  import Control.Monad import System.IO@@ -35,6 +36,12 @@ 		ws <- replicateM len (choose (0, 255) :: Gen Int) 		return $ L.pack $ map fromIntegral ws +instance Arbitrary T.Text where+	arbitrary = do+		len <- choose (0, 529) :: Gen Int+		ws <- replicateM len arbitrary+		return $ T.pack ws+ instance Arbitrary TagClass where 	arbitrary = elements [ Universal, Application, Context, Private ] @@ -67,6 +74,15 @@ 		aList (Sequence _) = True 		aList _            = False +arbitraryPrintString = do+	let printableString = (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ " ()+,-./:=?")+	x <- replicateM 21 (elements printableString)+	return $ T.pack x++arbitraryIA5String = do+	x <- replicateM 21 (elements $ map toEnum [0..127])+	return $ T.pack x+ instance Arbitrary ASN1 where 	arbitrary = oneof 		[ return EOC@@ -82,10 +98,10 @@ 		, liftM Sequence arbitraryListASN1 		, liftM Set arbitraryListASN1 		, liftM NumericString arbitrary-		, liftM PrintableString arbitrary+		, liftM PrintableString arbitraryPrintString 		, liftM T61String arbitrary 		, liftM VideoTexString arbitrary-		, liftM IA5String arbitrary+		, liftM IA5String arbitraryIA5String 		, liftM UTCTime arbitraryTime 		, liftM GeneralizedTime arbitraryTime 		, liftM GraphicString arbitrary@@ -103,7 +119,7 @@ prop_asn1_marshalling_id :: ASN1 -> Bool prop_asn1_marshalling_id v = (DER.decodeASN1 . DER.encodeASN1) v == Right v -args = Args+args = stdArgs 	{ replay     = Nothing 	, maxSuccess = 500 	, maxDiscard = 2000

@@ -1,5 +1,5 @@ Name:                asn1-data-Version:             0.2.2+Version:             0.3.0 Description:     ASN1 data reader and writer in raw form with supports for high level forms of ASN1 (BER, CER and DER) License:             BSD3@@ -24,6 +24,7 @@   Build-Depends:     base >= 3 && < 7,                      binary >= 0.5,                      bytestring,+                     text >= 0.11,                      mtl   Exposed-modules:   Data.ASN1.BER                      Data.ASN1.CER