@adapt-toolkit/mufl 0.8.0

package/transactions/__t_wrapper.mm

@@ -0,0 +1,169 @@
+// This library defines a wrapper around a transaction function.
+// The goal is that given a function that takes a MUFL record type
+// to create a function that takes a string that contains JSON that encodes the value of that type
+// and performs all the necessary runtime checks.
+
+library __t_wrapper loads libraries transaction, key_storage, transaction_queue, identity_proof_document_types {
+
+    metadef t_trn: ($name->str, $targ->any).
+    metadef t_trn_extended: ($trn->t_trn, $is_signed->bool, $is_encrypted->bool).
+    metadef t_trn_message_info: (
+        $decoded_envelope -> transaction::envelope::external::decoded_type || t_trn,
+        $decoded_message -> t_trn,
+        $is_signed -> bool,
+        $is_encrypted -> bool,
+        $has_envelope -> bool
+    ).
+
+    hidden {
+        decrypt_message = fn (message: crypto_message) -> any {
+            return key_storage::decrypt_message message.
+        }
+
+        check_signature = fn (signature: crypto_signature, message: any) -> bool {
+            hash = _value_id message |.
+            return key_storage::check_signature hash signature.
+        }
+
+        check_origin_binding = fn (envelope: any) -> publickey_sign {
+            ip_raw = envelope $ip_document.
+            abort "Missing identity document on external message" WHEN ip_raw == NIL.
+            ip = ip_raw SAFE(identity_proof_document_types::t_identity_proof_document) abort "Invalid identity proof document" WHEN IS NIL.
+            identity = ip? $node_description $address_document $identity.
+            abort "Identity does not commit to the origin address" WHEN (identity $container_id) != (envelope $from).
+            sign_key_id = identity $default_keys $SIGN.
+            sign_pub IS publickey_sign+ = NIL.
+            sc identity $key_list -- (k->) {
+                if _crypto_get_key_id k == sign_key_id {
+                    sign_pub -> k SAFE(publickey_sign).
+                    break.
+                }
+            }
+            abort "SIGN key not found in identity key_list" WHEN sign_pub == NIL.
+            abort "Origin address does not commit to signing key" WHEN (key_storage::address_of_key sign_pub?) != (envelope $from).
+            return sign_pub?.
+        }
+
+        decode_message_with_keys = fn (message: any, origin_sign_key: publickey_sign+) -> t_trn_extended {
+            if message $encrypted_message {
+                is_ptsignature IS bool = TRUE.
+                signature IS crypto_signature+ = NIL.
+                if (message $ptsignature) {
+                    signature -> (message $ptsignature) SAFE(crypto_signature).
+                } else {
+                    signature -> (message $emsignature) SAFE(crypto_signature).
+                    is_ptsignature -> NIL.
+                }
+                encrypted_message = (message $encrypted_message) SAFE(crypto_message).
+                decrypted_message = decrypt_message encrypted_message.
+                res = decrypted_message SAFE(t_trn).
+                if is_ptsignature && (check_signature signature? decrypted_message) {
+                    return ($trn -> res, $is_signed -> TRUE, $is_encrypted -> TRUE).
+                } elif (!is_ptsignature && check_signature signature? encrypted_message) {
+                    return ($trn -> res, $is_signed -> TRUE, $is_encrypted -> TRUE).
+                } else {
+                    abort "Signature verification failed." WHEN TRUE.
+                    return ($trn -> ($name -> "", $targ -> NIL), $is_signed -> FALSE, $is_encrypted -> FALSE).
+                }
+            } elif message $trn {
+                tn = message $trn.
+                signature = (message $ptsignature) SAFE(crypto_signature) abort "Missing field 'ptsignature' in signed message." WHEN IS NIL.
+                if origin_sign_key {
+                    abort "Signature verification failed for message." WHEN ((_crypto_verify_hash_signature (_value_id tn |) signature? origin_sign_key?) != TRUE).
+                } else {
+                    abort "Signature verification failed for message." WHEN ((check_signature signature? tn) == NIL).
+                }
+                return ($trn -> (tn safe(t_trn)), $is_signed -> TRUE, $is_encrypted -> FALSE).
+            } else {
+                return ($trn -> (message safe(t_trn)), $is_signed -> FALSE, $is_encrypted -> FALSE).
+            }
+        }
+    }
+
+    fn decode_message (message: any) -> t_trn_extended
+    {
+        return decode_message_with_keys message NIL.
+    }
+
+    /*
+        This function processing the input transaction envelope.
+        There are different types of transaction envelopes possible (you can learn more about different transaction types in transaction.mm):
+
+        1. External envelope
+            ($from -> global_id, $to -> global_id, $ip_document -> identity_proof_document::type, $body -> ::transaction::type)
+
+            External envelopes then differ in body type
+                1.1. signed encrypted
+                1.2. signed
+                1.3. unsigned unencrypted
+
+        2. Internal envelope
+            ($name -> str, $targ -> any)
+
+
+        Function steps:
+        1. Extract a message from the envelope if needed
+        2. Decode the message  if needed
+        3. Set the flags
+        4. Set the decoded message to the envelope if needed
+        5. Set flags
+    */
+    fn process_transaction_envelope (envelope: any) -> t_trn_message_info {
+        has_envelope is bool = FALSE.
+        message is any = NIL.
+        origin_sign_key IS publickey_sign+ = NIL.
+
+        // This is the case of external message packed into the transaction envelope
+        if envelope $body != NIL {
+            origin_sign_key -> check_origin_binding envelope.
+            message -> envelope $body.
+            has_envelope -> TRUE.
+        } else {
+            message -> envelope.
+            has_envelope -> FALSE.
+        }
+
+        decode_message_with_keys message origin_sign_key => ($trn -> decoded_message, $is_signed -> is_signed, $is_encrypted -> is_encrypted).
+
+        abort "Unsigned external message rejected: enveloped messages must be signed." WHEN has_envelope && (!is_signed).
+
+        if has_envelope {
+            envelope $body -> decoded_message.
+            return (
+                $decoded_envelope -> envelope,
+                $decoded_message -> decoded_message,
+                $is_signed -> is_signed,
+                $is_encrypted -> is_encrypted,
+                $has_envelope -> has_envelope
+            ) safe t_trn_message_info.
+        } else {
+            return (
+                $decoded_envelope -> decoded_message,
+                $decoded_message -> decoded_message,
+                $is_signed -> is_signed,
+                $is_encrypted -> is_encrypted,
+                $has_envelope -> has_envelope
+            ) safe t_trn_message_info.
+        }
+    }
+
+    generic module __w takes TFunc {
+        __functor_mufl = fn (T:TFunc, _is_readonly: bool) -> (?T/reducer->transaction::envelope::type->any) {
+            return fn (message: (?T/reducer), envelope:transaction::envelope::type, origin: transaction::envelope::origin::type, is_signed: bool, is_encrypted: bool, timestamp: time) -> any {
+                transaction::set_current envelope is_signed is_encrypted origin timestamp.
+                ret = (T message SAFE( ?T/reducer )).
+                if _typeof ret == "IMMUTABLE_DICTIONARY" && ret $result_kind == transaction::results::kind::success {
+                    buffered_actions = transaction_queue::get << transaction::envelope::get_trn_name envelope.
+                    actions = ret $result.
+                    sc buffered_actions -- ( -> action) {
+                        actions (_count actions|) -> action as (transaction::action::type).
+                    }
+                    ret $result -> actions.
+
+                }
+                transaction::reset_current ().
+                return ret.
+            }
+        }
+    }
+}

package/transactions/config.mufl

@@ -0,0 +1,22 @@
+config script {
+    (
+        $exports->(
+            $libraries->(
+                $transaction->#"transaction.mm",
+                $__t_wrapper->#"__t_wrapper.mm",
+            ),
+            $applications->(,),
+        ),
+        $imports->(
+            $libraries->(
+                $transaction->#"transaction.mm",
+                $__t_wrapper->#"__t_wrapper.mm",
+                $key_storage->#"../mufl_stdlib",
+                $transaction_queue->#"../mufl_stdlib",
+                $key_utils->#"../mufl_stdlib",
+                $identity_proof_document_types->#"../mufl_stdlib"
+            ),
+            $applications->(,)
+        )
+    ).
+}

package/transactions/transaction.mm

@@ -0,0 +1,200 @@
+library transaction loads libraries key_utils, key_storage, identity_proof_document_types {
+    using key_utils.
+
+
+    generic module typedef takes T { metadef type: T. }
+    // generic module functor takes _Reducer, _Product
+    // {
+    //     metadef type: _Product.
+    //     metadef func_type: _Reducer->_Product.
+    //     hidden
+    //     {
+    //         __func 
+    //     }
+    // }
+
+    metadef unsigned_message: ($name -> str, $targ -> any).
+    metadef signed_message: ($trn -> unsigned_message, $ptsignature -> crypto_signature).
+    metadef encrypted_pt_signed_message: ($encrypted_message -> crypto_message, $ptsignature -> crypto_signature).
+    metadef encrypted_em_signed_message: ($encrypted_message -> crypto_message, $emsignature -> crypto_signature).
+    metadef encrypted_signed_message: encrypted_pt_signed_message || encrypted_em_signed_message.
+    metadef type: (unsigned_message || signed_message || encrypted_pt_signed_message || encrypted_em_signed_message).
+
+
+    module envelope
+    {
+        module origin
+        {
+            user is <$user> = $user.
+            local is <$local> = $local.
+            external is <$external> = $external.
+            metadef type: ?user || ?local || ?external.
+        }
+        module external {
+            metadef type: (
+                $ip_document -> any,
+                $from -> global_id,
+                $to -> global_id,
+                $body -> ::transaction::type
+            ).
+
+            metadef decoded_type: (
+                $ip_document -> any,
+                $from -> global_id,
+                $to -> global_id,
+                $body -> unsigned_message
+            ).
+        }
+
+        module user instantiates typedef with unsigned_message.
+        module local instantiates typedef with unsigned_message.
+
+        metadef type: (external::type || user::type || local::type).
+
+        get_trn_name = fn (envelope) -> str {
+            if envelope $name {
+                return (envelope $name) as str.
+            }
+            return (envelope $body $name) as str.
+        }
+    }
+
+    module action {
+        module kind {
+            return_data is <$RET> = $RET.
+            verify is <$VER> = $VER.
+            send is <$SEND> = $SEND.
+            timeout is <$TIMEOUT> = $TIMEOUT.
+            metadef type: ?return_data || ?verify || ?send || ?timeout.
+        }
+
+        metadef return_data_t: ($action_kind -> ?kind::return_data, $data -> any, $req_id -> str+).
+        metadef send_t: ($action_kind -> ?kind::send, $data -> envelope::external::type).
+        metadef verify_t: ($action_kind -> ?kind::verify, $data -> ($verification_id -> global_id, $data -> any)).
+        metadef timeout_t: ($action_kind -> ?kind::timeout, $data -> ($continuation_id -> global_id, $seconds -> int)).
+
+        metadef type: return_data_t || send_t || verify_t || timeout_t.
+        
+        return_data = fn (data: any) -> return_data_t
+        {
+            return ($action_kind -> kind::return_data, $data -> data).
+        }
+
+        hidden {
+            sign = fn (_:($trn -> tn: ($name -> str, $targ -> any))) -> signed_message {
+                signature = key_storage::default_sign (_value_id tn |).
+                return ($trn -> tn, $ptsignature -> signature) as signed_message.
+            }
+        }
+
+        send = fn (recipient: global_id, trn_body: transaction::type) -> send_t
+        {
+            body is transaction::type = trn_body.
+            // Discriminate the union by probing the distinguishing field first
+            // (cf. __t_wrapper::decode_message_with_keys): SAFE-casting an
+            // ENCRYPTED member against unsigned_message aborts in the meta
+            // domain check ($name reduces NIL against str) instead of yielding
+            // NIL, which broke every encrypted send. Only a plain UNSIGNED
+            // body (has $name, no signature wrapper) gets auto-signed here.
+            raw is any = trn_body.
+            if raw $name {
+                as_unsigned IS unsigned_message+ = trn_body SAFE(unsigned_message).
+                if as_unsigned {
+                    body -> sign ($trn -> as_unsigned?).
+                }
+            }
+            my_ipd = identity_proof_document_types::get_my_ipd().
+            envelope is envelope::external::type = (
+                $ip_document -> my_ipd,
+                $from -> _get_container_id(),
+                $to -> recipient,
+                $body -> body).
+            return ($action_kind -> kind::send, $data -> envelope).
+        }
+
+        verify = fn (verification_id: global_id, data: any) -> verify_t
+        {
+            return ($action_kind -> kind::verify, $data -> ($verification_id -> verification_id, $data -> data)).
+        }
+
+        timeout = fn (continuation_id: global_id, seconds: int) -> timeout_t
+        {
+            return ($action_kind -> kind::timeout, $data -> ($continuation_id -> continuation_id, $seconds -> seconds)).
+        }
+                
+    }
+
+    module results {
+        module kind {
+            success is <$SUC> = $SUC.
+            failure is <$FAIL> = $FAIL.
+
+            metadef type: ?success || ?failure.
+        }
+
+        module success instantiates typedef with ($result_kind -> ?kind::success, $result -> action::type[]).
+        module failure instantiates typedef with ($result_kind -> ?kind::failure, $result -> str).
+        metadef type: success::type || failure::type.
+    }
+
+    hidden { 
+        current is envelope::type+ = NIL.
+        m_is_signed is bool = NIL.
+        m_is_encrypted is bool = NIL.
+        m_origin is envelope::origin::type+ = NIL.
+        m_timestamp is time+ = NIL.
+    }
+        
+    set_current = fn (data: envelope::type+, is_signed: bool, is_encrypted: bool, origin: envelope::origin::type+, timestamp: time+)
+    {
+        current->data. 
+        m_is_signed -> is_signed.
+        m_is_encrypted -> is_encrypted.
+        m_origin -> origin.
+        m_timestamp -> timestamp.
+    }
+
+    reset_current = fn _
+    {
+        set_current NIL NIL NIL NIL NIL.
+    }
+
+    get_transaction_time = fn _ = m_timestamp. 
+    
+    get_current = fn (_) = current. 
+
+    is_signed = fn _ = m_is_signed.
+
+    is_encrypted = fn _ = m_is_encrypted.
+
+    get_origin = fn _ = m_origin.
+
+    failure = fn (message:str) -> results::failure::type 
+    {
+        return ($result_kind -> results::kind::failure, $result -> message).
+    }
+
+    success = fn (actions: action::type[]) -> results::success::type
+    {
+        return ($result_kind -> results::kind::success, $result -> actions).
+    }
+
+    encrypt = fn (_:($cid -> cid: t_container_id, $trn -> tn: ($name -> str, $targ -> any), $isemsignature -> isem: bool)
+               ) -> encrypted_signed_message
+    {
+        encrypted_data = key_storage::default_encrypt tn cid.
+        if isem {
+            signature = key_storage::default_sign (_value_id encrypted_data |).
+            return ($encrypted_message -> encrypted_data, $emsignature -> signature) as encrypted_em_signed_message.
+        } else {
+            signature = key_storage::default_sign (_value_id tn |).
+            return ($encrypted_message -> encrypted_data, $ptsignature -> signature) as encrypted_pt_signed_message.
+        }
+    }
+
+
+}
+
+
+
+