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)
type ASN1Stream e = [e] -> [e]
class ASN1Elem e where
asn1Container :: ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
gMany :: [ASN1] -> ASN1Stream e
gOne :: ASN1 -> ASN1Stream e
instance ASN1Elem ASN1 where
asn1Container ty f = (Start ty :) . f . (End ty :)
gMany = (++)
gOne = (:)
data ASN1P
= ASN1Prim [ASN1]
| ASN1Container !ASN1ConstructionType [ASN1P]
| ASN1Encoded !ByteString
instance ASN1Elem ASN1P where
asn1Container ty f = (ASN1Container ty (f []) :)
gMany asn1 = (ASN1Prim asn1 :)
gOne = gMany . (:[])
type ASN1PS = ASN1Stream ASN1P
pEncode :: [ASN1P] -> ByteString
pEncode x = let (_, f) = run x in f B.empty
where
run [] = (0, id)
run (ASN1Prim asn1 : as) = (B.length p + r, B.append p . ps)
where p = encodeASN1' DER asn1
(r, ps) = run as
run (ASN1Encoded p : as) = (B.length p + r, B.append p . ps)
where (r, ps) = run as
run (ASN1Container ty children : as) =
(B.length header + l + r, B.append header . p . ps)
where (l, p) = run children
(r, ps) = run as
header = toByteString [Header $ ASN1Header cl tg True $ makeLen l]
(cl, tg) =
case ty of
Container tyClass tyTag -> (tyClass, tyTag)
Sequence -> (Universal, 0x10)
Set -> (Universal, 0x11)
makeLen len
| len < 0x80 = LenShort len
| otherwise = LenLong (nbBytes len) len
nbBytes nb = if nb > 255 then 1 + nbBytes (nb `div` 256) else 1
gNull :: ASN1Elem e => ASN1Stream e
gNull = gOne Null
gIntVal :: ASN1Elem e => Integer -> ASN1Stream e
gIntVal = gOne . IntVal
gOID :: ASN1Elem e => OID -> ASN1Stream e
gOID = gOne . OID
gASN1String :: ASN1Elem e => ASN1CharacterString -> ASN1Stream e
gASN1String = gOne . ASN1String
gBMPString :: ASN1Elem e => String -> ASN1Stream e
gBMPString = gASN1String . asn1CharacterString BMP
gOctetString :: ASN1Elem e => ByteString -> ASN1Stream e
gOctetString = gOne . OctetString
gBitString :: ASN1Elem e => BitArray -> ASN1Stream e
gBitString = gOne . BitString
gASN1Time :: ASN1Elem e
=> ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1Stream e
gASN1Time a b c = gOne (ASN1Time a b c)
optASN1S :: Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
optASN1S Nothing _ = id
optASN1S (Just val) fn = fn val
gEncoded :: ByteString -> ASN1PS
gEncoded = (:) . ASN1Encoded
encodeASN1S :: ASN1PS -> ByteString
encodeASN1S asn1 = pEncode (asn1 [])