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 :: ASN1ConstructionType -> ASN1Stream ASN1 -> ASN1Stream ASN1
asn1Container ASN1ConstructionType
ty ASN1Stream ASN1
f = (ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
ty forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASN1ConstructionType -> ASN1
End ASN1ConstructionType
ty forall a. a -> [a] -> [a]
:)
gMany :: [ASN1] -> ASN1Stream ASN1
gMany = forall a. [a] -> [a] -> [a]
(++)
gOne :: ASN1 -> ASN1Stream ASN1
gOne = (:)
data ASN1P
= ASN1Prim [ASN1]
| ASN1Container !ASN1ConstructionType [ASN1P]
| ASN1Encoded !ByteString
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 []) forall a. a -> [a] -> [a]
:)
gMany :: [ASN1] -> ASN1Stream ASN1P
gMany [ASN1]
asn1 = ([ASN1] -> ASN1P
ASN1Prim [ASN1]
asn1 forall a. a -> [a] -> [a]
:)
gOne :: ASN1 -> ASN1Stream ASN1P
gOne = forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
type ASN1PS = ASN1Stream ASN1P
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 forall a. ByteArray a => a
B.empty
where
run :: [ASN1P] -> (Int, ByteString -> ByteString)
run [] = (Int
0, forall a. a -> a
id)
run (ASN1Prim [ASN1]
asn1 : [ASN1P]
as) = (forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
p forall a. Num a => a -> a -> a
+ Int
r, forall bs. ByteArray bs => bs -> bs -> bs
B.append ByteString
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ps)
where p :: ByteString
p = 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) = (forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
p forall a. Num a => a -> a -> a
+ Int
r, forall bs. ByteArray bs => bs -> bs -> bs
B.append ByteString
p 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) =
(forall ba. ByteArrayAccess ba => ba -> Int
B.length ByteString
header forall a. Num a => a -> a -> a
+ Int
l forall a. Num a => a -> a -> a
+ Int
r, forall bs. ByteArray bs => bs -> bs -> bs
B.append ByteString
header forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
p 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 forall a b. (a -> b) -> a -> b
$ ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
cl Int
tg Bool
True 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 forall a. Ord a => a -> a -> Bool
< Int
0x80 = Int -> ASN1Length
LenShort Int
len
| Bool
otherwise = Int -> Int -> ASN1Length
LenLong (forall {t} {a}. (Num a, Integral t) => t -> a
nbBytes Int
len) Int
len
nbBytes :: t -> a
nbBytes t
nb = if t
nb forall a. Ord a => a -> a -> Bool
> t
255 then a
1 forall a. Num a => a -> a -> a
+ t -> a
nbBytes (t
nb forall a. Integral a => a -> a -> a
`div` t
256) else a
1
gNull :: ASN1Elem e => ASN1Stream e
gNull :: forall e. ASN1Elem e => ASN1Stream e
gNull = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne ASN1
Null
gIntVal :: ASN1Elem e => Integer -> ASN1Stream e
gIntVal :: forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ASN1
IntVal
gOID :: ASN1Elem e => OID -> ASN1Stream e
gOID :: forall e. ASN1Elem e => OID -> ASN1Stream e
gOID = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> ASN1
OID
gASN1String :: ASN1Elem e => ASN1CharacterString -> ASN1Stream e
gASN1String :: forall e. ASN1Elem e => ASN1CharacterString -> ASN1Stream e
gASN1String = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1CharacterString -> ASN1
ASN1String
gBMPString :: ASN1Elem e => String -> ASN1Stream e
gBMPString :: forall e. ASN1Elem e => String -> ASN1Stream e
gBMPString = forall e. ASN1Elem e => ASN1CharacterString -> ASN1Stream e
gASN1String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1StringEncoding -> String -> ASN1CharacterString
asn1CharacterString ASN1StringEncoding
BMP
gOctetString :: ASN1Elem e => ByteString -> ASN1Stream e
gOctetString :: forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ASN1
OctetString
gBitString :: ASN1Elem e => BitArray -> ASN1Stream e
gBitString :: forall e. ASN1Elem e => BitArray -> ASN1Stream e
gBitString = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitArray -> ASN1
BitString
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 = forall e. ASN1Elem e => ASN1 -> ASN1Stream e
gOne (ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
ASN1Time ASN1TimeType
a DateTime
b Maybe TimezoneOffset
c)
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
_ = forall a. a -> a
id
optASN1S (Just a
val) a -> ASN1Stream e
fn = a -> ASN1Stream e
fn a
val
gEncoded :: ByteString -> ASN1PS
gEncoded :: ByteString -> ASN1Stream ASN1P
gEncoded = (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ASN1P
ASN1Encoded
encodeASN1S :: ASN1PS -> ByteString
encodeASN1S :: ASN1Stream ASN1P -> ByteString
encodeASN1S ASN1Stream ASN1P
asn1 = [ASN1P] -> ByteString
pEncode (ASN1Stream ASN1P
asn1 [])