    -- |
    -- Module      : Crypto.Store.ASN1.Generate
    -- License     : BSD-style
    -- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Generating ASN.1
    module Crypto.Store.ASN1.Generate
        ( ASN1Stream
        , ASN1Elem()
        , ASN1P()
        , ASN1PS
        , asn1Container
        , gNull
        , gIntVal
        , gOID
        , gASN1String
        , gBMPString
        , gOctetString
        , gBitString
        , gASN1Time
        , gMany
        , gEncoded
        , optASN1S
        , encodeASN1S
        ) where

    import           Data.ASN1.BinaryEncoding
    import           Data.ASN1.BinaryEncoding.Raw
    import           Data.ASN1.BitArray
    import           Data.ASN1.Encoding
    import           Data.ASN1.OID
    import           Data.ASN1.Types
    import qualified Data.ByteArray as B
    import           Data.ByteString (ByteString)

    import Time.Types (DateTime, TimezoneOffset)

    -- | A stream of ASN.1 elements.
    type ASN1Stream e = [e] -> [e]

    -- | Elements in an ASN.1 stream.
    class ASN1Elem e where
        -- | Create a container from an inner ASN.1 stream.
        asn1Container :: ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
        -- | Generate a list of ASN.1 elements.
        gMany :: [ASN1] -> ASN1Stream e
        -- | Generate one ASN.1 element.
        gOne :: ASN1 -> ASN1Stream e

    instance ASN1Elem ASN1 where
        asn1Container :: ASN1ConstructionType -> ASN1Stream ASN1 -> ASN1Stream ASN1
    asn1Container ASN1ConstructionType
    ty ASN1Stream ASN1
    f = (ASN1ConstructionType -> ASN1
    Start ASN1ConstructionType
    ty ASN1 -> ASN1Stream ASN1
    forall a. a -> [a] -> [a]
    :) ASN1Stream ASN1 -> ASN1Stream ASN1 -> ASN1Stream ASN1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ASN1Stream ASN1
    f ASN1Stream ASN1 -> ASN1Stream ASN1 -> ASN1Stream ASN1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ASN1ConstructionType -> ASN1
    End ASN1ConstructionType
    ty ASN1 -> ASN1Stream ASN1
    forall a. a -> [a] -> [a]
    :)
        gMany :: [ASN1] -> ASN1Stream ASN1
    gMany = [ASN1] -> ASN1Stream ASN1
    forall a. [a] -> [a] -> [a]
    (++)
        gOne :: ASN1 -> ASN1Stream ASN1
    gOne = (:)

    -- | Extend the 'ASN1' type to be able to encode to ASN.1 even when some parts
    -- of the stream have already been encoded.
    data ASN1P
        = ASN1Prim [ASN1]
          -- ^ Primitive elements (or constructed types that are fully terminated)
        | ASN1Container !ASN1ConstructionType [ASN1P]
          -- ^ Constructed type with inner structure kept
        | ASN1Encoded !ByteString
          -- ^ A part which has already been encoded

    instance ASN1Elem ASN1P where
        asn1Container :: ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
    asn1Container ASN1ConstructionType
    ty ASN1Stream ASN1P
    f = (ASN1ConstructionType -> [ASN1P] -> ASN1P
    ASN1Container ASN1ConstructionType
    ty (ASN1Stream ASN1P
    f []) ASN1P -> ASN1Stream ASN1P
    forall a. a -> [a] -> [a]
    :)
        gMany :: [ASN1] -> ASN1Stream ASN1P
    gMany [ASN1]
    asn1 = ([ASN1] -> ASN1P
    ASN1Prim [ASN1]
    asn1 ASN1P -> ASN1Stream ASN1P
    forall a. a -> [a] -> [a]
    :)
        gOne :: ASN1 -> ASN1Stream ASN1P
    gOne = [ASN1] -> ASN1Stream ASN1P
    forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
    gMany ([ASN1] -> ASN1Stream ASN1P)
    -> (ASN1 -> [ASN1]) -> ASN1 -> ASN1Stream ASN1P
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ASN1 -> ASN1Stream ASN1
    forall a. a -> [a] -> [a]
    :[])

    -- | Prepend a list of 'ASN1P'.
    type ASN1PS = ASN1Stream ASN1P

    -- | Encode to ASN.1 a list of 'ASN1P' elements.  Outer encoding will be DER,
    -- but partially encoded inner 'ASN1Encoded' elements many have any encoding.
    pEncode :: [ASN1P] -> ByteString
    pEncode :: [ASN1P] -> ByteString
    pEncode [ASN1P]
    x = let (Int
    _, ByteString -> ByteString
    f) = [ASN1P] -> (Int, ByteString -> ByteString)
    run [ASN1P]
    x in ByteString -> ByteString
    f ByteString
    forall a. ByteArray a => a
    B.empty
      where
        run :: [ASN1P] -> (Int, ByteString -> ByteString)
    run []                   = (Int
    0, ByteString -> ByteString
    forall a. a -> a
    id)
        run (ASN1Prim [ASN1]
    asn1 : [ASN1P]
    as) = (ByteString -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ByteString
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    r, ByteString -> ByteString -> ByteString
    forall bs. ByteArray bs => bs -> bs -> bs
    B.append ByteString
    p (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    ps)
          where p :: ByteString
    p       = DER -> [ASN1] -> ByteString
    forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
    encodeASN1' DER
    DER [ASN1]
    asn1
                (Int
    r, ByteString -> ByteString
    ps) = [ASN1P] -> (Int, ByteString -> ByteString)
    run [ASN1P]
    as
        run (ASN1Encoded ByteString
    p : [ASN1P]
    as) = (ByteString -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ByteString
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    r, ByteString -> ByteString -> ByteString
    forall bs. ByteArray bs => bs -> bs -> bs
    B.append ByteString
    p (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    ps)
          where (Int
    r, ByteString -> ByteString
    ps) = [ASN1P] -> (Int, ByteString -> ByteString)
    run [ASN1P]
    as
        run (ASN1Container ASN1ConstructionType
    ty [ASN1P]
    children : [ASN1P]
    as) =
            (ByteString -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ByteString
    header Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    r, ByteString -> ByteString -> ByteString
    forall bs. ByteArray bs => bs -> bs -> bs
    B.append ByteString
    header (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    p (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    ps)
          where (Int
    l, ByteString -> ByteString
    p)  = [ASN1P] -> (Int, ByteString -> ByteString)
    run [ASN1P]
    children
                (Int
    r, ByteString -> ByteString
    ps) = [ASN1P] -> (Int, ByteString -> ByteString)
    run [ASN1P]
    as
                header :: ByteString
    header  = [ASN1Event] -> ByteString
    toByteString [ASN1Header -> ASN1Event
    Header (ASN1Header -> ASN1Event) -> ASN1Header -> ASN1Event
    forall a b. (a -> b) -> a -> b
    $ ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
    ASN1Header ASN1Class
    cl Int
    tg Bool
    True (ASN1Length -> ASN1Header) -> ASN1Length -> ASN1Header
    forall a b. (a -> b) -> a -> b
    $ Int -> ASN1Length
    makeLen Int
    l]
                (ASN1Class
    cl, Int
    tg) =
                    case ASN1ConstructionType
    ty of
                        Container ASN1Class
    tyClass Int
    tyTag -> (ASN1Class
    tyClass, Int
    tyTag)
                        ASN1ConstructionType
    Sequence -> (ASN1Class
    Universal, Int
    0x10)
                        ASN1ConstructionType
    Set -> (ASN1Class
    Universal, Int
    0x11)

        makeLen :: Int -> ASN1Length
    makeLen Int
    len
            | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0x80 = Int -> ASN1Length
    LenShort Int
    len
            | Bool
    otherwise  = Int -> Int -> ASN1Length
    LenLong (Int -> Int
    forall {t} {a}. (Num a, Integral t) => t -> a
    nbBytes Int
    len) Int
    len
        nbBytes :: t -> a
    nbBytes t
    nb = if t
    nb t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    > t
    255 then a
    1 a -> a -> a
    forall a. Num a => a -> a -> a
    + t -> a
    nbBytes (t
    nb t -> t -> t
    forall a. Integral a => a -> a -> a
    `div` t
    256) else a
    1

    -- | Generate a 'Null' ASN.1 element.
    gNull :: ASN1Elem e => ASN1Stream e
    gNull :: forall e. ASN1Elem e => ASN1Stream e
    gNull = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne ASN1
    Null

    -- | Generate an 'IntVal' ASN.1 element.
    gIntVal :: ASN1Elem e => Integer -> ASN1Stream e
    gIntVal :: forall e. ASN1Elem e => Integer -> ASN1Stream e
    gIntVal = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne (ASN1 -> ASN1Stream e)
    -> (Integer -> ASN1) -> Integer -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> ASN1
    IntVal

    -- | Generate an 'OID' ASN.1 element.
    gOID :: ASN1Elem e => OID -> ASN1Stream e
    gOID :: forall e. ASN1Elem e => OID -> ASN1Stream e
    gOID = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne (ASN1 -> ASN1Stream e) -> (OID -> ASN1) -> OID -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OID -> ASN1
    OID

    -- | Generate an 'ASN1String' ASN.1 element.
    gASN1String :: ASN1Elem e => ASN1CharacterString -> ASN1Stream e
    gASN1String :: forall e. ASN1Elem e => ASN1CharacterString -> ASN1Stream e
    gASN1String = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne (ASN1 -> ASN1Stream e)
    -> (ASN1CharacterString -> ASN1)
    -> ASN1CharacterString
    -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ASN1CharacterString -> ASN1
    ASN1String

    -- | Generate an @BMPString@ ASN.1 element.
    gBMPString :: ASN1Elem e => String -> ASN1Stream e
    gBMPString :: forall e. ASN1Elem e => String -> ASN1Stream e
    gBMPString = ASN1CharacterString -> ASN1Stream e
    forall e. ASN1Elem e => ASN1CharacterString -> ASN1Stream e
    gASN1String (ASN1CharacterString -> ASN1Stream e)
    -> (String -> ASN1CharacterString) -> String -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ASN1StringEncoding -> String -> ASN1CharacterString
    asn1CharacterString ASN1StringEncoding
    BMP

    -- | Generate an 'OctetString' ASN.1 element.
    gOctetString :: ASN1Elem e => ByteString -> ASN1Stream e
    gOctetString :: forall e. ASN1Elem e => ByteString -> ASN1Stream e
    gOctetString = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne (ASN1 -> ASN1Stream e)
    -> (ByteString -> ASN1) -> ByteString -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ASN1
    OctetString

    -- | Generate a 'BitString' ASN.1 element.
    gBitString :: ASN1Elem e => BitArray -> ASN1Stream e
    gBitString :: forall e. ASN1Elem e => BitArray -> ASN1Stream e
    gBitString = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne (ASN1 -> ASN1Stream e)
    -> (BitArray -> ASN1) -> BitArray -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BitArray -> ASN1
    BitString

    -- | Generate an 'ASN1Time' ASN.1 element.
    gASN1Time :: ASN1Elem e
              => ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1Stream e
    gASN1Time :: forall e.
    ASN1Elem e =>
    ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1Stream e
    gASN1Time ASN1TimeType
    a DateTime
    b Maybe TimezoneOffset
    c = ASN1 -> ASN1Stream e
    forall e. ASN1Elem e => ASN1 -> ASN1Stream e
    gOne (ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
    ASN1Time ASN1TimeType
    a DateTime
    b Maybe TimezoneOffset
    c)

    -- | Generate ASN.1 for an optional value.
    optASN1S :: Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
    optASN1S :: forall a e. Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
    optASN1S Maybe a
    Nothing    a -> ASN1Stream e
    _  = ASN1Stream e
    forall a. a -> a
    id
    optASN1S (Just a
    val) a -> ASN1Stream e
    fn = a -> ASN1Stream e
    fn a
    val

    -- | Generate ASN.1 for a part of the stream which is already encoded.
    gEncoded :: ByteString -> ASN1PS
    gEncoded :: ByteString -> ASN1Stream ASN1P
    gEncoded = (:) (ASN1P -> ASN1Stream ASN1P)
    -> (ByteString -> ASN1P) -> ByteString -> ASN1Stream ASN1P
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ASN1P
    ASN1Encoded

    -- | Encode the ASN.1 stream to DER format (except for inner parts that are
    -- already encoded and may use another format).
    encodeASN1S :: ASN1PS -> ByteString
    encodeASN1S :: ASN1Stream ASN1P -> ByteString
    encodeASN1S ASN1Stream ASN1P
    asn1 = [ASN1P] -> ByteString
    pEncode (ASN1Stream ASN1P
    asn1 [])