{- |
Module      : Data.ASN1.BinaryEncoding.Writer
License     : BSD-style
Copyright   : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Serialize events for streaming.
-}

module Data.ASN1.BinaryEncoding.Writer
  ( toByteString
  , toLazyByteString
  ) where

import           Data.ASN1.Serialize ( putHeader )
import           Data.ASN1.Types.Lowlevel
                   ( ASN1Event (..), ASN1Header (..), ASN1Length (..) )
import           Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L

-- | Transform a list of ASN.1 events into a strict bytestring.

toByteString :: [ASN1Event] -> ByteString
toByteString :: [ASN1Event] -> ByteString
toByteString = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([ASN1Event] -> [ByteString]) -> [ASN1Event] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> [ByteString]
L.toChunks (LazyByteString -> [ByteString])
-> ([ASN1Event] -> LazyByteString) -> [ASN1Event] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ASN1Event] -> LazyByteString
toLazyByteString

-- | Transform a list of ASN.1 events into a lazy bytestring.

toLazyByteString :: [ASN1Event] -> L.ByteString
toLazyByteString :: [ASN1Event] -> LazyByteString
toLazyByteString [ASN1Event]
evs = [ByteString] -> LazyByteString
L.fromChunks ([ByteString] -> LazyByteString) -> [ByteString] -> LazyByteString
forall a b. (a -> b) -> a -> b
$ [Bool] -> [ASN1Event] -> [ByteString]
loop [] [ASN1Event]
evs
 where
  loop :: [Bool] -> [ASN1Event] -> [ByteString]
loop [Bool]
_ [] = []
  loop [Bool]
acc (x :: ASN1Event
x@(Header (ASN1Header ASN1Class
_ ASN1Tag
_ Bool
pc ASN1Length
len)):[ASN1Event]
xs) =
    ASN1Event -> ByteString
toBs ASN1Event
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [Bool] -> [ASN1Event] -> [ByteString]
loop (if Bool
pc then (ASN1Length
len ASN1Length -> ASN1Length -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Length
LenIndefinite)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
acc else [Bool]
acc) [ASN1Event]
xs
  loop [Bool]
acc (ASN1Event
ConstructionEnd:[ASN1Event]
xs) = case [Bool]
acc of
    []        -> [Char] -> [ByteString]
forall a. HasCallStack => [Char] -> a
error [Char]
"malformed stream: end before construction"
    (Bool
True:[Bool]
r)  -> ASN1Event -> ByteString
toBs ASN1Event
ConstructionEnd ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [Bool] -> [ASN1Event] -> [ByteString]
loop [Bool]
r [ASN1Event]
xs
    (Bool
False:[Bool]
r) -> [Bool] -> [ASN1Event] -> [ByteString]
loop [Bool]
r [ASN1Event]
xs
  loop [Bool]
acc (ASN1Event
x:[ASN1Event]
xs) = ASN1Event -> ByteString
toBs ASN1Event
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [Bool] -> [ASN1Event] -> [ByteString]
loop [Bool]
acc [ASN1Event]
xs

  toBs :: ASN1Event -> ByteString
toBs (Header ASN1Header
hdr)      = ASN1Header -> ByteString
putHeader ASN1Header
hdr
  toBs (Primitive ByteString
bs)    = ByteString
bs
  toBs ASN1Event
ConstructionBegin = ByteString
B.empty
  toBs ASN1Event
ConstructionEnd   = ByteString
B.empty