language-asn (empty) → 0.1.0.0

raw patch · 8 files changed

+1148/−0 lines, 8 filesdep +basedep +bytestringdep +contravariant

Dependencies added: base, bytestring, contravariant, hashable, pretty, primitive, text, vector

Files

• CHANGELOG.md +12/−0
• LICENSE +29/−0
• language-asn.cabal +52/−0
• src/Language/Asn/Decoding.hs +339/−0
• src/Language/Asn/Encoding.hs +376/−0
• src/Language/Asn/ObjectIdentifier.hs +73/−0
• src/Language/Asn/Types.hs +10/−0
• src/Language/Asn/Types/Internal.hs +257/−0

@@ -0,0 +1,12 @@+# Changelog++`language-asn` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.0.0+=====++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/chessai/language-asn/releases

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, chessai+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* 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.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT HOLDER 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.

@@ -0,0 +1,52 @@+cabal-version: 2.2+name:+  language-asn+version:+  0.1.0.0+synopsis:+  ASN.1 encoding and decoding+description:+  ASN.1 language implementation. ASN.1 is used tightly with SNMP.+homepage:+  https://github.com/chessai/language-asn.git+license:+  BSD-3-Clause+license-file:+  LICENSE+author:+  Andrew Martin+maintainer:+  chessai1996@gmail.com+copyright:+  2019 (c) Andrew Martin+category:+  Language+build-type:+  Simple+extra-source-files:+  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/chessai/language-asn++library+  exposed-modules:+    Language.Asn.Encoding+    Language.Asn.Decoding+    Language.Asn.ObjectIdentifier+    Language.Asn.Types+    Language.Asn.Types.Internal+  build-depends:+      base >=4.9 && <4.13+    , bytestring >= 0.10 && < 0.11+    , contravariant >= 1.3 && < 1.6+    , vector >= 0.11 && < 0.13+    , primitive >= 0.6.4 && < 7+    , pretty >= 1.1 && < 1.2+    , text >= 1.2 && < 1.3+    , hashable >= 1.2 && < 1.3+  hs-source-dirs:+    src+  default-language:+    Haskell2010

@@ -0,0 +1,339 @@+{-# language ExistentialQuantification #-}+{-# language GADTs #-}+{-# language OverloadedStrings #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language BangPatterns #-}+{-# language MagicHash #-}++module Language.Asn.Decoding+  ( ber+  , sequence+  , sequenceOf+  , required+  , optional+  , defaulted+  , utf8String+  , integer+  , integerRanged+  , int32+  , int+  , word32+  , word64+  , null+  , null'+  , octetString+  , octetStringWord8+  , octetStringWord32+  , objectIdentifier+  , choice+  , option+  , tag+  , mapFailable+  ) where++import Prelude hiding (sequence,null)+import Language.Asn.Types.Internal+import Data.ByteString (ByteString)+import Data.Bits (Bits(..))+import Control.Monad hiding (sequence)+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Text (Text)+import Data.Word (Word8, Word32, Word64)+import Data.Int (Int32)+import Data.Functor.Identity (Identity(..))+import Text.Printf (printf)+import qualified GHC.Exts as E+import qualified Data.Text.Encoding as TE+import qualified Data.List as List+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Unsafe as BSU++ber :: AsnDecoding a -> ByteString -> Either String a+ber d bs = requireNoLeftovers =<< decodeBerInternal d Nothing bs++sequence :: FieldDecoding a -> AsnDecoding a+sequence = AsnDecodingSequence++sequenceOf :: AsnDecoding a -> AsnDecoding [a]+sequenceOf = AsnDecodingSequenceOf id++required :: FieldName -> AsnDecoding a -> FieldDecoding a+required name d = FieldDecoding (liftAp (FieldDecodingRequired name d))++optional :: FieldName -> AsnDecoding a -> FieldDecoding (Maybe a)+optional name d = FieldDecoding (liftAp (FieldDecodingOptional name d id))++defaulted :: Show a => FieldName -> AsnDecoding a -> a -> FieldDecoding a+defaulted name d defVal = FieldDecoding (liftAp (FieldDecodingDefault name d defVal show))++choice :: [OptionDecoding a] -> AsnDecoding a+choice = AsnDecodingChoice++option :: OptionName -> AsnDecoding a -> OptionDecoding a+option = OptionDecoding++tag :: TagClass -> Int -> Explicitness -> AsnDecoding a -> AsnDecoding a+tag c n e = AsnDecodingRetag (TagAndExplicitness (Tag c n) e)++utf8String :: AsnDecoding Text+utf8String = AsnDecodingUniversal $ UniverseDecodingTextualString Utf8String id (Subtypes []) (Subtypes [])++octetString :: AsnDecoding ByteString+octetString = AsnDecodingUniversal $ UniverseDecodingOctetString id (Subtypes [])++octetStringWord32 :: AsnDecoding Word32+octetStringWord32 = mapFailable+  ( \bs -> if ByteString.length bs == 4+      then Right $ (fromIntegral :: Word -> Word32)+         $ unsafeShiftL 24 (fromIntegral (BSU.unsafeIndex bs 0))+         + unsafeShiftL 16 (fromIntegral (BSU.unsafeIndex bs 1))+         + unsafeShiftL 8 (fromIntegral (BSU.unsafeIndex bs 2))+         + fromIntegral (BSU.unsafeIndex bs 3)+      else Left "octetStringWord32 expects the octet string to have exactly 4 bytes"+  ) octetString++octetStringWord8 :: AsnDecoding Word8+octetStringWord8 = mapFailable+  ( \bs -> if ByteString.length bs == 1+      then Right (BSU.unsafeIndex bs 0)+      else Left "octetStringWord8 expects the octet string to have exactly 1 byte"+  ) octetString++integer :: AsnDecoding Integer+integer = AsnDecodingUniversal (UniverseDecodingInteger id (Subtypes []))++-- This could be improved by making sure that integer in question is actually+-- in the provided bounds.+int :: AsnDecoding Int+int = AsnDecodingUniversal (UniverseDecodingInteger fromIntegral (Subtypes []))++-- This could be improved by making sure that integer in question is actually+-- in the provided bounds.+int32 :: AsnDecoding Int32+int32 = AsnDecodingUniversal (UniverseDecodingInteger fromIntegral (Subtypes []))++-- This could be improved by making sure that integer in question is actually+-- in the provided bounds.+word32 :: AsnDecoding Word32+word32 = AsnDecodingUniversal (UniverseDecodingInteger fromIntegral (Subtypes []))++-- This could be improved by making sure that integer in question is actually+-- in the provided bounds.+word64 :: AsnDecoding Word64+word64 = AsnDecodingUniversal (UniverseDecodingInteger fromIntegral (Subtypes []))++null :: AsnDecoding ()+null = AsnDecodingUniversal (UniverseDecodingNull ())++null' :: a -> AsnDecoding a+null' = AsnDecodingUniversal . UniverseDecodingNull++objectIdentifier :: AsnDecoding ObjectIdentifier+objectIdentifier = AsnDecodingUniversal (UniverseDecodingObjectIdentifier id (Subtypes []))++integerRanged :: Integer -> Integer -> AsnDecoding Integer+integerRanged lo hi = AsnDecodingUniversal+  (UniverseDecodingInteger id (Subtypes [SubtypeValueRange lo hi]))++mapFailable :: (a -> Either String b) -> AsnDecoding a -> AsnDecoding b+mapFailable f d = AsnDecodingConversion d f++repeatUntilEmpty :: Monad m => (ByteString -> m (a,ByteString)) -> ByteString -> m [a]+repeatUntilEmpty f = go where+  go bs1 = do+    (a,bs2) <- f bs1+    if ByteString.null bs2+      then return [a]+      else fmap (a:) (go bs2)++decodeBerInternal :: AsnDecoding a -> Maybe Tag -> ByteString -> Either String (a,ByteString)+decodeBerInternal x overrideTag bs1 = case x of+  AsnDecodingUniversal u -> do+    (bsContent,bsRemainder) <- takeTagAndLength Primitive (Tag Universal (universeDecodingTagNumber u))+    a <- decodeUniversal u bsContent+    return (a,bsRemainder)+  AsnDecodingRetag (TagAndExplicitness newTag expl) nextDecoding -> case expl of+    Implicit -> decodeBerInternal nextDecoding (Just $ fromMaybe newTag overrideTag) bs1+    Explicit -> do+      (bsContent,bsRemainder) <- takeTagAndLength Constructed newTag+      a <- requireNoLeftovers =<< decodeBerInternal nextDecoding Nothing bsContent+      return (a,bsRemainder)+  AsnDecodingSequence (FieldDecoding fieldDecoding) -> do+    (bsContent,bsRemainder) <- takeTagAndLength Constructed sequenceTag+    a <- requireNoLeftovers =<< getDecodePart (runAp decodeField fieldDecoding) bsContent+    return (a,bsRemainder)+  AsnDecodingSequenceOf f nextDecoding -> do+    (bsContent,bsRemainder) <- takeTagAndLength Constructed sequenceTag+    cs <- repeatUntilEmpty (decodeBerInternal nextDecoding Nothing) bsContent+    return (f cs,bsRemainder)+  AsnDecodingConversion nextDecoding conv -> do+    (b,bs2) <- decodeBerInternal nextDecoding overrideTag bs1+    a <- conv b+    return (a,bs2)+  -- Note: overrideTag is currently ignored in this case. Per+  -- ASN.1 rules, you cannot put an IMPLICIT tag over a CHOICE,+  -- which is the only thing that could cause this to happen.+  -- Still, I don't like that it's being ignored.+  AsnDecodingChoice opts -> case ByteString.uncons bs1 of+    Nothing -> Left "while trying to decode Choice tag, ran out of input"+    Just (b,bs2) -> do+      let possibilities = nextExpectedTags =<< map (\(OptionDecoding _ d) -> d) opts+          theTagNumberPrefix = b .&. 31+      (theTagNumber,_) <- decipherTagNumber theTagNumberPrefix bs2+      let mmatched = listToMaybe $ List.filter+            (\((Tag tc tn,cstn),_) -> b .&. 192 == tagClassBit tc && b .&. 32 == constructionBit cstn && tn == theTagNumber)+            possibilities+      case mmatched of+        Nothing -> Left $ concat +          [ "while trying to decode Choice tag, the tag did not match any of the expected tags: found "+          , show theTagNumber+          , " but expected one of ["+          , List.intercalate "," $ flip map possibilities $ \((Tag tc tn, cstn),_) -> concat+              [ show tc+              , " "+              , show cstn+              , " "+              , show tn+              ]+          , "]"+          ]+        Just (_,Wrapper chosenDecoder conv2) -> do+          (c,bs3) <- decodeBerInternal chosenDecoder Nothing bs1+          r <- conv2 c+          Right (r,bs3)+  where+  takeTagAndLength :: Construction -> Tag -> Either String (ByteString,ByteString)+  takeTagAndLength construction t1 = do+    let tagToUse = fromMaybe t1 overrideTag+    bs2 <- expectTag construction tagToUse bs1+    (len,bs3) <- takeLength bs2+    splitOrFail len bs3++data Wrapper a = forall b. Wrapper (AsnDecoding b) (b -> Either String a)++idWrapper :: AsnDecoding a -> Wrapper a+idWrapper d = Wrapper d Right++nextExpectedTags :: AsnDecoding a -> [((Tag,Construction), Wrapper a)]+nextExpectedTags x = case x of+  AsnDecodingUniversal u -> [((Tag Universal (universeDecodingTagNumber u), Primitive),idWrapper x)]+  AsnDecodingSequenceOf _ _ -> [((sequenceTag, Constructed),idWrapper x)]+  AsnDecodingSequence _ -> [((sequenceTag, Constructed),idWrapper x)]+  AsnDecodingChoice opts -> join (map (\(OptionDecoding _ theDec) -> nextExpectedTags theDec) opts)+  AsnDecodingRetag (TagAndExplicitness newTag expl) nextDecoding -> case expl of+    Explicit -> [((newTag,Constructed),idWrapper x)]+    Implicit -> map (\((_,c),Wrapper theDec theConv) -> ((newTag,c), Wrapper (AsnDecodingRetag (TagAndExplicitness newTag expl) theDec) theConv)) (nextExpectedTags nextDecoding)+  AsnDecodingConversion nextDecoding conv ->+    map (\((t,c),Wrapper theDec theConv) -> ((t,c),Wrapper theDec (theConv >=> conv))) (nextExpectedTags nextDecoding)++decodeField :: FieldDecodingPart a -> DecodePart a+decodeField x = case x of+  FieldDecodingRequired _ d -> DecodePart (decodeBerInternal d Nothing)+  FieldDecodingOptional _ d conv1 -> handlePossiblyMissingField d conv1+  FieldDecodingDefault _ d a _ -> handlePossiblyMissingField d (fromMaybe a)++handlePossiblyMissingField :: AsnDecoding b -> (Maybe b -> a) -> DecodePart a+handlePossiblyMissingField d conv1 = DecodePart $ \bs1 -> case ByteString.uncons bs1 of+  Nothing -> Right (conv1 Nothing, bs1)+  Just (b,bs2) -> do+    let possibilities = nextExpectedTags d+        theTagNumberPrefix = b .&. 31+    (theTagNumber,_) <- decipherTagNumber theTagNumberPrefix bs2+    let mmatched = listToMaybe $ List.filter+          (\((Tag tc tn,cstn),_) -> b .&. 192 == tagClassBit tc && b .&. 32 == constructionBit cstn && tn == theTagNumber) possibilities+    case mmatched of+      Nothing -> Right (conv1 Nothing, bs1)+      Just (_,Wrapper chosenDecoder conv2) -> do+        (c,bs3) <- decodeBerInternal chosenDecoder Nothing bs1+        r <- conv2 c+        Right (conv1 (Just r),bs3)++-- The first argument is the full tag byte+decipherTagNumber :: Word8 -> ByteString -> Either String (Int,ByteString)+decipherTagNumber w bs = do+  let tn = w .&. 31+  if tn < 31+    then Right (fromIntegral tn,bs)+    else error "decipherTagNumber: handle tags greater than 30"+++requireNoLeftovers :: (a,ByteString) -> Either String a+requireNoLeftovers (a,bs) = if ByteString.null bs then Right a else Left "expected not to have leftovers, but there were leftovers"++expectTag :: Construction -> Tag -> ByteString -> Either String ByteString+expectTag construction (Tag tc tn) bs = case ByteString.uncons bs of+  Nothing -> Left "expected a byte for the Tag but the ByteString was empty"+  Just (b,bsNext) -> do+    let expectedTagBits = tagClassBit tc+        actualTagBits = b .&. 192+    when (actualTagBits /= expectedTagBits)+      $ Left $ "while parsing the tag, the tag class bits did not match: "+            ++ "found " ++ printf "%08b" actualTagBits ++ " but expected "+            ++ printf "%08b" expectedTagBits ++ " (" ++ show tc ++ ")"+    when (b .&. 32 /= constructionBit construction) $ Left "while parsing the tag, the construction bit did not match"+    if tn < 31+      then do+        when (b .&. 31 /= fromIntegral tn) $ Left "while parsing the tag, the tag number did not match what was expected"+        Right bsNext+      else error "expectTag: handle tag numbers higher than 30"++splitOrFail :: Int -> ByteString -> Either String (ByteString,ByteString)+splitOrFail i bs = if i > ByteString.length bs+  then Left "tried to take a fixed number of bytes as specified by the encoding, but bytestring ended"+  else Right (ByteString.splitAt i bs)++takeLength :: ByteString -> Either String (Int,ByteString)+takeLength bs1 = case ByteString.uncons bs1 of+  Nothing -> Left "while trying to decode the length, expected an initial octet but the bytestring ended"+  Just (b,bs2) -> if b < 128+    then Right (fromIntegral b, bs2)+    else let bytesToTake = fromIntegral (127 .&. b) in+      if ByteString.length bs2 < bytesToTake+        then Left "while decoding multi-byte length, ran out of bytes"+        else let (bs3,bs4) = ByteString.splitAt bytesToTake bs2 in Right (parseLength bs3, bs4)+++parseLength :: ByteString -> Int+parseLength = ByteString.foldl' (\i w8 -> i * 256 + fromIntegral w8) 0++-- This currently does the wrong thing for negative numbers+parseInteger :: ByteString -> Integer+parseInteger = ByteString.foldl' (\i w8 -> i * 256 + fromIntegral w8) 0++decodeUniversal :: UniverseDecoding a -> ByteString -> Either String a+decodeUniversal x bs = case x of+  UniverseDecodingInteger f _ -> Right (f (parseInteger bs))+  UniverseDecodingTextualString _ f _ _ -> case TE.decodeUtf8' bs of+    Left _ -> Left "while decoding string primitive, found that UTF8-encoding was not used"+    Right t -> Right (f t)+  UniverseDecodingObjectIdentifier f _ -> fmap f (stepOidAll bs)+  UniverseDecodingOctetString f _ -> Right (f bs)+  UniverseDecodingNull a -> Right a++stepOidAll :: ByteString -> Either String ObjectIdentifier+stepOidAll bs1 = case ByteString.uncons bs1 of+  Nothing -> Left "while decoding OID, found no bytes, the OID should have at least one octet"+  Just (b,bs2) ->+    let (w1,w2) = quotRem b 40+        Identity nums = repeatUntilEmpty (Identity . stepOid 0) bs2+     in Right (ObjectIdentifier (E.fromList $ fromIntegral w1 : fromIntegral w2 : nums))++stepOid :: Word -> ByteString -> (Word,ByteString)+stepOid !i bs1 = case ByteString.uncons bs1 of+  Nothing -> (i,bs1)+  Just (w,bs2) ->+    let !acc = i * 128 + fromIntegral (w .&. 127) in+    if w .&. 128 == 128+      then stepOid acc bs2+      else (acc,bs2)++universeDecodingTagNumber :: UniverseDecoding a -> Int+universeDecodingTagNumber x = case x of+  UniverseDecodingInteger _ _ -> 2+  UniverseDecodingTextualString typ _ _ _ -> tagNumStringType typ+  UniverseDecodingObjectIdentifier _ _ -> 6+  UniverseDecodingOctetString _ _ -> 4+  UniverseDecodingNull _ -> 5+++

@@ -0,0 +1,376 @@+{-# language BangPatterns #-}+{-# language CPP #-}+{-# language ExistentialQuantification #-}+{-# language GADTs #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language OverloadedStrings #-}++module Language.Asn.Encoding+  ( -- * Run Encoding+    der+  , toDefinitionString+    -- * Build Encoding+    -- ** Constructed+  , sequence+  , sequenceOf+  , choice+  , tag+  , implicitTag+    -- ** Fields+  , required+  , optional+  , defaulted+  , option+    -- ** Primitive+  , integer+  , integerRanged+  , int32+  , int+  , word32+  , word64+  , word+  , octetString+  , octetStringWord8+  , octetStringWord32+  , utf8String+  , null+  , null'+  , objectIdentifier+  -- Remove anything exported below this +  , int64Log256+  , encodeLength+  ) where++import Prelude hiding (sequence,null)+import Language.Asn.Types.Internal+import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder)+import Data.Text (Text)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+import Data.Word (Word8, Word32, Word64)+import Data.Int (Int32, Int64)+import Data.Bits (Bits(..), FiniteBits(..))+import Data.Primitive (PrimArray,Prim)+import GHC.Int (Int(..))+import Data.Foldable hiding (null)+import qualified Data.Text.Encoding as TE+import qualified Text.PrettyPrint as PP+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Builder as Builder+import qualified Data.List as List+import qualified Data.Primitive as PM+import qualified Data.ByteString as ByteString++-- Note that DER encoding is a subset of BER encoding. If you+-- need to encode with BER, just use this function.+der :: AsnEncoding a -> a -> LB.ByteString+der e = encodeTaggedByteString . encodeBerInternal e++tagClassPrefix :: TagClass -> String+tagClassPrefix = \case+  Universal -> "UNIVERSAL "+  Private -> "PRIVATE "+  Application -> "APPLICATION "+  ContextSpecific -> ""++toDefinitionString :: AsnEncoding a -> String+toDefinitionString = PP.render . go where+  go :: forall b. AsnEncoding b -> PP.Doc+  go (EncUniversalValue u) = prettyPrintUniversalValue u+  go (EncRetag (TagAndExplicitness theTag expl) e) =+    PP.text (prettyPrintTag theTag ++ " " ++ ppExplicitness expl ++ " ") <> go e+  go (EncChoice (Choice _ allCtors getValAndEnc)) = (PP.$+$)+    "CHOICE"+    ( PP.nest 2 $ PP.vcat $ map (ppValEnc . getValAndEnc) allCtors)+  go (EncSequence fields) = (PP.$+$)+    "SEQUENCE"+    ( PP.nest 2 $ PP.vcat $ map ppField fields)+  go (EncSequenceOf _ e) = PP.text "SEQUENCE OF" PP.<+> go e+  ppField :: forall b. Field b -> PP.Doc+  ppField = \case+    FieldRequired (FieldName name) _ e -> PP.text (name ++ " ") <> go e+    FieldOptional (FieldName name) _ e -> PP.text (name ++ " OPTIONAL ") <> go e+    FieldDefaulted (FieldName name) _ defVal showVal _ e ->+      PP.text (name ++ " DEFAULT " ++ showVal defVal ++ " ") <> go e+  ppValEnc :: ValueAndEncoding -> PP.Doc+  ppValEnc (ValueAndEncoding _ (OptionName name) _ enc) = PP.text (name ++ " ") <> go enc+  ppExplicitness :: Explicitness -> String+  ppExplicitness = \case+    Implicit -> "IMPLICIT"+    Explicit -> "EXPLICIT"++prettyPrintTag :: Tag -> String+prettyPrintTag (Tag c n) = "[" ++ tagClassPrefix c ++ show n ++ "]"++prettyPrintUniversalValue :: UniversalValue x -> PP.Doc+prettyPrintUniversalValue = \case+  UniversalValueBoolean _ _ -> PP.text "BOOLEAN"+  UniversalValueInteger _ ss -> PP.text $ "INTEGER" ++ strSubtypes show ss+  UniversalValueNull -> PP.text "NULL"+  UniversalValueOctetString _ _ -> PP.text "OCTET STRING"+  UniversalValueObjectIdentifier _ _ -> PP.text "OBJECT IDENTIFIER"+  UniversalValueTextualString typ _ _ _ -> PP.text (strStringType typ)++strStringType :: StringType -> String+strStringType = \case+  Utf8String -> "UTF8String"+  NumericString -> "NumericString"+  PrintableString -> "PrintableString"+  TeletexString -> "TeletexString"+  VideotexString -> "VideotexString"+  IA5String -> "IA5String"+  GraphicString -> "GraphicString"+  VisibleString -> "VisibleString"+  GeneralString -> "GeneralString"+  UniversalString -> "UniversalString"+  CharacterString -> "CHARACTER STRING"+  BmpString -> "BMPString"++strSubtypes :: (a -> String) -> Subtypes a -> String+strSubtypes f (Subtypes ss)+  | length ss == 0 = ""+  | otherwise = " (" ++ List.intercalate " | " (map (strSubtype f) ss) ++ ")"++strSubtype :: (a -> String) -> Subtype a -> String+strSubtype f = \case+  SubtypeSingleValue a -> f a+  SubtypeValueRange lo hi -> f lo ++ " .. " ++ f hi++makeTag :: TagClass -> Int -> Tag+makeTag = Tag++sequence :: [Field a] -> AsnEncoding a+sequence = EncSequence++sequenceOf :: Foldable f => AsnEncoding a -> AsnEncoding (f a)+sequenceOf = EncSequenceOf toList++choice :: [a] -> (a -> ValueAndEncoding) -> AsnEncoding a+choice xs f = EncChoice (Choice id xs f)++option :: Int -> OptionName -> b -> AsnEncoding b -> ValueAndEncoding+option = ValueAndEncoding++tag :: TagClass -> Int -> Explicitness -> AsnEncoding a -> AsnEncoding a+tag c n e = EncRetag (TagAndExplicitness (Tag c n) e)++implicitTag :: Tag -> AsnEncoding a -> AsnEncoding a+implicitTag t = EncRetag (TagAndExplicitness t Implicit)++required :: FieldName -> (a -> b) -> AsnEncoding b -> Field a+required = FieldRequired++optional :: FieldName -> (a -> Maybe b) -> AsnEncoding b -> Field a+optional = FieldOptional++defaulted :: (Eq b, Show b) => FieldName -> (a -> b) -> AsnEncoding b -> b -> Field a+defaulted name getVal enc defVal = FieldDefaulted name getVal defVal show (==) enc++objectIdentifier :: AsnEncoding ObjectIdentifier+objectIdentifier = EncUniversalValue (UniversalValueObjectIdentifier id mempty)++null :: AsnEncoding ()+null = null'++-- | Anything can be encoded as @NULL@ by simply discarding it. Typically,+--   encoding a type with more than one inhabitant as @NULL@ is a mistake,+--   so the more restrictive 'null' is to be preferred.+null' :: AsnEncoding a+null' = EncUniversalValue UniversalValueNull++integer :: AsnEncoding Integer+integer = EncUniversalValue (UniversalValueInteger id mempty)++integerRanged :: Integer -> Integer -> AsnEncoding Integer+integerRanged lo hi = EncUniversalValue+  (UniversalValueInteger id (Subtypes [SubtypeValueRange lo hi]))++word32 :: AsnEncoding Word32+word32 = EncUniversalValue (UniversalValueInteger fromIntegral (Subtypes [SubtypeValueRange 0 4294967295]))++word64 :: AsnEncoding Word64+word64 = EncUniversalValue (UniversalValueInteger fromIntegral (Subtypes [SubtypeValueRange 0 18446744073709551615]))++-- TODO: add a size subtype to this+octetStringWord32 :: AsnEncoding Word32+octetStringWord32 = EncUniversalValue (UniversalValueOctetString (LB.toStrict . Builder.toLazyByteString . Builder.word32BE) mempty)++octetStringWord8 :: AsnEncoding Word8+octetStringWord8 = EncUniversalValue +  ( UniversalValueOctetString +    ByteString.singleton+    mempty+  )++int32 :: AsnEncoding Int32+int32 = EncUniversalValue (UniversalValueInteger fromIntegral (Subtypes [SubtypeValueRange (-2147483648) 2147483647]))++word :: AsnEncoding Word+word = EncUniversalValue (UniversalValueInteger fromIntegral (Subtypes [SubtypeValueRange 0 (fromIntegral (maxBound :: Word))]))++int :: AsnEncoding Int+int = EncUniversalValue (UniversalValueInteger fromIntegral (Subtypes [SubtypeValueRange (fromIntegral (minBound :: Int)) (fromIntegral (maxBound :: Int))]))++octetString :: AsnEncoding ByteString+octetString = EncUniversalValue (UniversalValueOctetString id mempty)++utf8String :: AsnEncoding Text+utf8String = EncUniversalValue (UniversalValueTextualString Utf8String id mempty mempty)++universalValueTag :: UniversalValue a -> Int+universalValueTag = \case+  UniversalValueOctetString _ _ -> 4+  UniversalValueBoolean _ _ -> 1+  UniversalValueInteger _ _ -> 2+  UniversalValueNull -> 5+  UniversalValueObjectIdentifier _ _ -> 6+  UniversalValueTextualString typ _ _ _ -> tagNumStringType typ++-- For DER, which is what is actually targetted by this file,+-- I think that this is always Primitive.+univsersalValueConstruction :: UniversalValue a -> Construction+univsersalValueConstruction = \case+  UniversalValueOctetString _ _ -> Primitive+  UniversalValueBoolean _ _ -> Primitive+  UniversalValueInteger _ _ -> Primitive+  UniversalValueNull -> Primitive+  UniversalValueTextualString _ _ _ _ -> Primitive+  UniversalValueObjectIdentifier _ _ -> Primitive++-- | The ByteString that accompanies the tag does not+--   include its own length.+encodeBerInternal :: AsnEncoding a -> a -> TaggedByteString+encodeBerInternal x a = case x of+  EncRetag (TagAndExplicitness outerTag explicitness) e ->+    let TaggedByteString construction innerTag lbs = encodeBerInternal e a+     in case explicitness of+          Implicit -> TaggedByteString construction outerTag lbs+          Explicit -> TaggedByteString Constructed outerTag (encodeTaggedByteString (TaggedByteString construction innerTag lbs))+  EncUniversalValue p -> TaggedByteString (univsersalValueConstruction p) (makeTag Universal (universalValueTag p)) (encodePrimitiveBer p a)+  EncChoice (Choice conv _ f) -> case f (conv a) of+    ValueAndEncoding _ _ b enc2 -> encodeBerInternal enc2 b+  EncSequence fields -> TaggedByteString Constructed sequenceTag (foldMap (encodeField a) fields)+  -- It's kind of weird that sequence and sequence-of share the same tag,+  -- but hey, that's how the committee designed it.+  EncSequenceOf listify e -> TaggedByteString Constructed sequenceTag+    (foldMap (encodeTaggedByteString . encodeBerInternal e) (listify a))++-- Factor out some of the encoding stuff here into another function+encodeField :: a -> Field a -> LB.ByteString+encodeField a = \case+  FieldRequired _ func enc -> encodeTaggedByteString (encodeBerInternal enc (func a))+  FieldDefaulted _ func defVal _ eqVal enc ->+    let val = func a+     in if eqVal defVal val+          then mempty+          else encodeTaggedByteString (encodeBerInternal enc val)+  FieldOptional _ mfunc enc -> case mfunc a of+    Nothing -> mempty+    Just v -> encodeTaggedByteString (encodeBerInternal enc v)++encodeTaggedByteString :: TaggedByteString -> LB.ByteString+encodeTaggedByteString (TaggedByteString construction theTag lbs) =+  encodeTag construction theTag <> encodeLength (LB.length lbs) <> lbs++encodeTag :: Construction -> Tag -> LB.ByteString+encodeTag c (Tag tclass tnum)+  | tnum < 31 = LB.singleton (firstThreeBits .|. intToWord8 tnum)+  | otherwise = error "tag number above 30: write this"+  where+  !firstThreeBits = constructionBit c .|. tagClassBit tclass++encodeLength :: Int64 -> LB.ByteString+encodeLength x+  | x < 128 = LB.singleton (int64ToWord8 x)+  | otherwise =+      let totalOctets = fromIntegral (int64Log256 x + 1) :: Word8+       in LB.singleton (128 .|. totalOctets)+          <> lengthBE (fromIntegral x)++int64Log256 :: Int64 -> Int+int64Log256 x = unsafeShiftR (int64Log2 x) 3++int64Log2 :: Int64 -> Int+int64Log2 x = finiteBitSize x - 1 - countLeadingZeros x++int64ToWord8 :: Int64 -> Word8+int64ToWord8 = fromIntegral+{-# INLINE int64ToWord8 #-}++intToWord8 :: Int -> Word8+intToWord8 = fromIntegral+{-# INLINE intToWord8 #-}++encodePrimitiveBer :: UniversalValue a -> a -> LB.ByteString+encodePrimitiveBer p x = case p of+  UniversalValueTextualString typ f _ _ -> LB.fromStrict (encodeText typ (f x))+  UniversalValueOctetString f _ -> LB.fromStrict (f x)+  UniversalValueObjectIdentifier f _ -> oidBE (f x)+  UniversalValueBoolean f _ -> case f x of+    True -> LB.singleton 1+    False -> LB.singleton 0+  UniversalValueInteger f _ -> integerBE (f x)+  UniversalValueNull -> LB.empty++encodeText :: StringType -> Text -> ByteString+encodeText x t = case x of+  Utf8String -> TE.encodeUtf8 t+  _ -> error "encodeText: handle more ASN.1 string types"++lengthBE :: Int64 -> LB.ByteString+lengthBE i = if i > 0+  then Builder.toLazyByteString (goPos i)+  else error "lengthBE: handle the negative case"+  where+  goPos :: Int64 -> Builder+  goPos n1 = if n1 == 0+    then mempty+    else let (!n2,!byteVal) = quotRem n1 256+          in goPos n2 <> Builder.word8 (fromIntegral byteVal)++integerBE :: Integer -> LB.ByteString+integerBE i+  | i < 128 && i > (-129) = Builder.toLazyByteString (Builder.int8 (fromIntegral i))+  | otherwise = if i > 0+      then let lb = Builder.toLazyByteString (goPos i)+            in if LB.head lb > 127 then LB.cons 0 lb else lb+      else error "integerBE: handle the negative case"+  where+  goPos :: Integer -> Builder+  goPos n1 = if n1 == 0+    then mempty+    else let (!n2,!byteVal) = quotRem n1 256+          in goPos n2 <> Builder.word8 (fromIntegral byteVal)++oidBE :: ObjectIdentifier -> LB.ByteString+oidBE (ObjectIdentifier nums1)+  | sz > 2 =+      let !n1 = PM.indexPrimArray nums1 0+          !n2 = PM.indexPrimArray nums1 1+          -- !nums2 = Vector.unsafeDrop 2 nums1+          !firstOctet = fromIntegral n1 * 40 + fromIntegral n2 :: Word8+       in Builder.toLazyByteString (Builder.word8 firstOctet <> foldMapPrimArrayFromTo 2 sz multiByteBase127Encoding nums1)+  | otherwise = error "oidBE: OID with less than 3 identifiers"+  where+  sz = PM.sizeofPrimArray nums1++foldMapPrimArrayFromTo :: forall a b. (Prim a, Monoid b) => Int -> Int -> (a -> b) -> PrimArray a -> b+foldMapPrimArrayFromTo !start !end f !arr = go start where+  go !i+    | end > i = mappend (f (PM.indexPrimArray arr i)) (go (i+1))+    | otherwise = mempty++-- This function works fine on any integral type.+multiByteBase127Encoding :: Word -> Builder+multiByteBase127Encoding i0 =+  let (!i1,!byteVal) = quotRem i0 128+   in go i1 <> Builder.word8 (fromIntegral byteVal)+  where+  go n1 = if n1 == 0+    then mempty+    else let (!n2,!byteVal) = quotRem n1 128+          in go n2 <> Builder.word8 (128 .|. fromIntegral byteVal)

@@ -0,0 +1,73 @@+{-# language BangPatterns #-}++module Language.Asn.ObjectIdentifier+  ( fromList+  , suffixSingleton+  , appendSuffix+  , isPrefixOf+  , stripPrefix+  , encodeString+  , encodeByteString+  , encodeText+  )+  where++import Control.Monad.ST (runST)+import Language.Asn.Types+import Data.Maybe (isJust)+import Data.Text (Text)+import Data.ByteString (ByteString)+import Data.Word (Word32)+import Data.Primitive (PrimArray(..))+import qualified Data.Text as Text+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as BC8+import qualified Data.Vector.Primitive as PV+import qualified Data.List as List+import qualified Data.Primitive as PM+import qualified GHC.Exts as E++fromList :: [Word] -> ObjectIdentifier+fromList = ObjectIdentifier . E.fromList++suffixSingleton :: Word -> ObjectIdentifierSuffix+suffixSingleton = ObjectIdentifierSuffix . singletonPrimArray++appendSuffix :: ObjectIdentifier -> ObjectIdentifierSuffix -> ObjectIdentifier+appendSuffix (ObjectIdentifier a) (ObjectIdentifierSuffix b) = ObjectIdentifier (mappend a b)++isPrefixOf :: ObjectIdentifier -> ObjectIdentifier -> Bool+isPrefixOf a b = isJust (stripPrefix a b)++stripPrefix :: ObjectIdentifier -> ObjectIdentifier -> Maybe ObjectIdentifierSuffix+stripPrefix (ObjectIdentifier a) (ObjectIdentifier b) =+  let lenA = PM.sizeofPrimArray a+   in if (lenA <= PM.sizeofPrimArray b) && (upgradeArray a == PV.take lenA (upgradeArray b))+        then Just (ObjectIdentifierSuffix (unsafeDropPrimArray lenA b))+        else Nothing++upgradeArray :: PM.Prim a => PrimArray a -> PV.Vector a+upgradeArray b@(PrimArray a) = PV.Vector 0 (PM.sizeofPrimArray b) (PM.ByteArray a)++singletonPrimArray :: PM.Prim a => a -> PrimArray a+singletonPrimArray a = runST $ do+  m <- PM.newPrimArray 1+  PM.writePrimArray m 0 a+  PM.unsafeFreezePrimArray m++unsafeDropPrimArray :: PM.Prim a => Int -> PrimArray a -> PrimArray a+unsafeDropPrimArray !n !xs = runST $ do+  m <- PM.newPrimArray (PM.sizeofPrimArray xs - n)+  PM.copyPrimArray m 0 xs n (PM.sizeofPrimArray xs - n)+  PM.unsafeFreezePrimArray m++encodeString :: ObjectIdentifier -> String+encodeString = List.intercalate "." . map show . E.toList . getObjectIdentifier++encodeByteString :: ObjectIdentifier -> ByteString+encodeByteString = BC8.pack . encodeString++encodeText :: ObjectIdentifier -> Text+encodeText = Text.pack . encodeString++

@@ -0,0 +1,10 @@+module Language.Asn.Types+  ( AsnEncoding+  , AsnDecoding+  , ObjectIdentifier(..)+  , ObjectIdentifierSuffix(..)+  , TagClass(..)+  , Explicitness(..)+  ) where++import Language.Asn.Types.Internal

@@ -0,0 +1,257 @@+{-# language BangPatterns #-}+{-# language CPP #-}+{-# language DeriveFunctor #-}+{-# language DeriveGeneric #-}+{-# language ExistentialQuantification #-}+{-# language GADTs #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language OverloadedStrings #-}+{-# language RankNTypes #-}+{-# language StandaloneDeriving #-}++module Language.Asn.Types.Internal where++import Prelude hiding (sequence,null)+import Data.String (IsString)+import Data.ByteString (ByteString)+import Data.Text (Text)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid (Monoid)+#endif+import Data.Semigroup (Semigroup)+import Data.Word+import Data.Primitive (PrimArray)+import GHC.Int (Int(..))+import Data.Hashable (Hashable(..))+import GHC.Generics (Generic)+import Data.Functor.Contravariant (Contravariant(..))+import qualified Data.ByteString.Lazy as LB+import qualified GHC.Exts as E++data AsnEncoding a+  = EncSequence [Field a]+  | forall b. EncSequenceOf (a -> [b]) (AsnEncoding b)+  | EncChoice (Choice a)+  | EncRetag TagAndExplicitness (AsnEncoding a)+  | EncUniversalValue (UniversalValue a)++instance Contravariant AsnEncoding where+  contramap f = \case+    EncRetag te y -> EncRetag te (contramap f y)+    EncUniversalValue u -> EncUniversalValue (contramap f u)+    EncSequence xs -> EncSequence (map (contramap f) xs)+    EncChoice c -> EncChoice (contramap f c)+    EncSequenceOf conv enc -> EncSequenceOf (conv . f) enc++data UniversalValue a+  = UniversalValueBoolean (a -> Bool) (Subtypes Bool)+  | UniversalValueInteger (a -> Integer) (Subtypes Integer)+  | UniversalValueNull+  | UniversalValueOctetString (a -> ByteString) (Subtypes ByteString)+  | UniversalValueTextualString StringType (a -> Text) (Subtypes Text) (Subtypes Char)+  | UniversalValueObjectIdentifier (a -> ObjectIdentifier) (Subtypes ObjectIdentifier)++instance Contravariant UniversalValue where+  contramap f = \case+    UniversalValueBoolean conv s -> UniversalValueBoolean (conv . f) s+    UniversalValueInteger conv s -> UniversalValueInteger (conv . f) s+    UniversalValueObjectIdentifier conv s -> UniversalValueObjectIdentifier (conv . f) s+    UniversalValueOctetString conv s -> UniversalValueOctetString (conv . f) s+    UniversalValueTextualString typ conv s1 s2 -> UniversalValueTextualString typ (conv . f) s1 s2+    UniversalValueNull -> UniversalValueNull++newtype Subtypes a = Subtypes { getSubtypes :: [Subtype a] }+  deriving (Semigroup,Monoid)++-- | Note: we deviate slightly from the actual definition of an object+-- identifier. Technically, each number of an OID should be allowed to+-- be an integer of unlimited size. However, we are intentionally unfaithful+-- to this specification because in practice, there are no OIDs that use+-- integers above a 32-bit word, so we just use the machine's native word+-- size.+newtype ObjectIdentifier = ObjectIdentifier+  { getObjectIdentifier :: PrimArray Word+  } deriving (Eq,Ord,Show,Generic)++instance Hashable ObjectIdentifier where+  hash (ObjectIdentifier v) = hash (E.toList v)+  hashWithSalt s (ObjectIdentifier v) = hashWithSalt s (E.toList v)++newtype ObjectIdentifierSuffix = ObjectIdentifierSuffix+  { getObjectIdentifierSuffix :: PrimArray Word+  } deriving (Eq,Ord,Show,Generic)++instance Hashable ObjectIdentifierSuffix where+  hash (ObjectIdentifierSuffix v) = hash (E.toList v)+  hashWithSalt s (ObjectIdentifierSuffix v) = hashWithSalt s (E.toList v)++data Subtype a+  = SubtypeSingleValue a -- This also acts as PermittedAlphabet+  | SubtypeValueRange a a++data StringType+  = Utf8String+  | NumericString+  | PrintableString+  | TeletexString+  | VideotexString+  | IA5String+  | GraphicString+  | VisibleString+  | GeneralString+  | UniversalString+  | CharacterString+  | BmpString++data Explicitness = Explicit | Implicit+data TagAndExplicitness = TagAndExplicitness Tag Explicitness++data Choice a = forall b. Choice (a -> b) [b] (b -> ValueAndEncoding)++instance Contravariant Choice where+  contramap f (Choice conv bs bToValEnc) =+    Choice (conv . f) bs bToValEnc++data ValueAndEncoding = forall b. ValueAndEncoding Int OptionName b (AsnEncoding b)+data Field a+  = forall b. FieldRequired FieldName (a -> b) (AsnEncoding b)+  | forall b. FieldOptional FieldName (a -> Maybe b) (AsnEncoding b)+  | forall b. FieldDefaulted FieldName (a -> b) b (b -> String) (b -> b -> Bool) (AsnEncoding b)++instance Contravariant Field where+  contramap f = \case+    FieldRequired name g enc -> FieldRequired name (g . f) enc+    FieldOptional name g enc -> FieldOptional name (g . f) enc+    FieldDefaulted name g b1 b2 b3 enc -> FieldDefaulted name (g . f) b1 b2 b3 enc++data TaggedByteString = TaggedByteString !Construction !Tag !LB.ByteString+data TaggedStrictByteString = TaggedStrictByteString !Construction !Tag !ByteString+data Construction = Constructed | Primitive+  deriving (Show,Eq)++newtype FieldName = FieldName { getFieldName :: String }+  deriving (IsString)+newtype OptionName = OptionName { getOptionName :: String }+  deriving (IsString)++data TagClass+  = Universal+  | Application+  | Private+  | ContextSpecific+  deriving (Show,Eq)++data Tag = Tag+  { tagClass :: TagClass+  , tagNumber :: Int+  } deriving (Show,Eq)++fromIntegerTagAndExplicitness :: Integer -> TagAndExplicitness+fromIntegerTagAndExplicitness n = TagAndExplicitness+  (Tag ContextSpecific (fromIntegral n))+  Explicit++fromIntegerTag :: Integer -> Tag+fromIntegerTag n = Tag ContextSpecific (fromIntegral n)++------------------------------+-- Stuff specific to decoding+------------------------------++data AsnDecoding a+  = AsnDecodingUniversal (UniverseDecoding a)+  | forall b. AsnDecodingSequenceOf ([b] -> a) (AsnDecoding b)+  | forall b. AsnDecodingConversion (AsnDecoding b) (b -> Either String a)+  | AsnDecodingRetag TagAndExplicitness (AsnDecoding a)+  | AsnDecodingSequence (FieldDecoding a)+  | AsnDecodingChoice [OptionDecoding a]++deriving instance Functor AsnDecoding++data Ap f a where+  Pure :: a -> Ap f a+  Ap :: f a -> Ap f (a -> b) -> Ap f b++instance Functor (Ap f) where+  fmap f (Pure a)   = Pure (f a)+  fmap f (Ap x y)   = Ap x ((f .) <$> y)++instance Applicative (Ap f) where+  pure = Pure+  Pure f <*> y = fmap f y+  Ap x y <*> z = Ap x (flip <$> y <*> z)++data OptionDecoding a = OptionDecoding OptionName (AsnDecoding a)+  deriving (Functor)++newtype FieldDecoding a = FieldDecoding (Ap FieldDecodingPart a)+  deriving (Functor,Applicative)++data FieldDecodingPart a+  = FieldDecodingRequired FieldName (AsnDecoding a)+  | FieldDecodingDefault FieldName (AsnDecoding a) a (a -> String)+  | forall b. FieldDecodingOptional FieldName (AsnDecoding b) (Maybe b -> a)++data UniverseDecoding a+  = UniverseDecodingInteger (Integer -> a) (Subtypes Integer)+  | UniverseDecodingTextualString StringType (Text -> a) (Subtypes Text) (Subtypes Char)+  | UniverseDecodingOctetString (ByteString -> a) (Subtypes ByteString)+  | UniverseDecodingObjectIdentifier (ObjectIdentifier -> a) (Subtypes ObjectIdentifier)+  | UniverseDecodingNull a+  deriving (Functor)++newtype DecodePart a = DecodePart { getDecodePart :: ByteString -> Either String (a,ByteString) }+  deriving (Functor)++instance Applicative DecodePart where+  pure a = DecodePart (\bs -> Right (a,bs))+  DecodePart f <*> DecodePart g = DecodePart $ \bs1 -> do+    (h,bs2) <- f bs1+    (a,bs3) <- g bs2+    return (h a, bs3)++runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp _ (Pure x) = pure x+runAp u (Ap f x) = flip id <$> u f <*> runAp u x++liftAp :: f a -> Ap f a+liftAp x = Ap x (Pure id)+{-# INLINE liftAp #-}++--------------------------+-- Functions common to encoding and decoding+--------------------------++-- Bit six is 1 when a value is constructed.+constructionBit :: Construction -> Word8+constructionBit = \case+  Constructed -> 32+  Primitive -> 0++-- Controls upper two bits in the octet+tagClassBit :: TagClass -> Word8+tagClassBit = \case+  Universal -> 0+  Application -> 64+  ContextSpecific -> 128+  Private -> 192++sequenceTag :: Tag+sequenceTag = Tag Universal 16++tagNumStringType :: StringType -> Int+tagNumStringType = \case+  Utf8String -> 12+  NumericString -> 18+  PrintableString -> 19+  TeletexString -> 20+  VideotexString -> 21+  IA5String -> 22+  GraphicString -> 25+  VisibleString -> 26+  GeneralString -> 27+  UniversalString -> 28+  CharacterString -> 29+  BmpString -> 30