1-- |
2-- Module      : Data.ASN1.Serialize
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8module Data.ASN1.Serialize (getHeader, putHeader) where
9
10import qualified Data.ByteString as B
11import Data.ASN1.Get
12import Data.ASN1.Internal
13import Data.ASN1.Types
14import Data.ASN1.Types.Lowlevel
15import Data.Bits
16import Data.Word
17import Control.Applicative ((<$>))
18import Control.Monad
19
20-- | parse an ASN1 header
21getHeader :: Get ASN1Header
22getHeader = do
23    (cl,pc,t1) <- parseFirstWord <$> getWord8
24    tag        <- if t1 == 0x1f then getTagLong else return t1
25    len        <- getLength
26    return $ ASN1Header cl tag pc len
27
28-- | Parse the first word of an header
29parseFirstWord :: Word8 -> (ASN1Class, Bool, ASN1Tag)
30parseFirstWord w = (cl,pc,t1)
31  where cl = toEnum $ fromIntegral $ (w `shiftR` 6)
32        pc = testBit w 5
33        t1 = fromIntegral (w .&. 0x1f)
34
35{- when the first tag is 0x1f, the tag is in long form, where
36 - we get bytes while the 7th bit is set. -}
37getTagLong :: Get ASN1Tag
38getTagLong = do
39    t <- fromIntegral <$> getWord8
40    when (t == 0x80) $ fail "non canonical encoding of long tag"
41    if testBit t 7
42        then loop (clearBit t 7)
43        else return t
44  where loop n = do
45            t <- fromIntegral <$> getWord8
46            if testBit t 7
47                then loop (n `shiftL` 7 + clearBit t 7)
48                else return (n `shiftL` 7 + t)
49
50
51{- get the asn1 length which is either short form if 7th bit is not set,
52 - indefinite form is the 7 bit is set and every other bits clear,
53 - or long form otherwise, where the next bytes will represent the length
54 -}
55getLength :: Get ASN1Length
56getLength = do
57    l1 <- fromIntegral <$> getWord8
58    if testBit l1 7
59        then case clearBit l1 7 of
60            0   -> return LenIndefinite
61            len -> do
62                lw <- getBytes len
63                return (LenLong len $ uintbs lw)
64        else
65            return (LenShort l1)
66  where
67        {- uintbs return the unsigned int represented by the bytes -}
68        uintbs = B.foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0
69
70-- | putIdentifier encode an ASN1 Identifier into a marshalled value
71putHeader :: ASN1Header -> B.ByteString
72putHeader (ASN1Header cl tag pc len) = B.concat
73    [ B.singleton word1
74    , if tag < 0x1f then B.empty else tagBS
75    , lenBS]
76  where cli   = shiftL (fromIntegral $ fromEnum cl) 6
77        pcval = shiftL (if pc then 0x1 else 0x0) 5
78        tag0  = if tag < 0x1f then fromIntegral tag else 0x1f
79        word1 = cli .|. pcval .|. tag0
80        lenBS = B.pack $ putLength len
81        tagBS = putVarEncodingIntegral tag
82
83{- | putLength encode a length into a ASN1 length.
84 - see getLength for the encoding rules -}
85putLength :: ASN1Length -> [Word8]
86putLength (LenShort i)
87    | i < 0 || i > 0x7f = error "putLength: short length is not between 0x0 and 0x80"
88    | otherwise         = [fromIntegral i]
89putLength (LenLong _ i)
90    | i < 0     = error "putLength: long length is negative"
91    | otherwise = lenbytes : lw
92        where
93            lw       = bytesOfUInt $ fromIntegral i
94            lenbytes = fromIntegral (length lw .|. 0x80)
95putLength (LenIndefinite) = [0x80]
96