// SPDX-License-Identifier: GPL-3.0-only
// Copyright (c) 2022, Sylvain Huet, Ambermind
// Minimacy (r) System

use core.crypto.oid;;

sum Asn1=
	asn1ClassConstructed _ _ _,	asn1ClassPrimitive _ _ _,
	asn1Bool _, asn1Integer _, asn1BitString _ _, asn1OctetString _, asn1Null, asn1ObjectIdentifier _,	// 0-7
	asn1Utf8String _, // 8-15
	asn1Seq _,asn1Set _, asn1PrintableString _, asn1IA5String _, asn1UtcTime _,	// 16-23
	asn1Else _ _ _ _, asn1Raw _;;

const ASN1_UNIVERSAL=0;;
const ASN1_APPLICATION=1;;
const ASN1_CONTEXT_SPECIFIC=2;;
const ASN1_PRIVATE=3;;

const ASN1_BOOLEAN=1;;
const ASN1_INTEGER=2;;
const ASN1_BITSTRING=3;;
const ASN1_OCTETSTRING=4;;
const ASN1_NULL=5;;
const ASN1_OBJECTIDENTIFIER= 6;;
const ASN1_EXTERNAL= 8;;
const ASN1_UTF8STRING=12;;
const ASN1_SEQUENCE=16;;
const ASN1_SET= 17;;
const ASN1_PRINTABLESTRING= 19;;
const ASN1_IA5STRING= 22;;
const ASN1_UTCTIME= 23;;

fun asn1Echo(prefix, a)=
	echo prefix;
	match a with
		asn1ClassConstructed class tag l -> (
			echoLn strFormat("asn1ClassConstructed */* #*{", class, tag, listLength(l));
			let strConcat(prefix, " .") -> prefix in for p in l do asn1Echo(prefix, p);
			echo prefix; echoLn "}";
		),
		asn1ClassPrimitive class tag content -> echoLn strFormat("asn1ClassPrimitive */*: *", class, tag, hexFromStr(content)),
		asn1Bool b -> echoLn strFormat("asn1Bool: *", b),
		asn1Integer b -> echoLn strFormat("asn1Integer: *", hexFromStr(b)),
		asn1BitString empty s -> echoLn strFormat("asn1BitString: * (* empty)", hexFromStr(s), empty),
		asn1OctetString s -> echoLn strFormat("asn1OctetString: *", hexFromStr(s)),
		asn1Null -> echoLn "asn1Null",
		asn1Else class pc tag bin -> (echoLn ["?? ", tag];nil),
		asn1Utf8String s -> echoLn strFormat("asn1Utf8String: *", s),
		asn1Seq l -> (
			echoLn strFormat("asn1Seq #*{", listLength(l));
			let strConcat(prefix, " .") -> prefix in for p in l do asn1Echo(prefix, p);
			echo prefix; echoLn "}";
		),
		asn1Set l -> (
			echoLn strFormat("asn1Set #*{", listLength(l));
			let strConcat(prefix, " .") -> prefix in for p in l do asn1Echo(prefix, p);
			echo prefix; echoLn "}";
		),
		asn1ObjectIdentifier v -> let niceOID(v) -> nice in echoLn strFormat("asn1ObjectIdentifier: * *", v, if v<>nice then nice),
		asn1PrintableString v -> echoLn strFormat("asn1PrintableString: *", v),
		asn1IA5String v -> echoLn strFormat("asn1IA5String: *", v),
		asn1UtcTime v -> echoLn strFormat("asn1UtcTime: *", v),
		asn1Raw v -> echoLn strFormat("asn1Raw: *", hexFromStr(v)),
		_ -> (dump a;echoLn "!!!!");
	a;;

//---------------PACK----------------------------------------------

fun _asn1MakeSize(val, res)=
	if val==0 then res
	else _asn1MakeSize(val>>8, strInt8(val&255)::res);;

fun _asn1Block(class, constructed, tag, content)=
	let strLength(content) -> len in
	[
		strInt8((class<<6)|(constructed<<5)|tag),
		if len<128 then strInt8(len)
		else let strBuild(_asn1MakeSize(len, nil)) -> size in
			strBuild([strInt8(0x80+strLength(size)), size]),
		content
	];;

fun asn1Pack(a)=
	strBuild(match a with
		asn1ClassConstructed class tag l -> _asn1Block(class, 1, tag, strBuild(listMap(l, #asn1Pack))),
		asn1ClassPrimitive class tag content -> _asn1Block(class, 0, tag, content),
		asn1Bool b -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_BOOLEAN, strInt8(if b then 1 else 0)),
		asn1Integer b -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_INTEGER, b),
		asn1BitString empty s -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_BITSTRING, strConcat(strInt8(empty), s)),
		asn1OctetString s -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_OCTETSTRING, s),
		asn1Null -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_NULL, ""),
		asn1Else class pc tag bin -> _asn1Block(class, pc, tag, bin),
		asn1Utf8String s -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_UTF8STRING, s),
		asn1Seq l -> _asn1Block(ASN1_UNIVERSAL, 1, ASN1_SEQUENCE, strBuild(listMap(l, #asn1Pack))),
		asn1Set l -> _asn1Block(ASN1_UNIVERSAL, 1, ASN1_SET, strBuild(listMap(l, #asn1Pack))),
		asn1ObjectIdentifier v -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_OBJECTIDENTIFIER, strFromOid(v)),
		asn1PrintableString v -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_PRINTABLESTRING, v),
		asn1IA5String v -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_IA5STRING, v),
		asn1UtcTime v -> _asn1Block(ASN1_UNIVERSAL, 0, ASN1_UTCTIME, v),
		asn1Raw v -> [nil, nil, v]);;

//---------------UNPACK----------------------------------------------

fun _asn1ReadCode(bin, i)=
	let strGet(bin, i) -> code in
	if code&0x1f <> 0x1f then [(code>>6)&3, (code>>5)&1, code&0x1f, i+1]
	else
	let strReadVarUInt(bin, i+1) -> label in
	let strVarUIntNext(bin, i+1) -> i in
	[(code>>6)&3, (code>>5)&1, label, i];;
	
fun _asn1ReadInt(bin, i, n, val)=
	if n<=0 then val
	else _asn1ReadInt(bin, i+1, n-1, (val<<8) + strGet(bin, i));;

fun _asn1ReadSize(bin, j)=
	let strGet(bin, j) -> size in
	let strLength(bin) -> binLen in
	if size==0x80 then [strSlice(bin, j+1, binLen-(j+3)), binLen]
	else if !bitTest(size, 0x80) then (
		let j+1+size -> next in
		if next<=binLen then [strSlice(bin, j+1, size), next]
	)
	else let size&0x7f -> nb in
	let _asn1ReadInt(bin, j+1, nb, 0) -> size in
	if size>=0 then
	let j+1+nb+size -> next in
	if next<=binLen then [strSlice(bin, j+1+nb, size), next];;

fun asn1GetObject(bin, class, pc, tag)=
	if class<>0 then
	(
		if pc<>0 then asn1ClassConstructed class tag _asn1Unpack(bin, 0)
		else asn1ClassPrimitive class tag bin
	)
	else if pc<>0 then
	match tag with
		ASN1_SEQUENCE -> asn1Seq _asn1Unpack(bin, 0),
		ASN1_SET -> asn1Set _asn1Unpack(bin, 0),
		_ -> (echoLn strFormat("asn1 tag unknown: * (*/*)", tag, class, pc); hexDump bin; asn1Else class pc tag bin)
	else
	match tag with
		ASN1_BOOLEAN -> asn1Bool 0<>strGet(bin, 0),
		ASN1_INTEGER -> asn1Integer bin,
		ASN1_BITSTRING -> asn1BitString strGet(bin, 0) strSlice(bin, 1, nil),
		ASN1_OCTETSTRING -> asn1OctetString bin,
		ASN1_NULL -> asn1Null,
		ASN1_OBJECTIDENTIFIER -> asn1ObjectIdentifier oidFromStr(bin),
		ASN1_UTF8STRING -> asn1Utf8String bin,
		ASN1_PRINTABLESTRING -> asn1PrintableString bin,
		ASN1_IA5STRING -> asn1IA5String bin,
		ASN1_UTCTIME -> asn1UtcTime bin,
		_ -> (echoLn strFormat("asn1 tag unknown: * (*/*)", tag, class, pc); hexDump bin; asn1Else class pc tag bin);;

fun _asn1Unpack(bin, i)=
	if i<strLength(bin) then
	let _asn1ReadCode(bin, i) ->[class, pc, tag, i] in
	let _asn1ReadSize(bin, i) ->[content, i] in
	if i<>nil then 
	let asn1GetObject(content, class, pc, tag) -> asn1 in
	asn1::_asn1Unpack(bin, i);;

fun asn1Unpack(bin)= head(_asn1Unpack(bin, 0));;

fun asn1InfoBlock(bin)=	// to be used with certificates and csr
	let _asn1ReadCode(bin, 0) ->[_, _, _, i] in
	let _asn1ReadSize(bin, i) ->[content, i] in
	let _asn1ReadCode(content, 0) ->[_, _, _, i] in
	let _asn1ReadSize(content, i) ->[_, i] in
	strLeft(content, i);;

//-------------EXPLORE-----------------------------
fun boolFromAsn1(a) = match a with asn1Bool b -> b;;
fun intFromAsn1(a) = match a with asn1Integer b -> intFromHex(hexFromStr(b));;
fun strFromAsn1(a) = match a with
	asn1Integer b -> b,
	asn1BitString emptyBits b -> b,
	asn1OctetString b -> b,
	asn1Utf8String b -> b,
	asn1ObjectIdentifier b -> b,
	asn1PrintableString b -> b,
	asn1IA5String b -> b,
	asn1UtcTime b -> b,
	asn1ClassPrimitive class tag content -> content;;
fun listFromAsn1(a) = match a with
	asn1Seq seq-> seq,
	asn1Set seq-> seq,
	asn1ClassConstructed class tag seq -> seq;;

fun asn1ListOfStr(l)= if l<>nil then strFromAsn1(head(l))::asn1ListOfStr(tail(l));;
fun asn1ListOfHex(l)=listMap(asn1ListOfStr(l), #hexFromStr);;
fun asn1ListOfBignum(l)=listMap(asn1ListOfStr(l), #bigDeserialize);;

fun _distinguishedName(l)=
	if l<>nil then
		let listFromAsn1(head(listFromAsn1(head(l)))) -> (p::q::_) in
		let strFromAsn1(p) -> id in
		let strFromAsn1(q) -> val in
		[id, val]::_distinguishedName(tail(l));;

fun asn1DistinguishedName(bin)=
	let asn1Unpack(bin)-> asn1 in
	_distinguishedName(listFromAsn1(asn1));;

fun ecPointFromAsn1(asn1)=
	let listFromAsn1(asn1Unpack(asn1)) -> x::y::_ in
	if y<>nil then
	[bigDeserialize(strFromAsn1(x)), bigDeserialize(strFromAsn1(y))];;

fun _asn1EcCoord(x)=
	let bigSerialize(x, nil) -> str in
	strConcat(if bitTest(0x80, strGet(str, 0)) then "\z", str);;

fun asn1EcPoint([x, y])=
	asn1Pack(asn1Seq
		(asn1Integer _asn1EcCoord(x))::
		(asn1Integer _asn1EcCoord(y))::
		nil);;