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

module Data.ASN1.Stream
  ( ASN1Repr
    -- * Utilities

  , getConstructedEnd
  , getConstructedEndRepr
  ) where

import           Data.ASN1.Types ( ASN1 (..) )
import           Data.ASN1.Types.Lowlevel ( ASN1Event )

-- | Type synonym representing pairs of a ASN.1 value and a list of ASN.1

-- events.

--

-- This association is sometimes needed in order to know the exact byte sequence

-- leading to an ASN.1 value. For example, in the case of a cryptographic

-- signature.

type ASN1Repr = (ASN1, [ASN1Event])

-- | For the given list of ASN.1 values, assumed to follow a 'Start' value:

--

-- If the list is empty, return a pair of empty lists.

--

-- Otherwise, return a list of values up to (but excluding) the corresponding

-- 'End' value (if any), and a list of the remaining ASN.1 values.

getConstructedEnd ::
     Int
     -- ^ The number of additional 'Start' values encountered, @0@ initially.

  -> [ASN1]
  -> ([ASN1], [ASN1])
-- The given list is empty.

getConstructedEnd :: Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd Int
_ [] = ([], [])

-- The first item is another 'Start'.

getConstructedEnd Int
i (x :: ASN1
x@(Start ASN1ConstructionType
_) : [ASN1]
xs) =
  let ([ASN1]
ys, [ASN1]
zs) = Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [ASN1]
xs
  in  (ASN1
x ASN1 -> [ASN1] -> [ASN1]
forall a. a -> [a] -> [a]
: [ASN1]
ys, [ASN1]
zs)

-- The first item is the corresponding 'End'.

getConstructedEnd Int
0 ((End ASN1ConstructionType
_) : [ASN1]
xs) = ([], [ASN1]
xs)

-- The first item is an 'End', but not the corresponding 'End'.

getConstructedEnd Int
i (x :: ASN1
x@(End ASN1ConstructionType
_) : [ASN1]
xs) =
  let ([ASN1]
ys, [ASN1]
zs) = Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [ASN1]
xs
  in  (ASN1
x ASN1 -> [ASN1] -> [ASN1]
forall a. a -> [a] -> [a]
: [ASN1]
ys, [ASN1]
zs)

-- The first item is not an 'End' or another 'Start'.

getConstructedEnd Int
i (ASN1
x : [ASN1]
xs) =
  let ([ASN1]
ys, [ASN1]
zs) = Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd Int
i [ASN1]
xs
  in  (ASN1
x ASN1 -> [ASN1] -> [ASN1]
forall a. a -> [a] -> [a]
: [ASN1]
ys, [ASN1]
zs)

-- | For the given list of 'ASN1Repr' pairs:

--

-- If the list is empty, return a pair of empty lists.

--

-- If the first item represents a 'Start' value, return a list of pairs up to

-- the corresponding 'End' value (if any) (including the 'Start' and any 'End')

-- and a list of the remaining 'ASN1Repr' pairs.

--

-- Otherwise, return a list of that first item and a list of the

-- remaining pairs.

getConstructedEndRepr :: [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
-- The given list is empty.

getConstructedEndRepr :: [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr [] = ([], [])

-- The first item represents a 'Start'.

getConstructedEndRepr (x :: ASN1Repr
x@(Start ASN1ConstructionType
_, [ASN1Event]
_) : [ASN1Repr]
xs) =
  let ([ASN1Repr]
ys, [ASN1Repr]
zs) = Int -> [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr' Int
1 [ASN1Repr]
xs
  in  (ASN1Repr
x ASN1Repr -> [ASN1Repr] -> [ASN1Repr]
forall a. a -> [a] -> [a]
: [ASN1Repr]
ys, [ASN1Repr]
zs)

-- The first item does not represent a 'Start'.

getConstructedEndRepr (ASN1Repr
x : [ASN1Repr]
xs) = ([ASN1Repr
x], [ASN1Repr]
xs)

-- | For the given list of 'ASN1Repr' pairs:

--

-- If the list is empty, return a pair of empty lists.

--

-- If there is no corresponding 'Start', return an empty list and the list of

-- 'ASN1Repr' pairs.

--

-- Otherwise, return a list of values up to (and including) the corresponding

-- 'End' value (if any), and a list of the remaining  'ASN1Repr' pairs.

getConstructedEndRepr' ::
     Int
     -- ^ The number of 'Start' values encountered.

  -> [ASN1Repr]
  -> ([ASN1Repr], [ASN1Repr])
-- The given list is empty.

getConstructedEndRepr' :: Int -> [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr' Int
_ [] = ([], [])

-- There is no, or no longer a, corresponding 'Start'.

getConstructedEndRepr' Int
0 [ASN1Repr]
xs = ([], [ASN1Repr]
xs)

-- The first item is another 'Start'.

getConstructedEndRepr' Int
i (x :: ASN1Repr
x@(Start ASN1ConstructionType
_, [ASN1Event]
_) : [ASN1Repr]
xs) =
  let ([ASN1Repr]
ys, [ASN1Repr]
zs) = Int -> [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [ASN1Repr]
xs
  in  (ASN1Repr
x ASN1Repr -> [ASN1Repr] -> [ASN1Repr]
forall a. a -> [a] -> [a]
: [ASN1Repr]
ys, [ASN1Repr]
zs)

-- The first item is an 'End'.

getConstructedEndRepr' Int
i (x :: ASN1Repr
x@(End ASN1ConstructionType
_, [ASN1Event]
_):[ASN1Repr]
xs) =
  let ([ASN1Repr]
ys, [ASN1Repr]
zs) = Int -> [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [ASN1Repr]
xs
  in  (ASN1Repr
x ASN1Repr -> [ASN1Repr] -> [ASN1Repr]
forall a. a -> [a] -> [a]
: [ASN1Repr]
ys, [ASN1Repr]
zs)

-- The first item is not an 'End' or another 'Start'.

getConstructedEndRepr' Int
i (ASN1Repr
x : [ASN1Repr]
xs) =
  let ([ASN1Repr]
ys, [ASN1Repr]
zs) = Int -> [ASN1Repr] -> ([ASN1Repr], [ASN1Repr])
getConstructedEndRepr' Int
i [ASN1Repr]
xs
  in  (ASN1Repr
x ASN1Repr -> [ASN1Repr] -> [ASN1Repr]
forall a. a -> [a] -> [a]
: [ASN1Repr]
ys, [ASN1Repr]
zs)