Make PrincipalId abstract

src/codegen/compile.ml

@@ -3319,6 +3319,7 @@ module Serialization = struct
           | Func (s, c, tbs, ts1, ts2) ->
             List.iter go ts1; List.iter go ts2
           | Prim Blob -> ()
+          | Prim Principal -> ()
           | _ ->
             Printf.eprintf "type_desc: unexpected type %s\n" (string_of_typ t);
             assert false
@@ -3368,7 +3369,7 @@ module Serialization = struct
     let rec add_typ t =
       match t with
       | Non -> assert false
-      | Prim Blob ->
+      | Prim Blob | Prim Principal ->
         add_typ Type.(Array (Prim Word8))
       | Prim _ -> assert false
       | Tup ts ->
@@ -3490,7 +3491,7 @@ module Serialization = struct
           get_x ^^ get_i ^^ Arr.idx env ^^ load_ptr ^^
           size env t
         )
-      | Prim Blob ->
+      | Prim Blob | Prim Principal ->
         let (set_len, get_len) = new_local env "len" in
         get_x ^^ Heap.load_field Blob.len_field ^^ set_len ^^
         size_word env get_len ^^
@@ -3647,7 +3648,7 @@ module Serialization = struct
           )
           ( List.mapi (fun i (_h, f) -> (i,f)) (sort_by_hash vs) )
           ( E.trap_with env "serialize_go: unexpected variant" )
-      | Prim Blob ->
+      | Prim (Blob | Principal) ->
         let (set_len, get_len) = new_local env "len" in
         get_x ^^ Heap.load_field Blob.len_field ^^ set_len ^^
         write_word get_len ^^

src/mo_frontend/coverage.ml

@@ -104,6 +104,7 @@ let pick_val vs = function
   | T.Text
   | T.Blob
   | T.Error
+  | T.Principal
   | T.Float -> Any
 
 let rec expand_notval t n vs : desc list =

src/mo_idl/mo_to_idl.ml

@@ -58,6 +58,7 @@ let prim p =
   | Char -> I.PrimT I.Nat32
   | Text -> I.PrimT I.Text
   | Blob -> I.VecT (I.PrimT I.Nat8 @@ no_region)
+  | Principal -> I.VecT (I.PrimT I.Nat8 @@ no_region) (* could also be an empty service? *)
   | Error -> assert false
 
 let rec typ vs t =

src/mo_types/arrange_type.ml

@@ -40,6 +40,7 @@ let prim p = match p with
   | Text -> Atom "Text"
   | Blob -> Atom "Blob"
   | Error -> Atom "Error"
+  | Principal -> Atom "Principal"
 
 let con c = Atom (Con.to_string c)
 

src/mo_types/type.ml

@@ -34,6 +34,7 @@ type prim =
   | Text
   | Blob (* IR use: Packed representation, vec u8 IDL type *)
   | Error
+  | Principal
 
 type t = typ
 and typ =
@@ -112,7 +113,7 @@ let catch = Prim Error
 
 (* Shared call context *)
 
-let caller = Prim Blob
+let caller = Prim Principal
 let ctxt = Obj (Object,[{ lab = "caller"; typ = caller }])
 
 let prim = function
@@ -137,6 +138,7 @@ let prim = function
   | "Text" -> Text
   | "Blob" -> Blob
   | "Error" -> Error
+  | "Principal" -> Principal
   | s -> raise (Invalid_argument ("Type.prim: " ^ s))
 
 let seq = function [t] -> t | ts -> Tup ts
@@ -441,7 +443,7 @@ let rec span = function
   | Con _ as t -> span (promote t)
   | Prim Null -> Some 1
   | Prim Bool -> Some 2
-  | Prim (Nat | Int | Float | Text | Blob | Error) -> None
+  | Prim (Nat | Int | Float | Text | Blob | Error | Principal) -> None
   | Prim (Nat8 | Int8 | Word8) -> Some 0x100
   | Prim (Nat16 | Int16 | Word16) -> Some 0x10000
   | Prim (Nat32 | Int32 | Word32 | Nat64 | Int64 | Word64 | Char) -> None  (* for all practical purposes *)
@@ -1121,6 +1123,7 @@ let string_of_prim = function
   | Text -> "Text"
   | Blob -> "Blob"
   | Error -> "Error"
+  | Principal -> "Principal"
 
 let string_of_var (x, i) =
   if i = 0 then sprintf "%s" x else sprintf "%s.%d" x i

src/mo_types/type.mli

@@ -32,6 +32,7 @@ type prim =
   | Text
   | Blob (* IR use: Packed representation, vec u8 IDL type *)
   | Error
+  | Principal
 
 type t = typ
 and typ =

src/mo_values/operator.ml

@@ -150,7 +150,7 @@ let num_relop fnat (fnat8, fnat16, fnat32, fnat64) fint (fint8, fint16, fint32,
 let ord_relop fnat fnats fint fints fwords ffloat fchar ftext fblob = function
   | T.Char -> fun v1 v2 -> Bool (fchar (as_char v1) (as_char v2))
   | T.Text -> fun v1 v2 -> Bool (ftext (as_text v1) (as_text v2))
-  | T.Blob -> fun v1 v2 -> Bool (ftext (as_text v1) (as_text v2))
+  | T.Blob | T.Principal -> fun v1 v2 -> Bool (ftext (as_text v1) (as_text v2))
   | t -> num_relop fnat fnats fint fints fwords ffloat t
 
 let eq_relop fnat fnats fint fints fwords ffloat fchar ftext fblob fnull fbool = function

src/prelude/prelude.ml

@@ -28,6 +28,7 @@ type Char = prim "Char";
 type Text = prim "Text";
 type Blob = prim "Blob";
 type Error = prim "Error";
+type Principal = prim "Principal";
 
 type @Iter<T_> = {next : () -> ?T_};
 
@@ -446,5 +447,10 @@ func errorMessage(e : Error) : Text = {
   ((prim "cast" : Error -> (ErrorCode, Text)) e).1;
 };
 
+// Principal
+
+func blobOfPrincipal(id : Principal) : Blob = {
+  ((prim "cast" : Principal -> Blob) id)
+};
 
 |}

stdlib/Makefile

@@ -17,6 +17,7 @@ WASM=\
 TESTS=\
 	Array \
 	Blob \
+	Principal \
 	Debug \
 	ArrayTest \
 	BufTest \
@@ -81,6 +82,9 @@ $(OUTDIR)/Debug.out: debug.mo | $(OUTDIR)
 $(OUTDIR)/Blob.out: blob.mo | $(OUTDIR)
 	$(MOC) -r $(filter-out $(OUTDIR), $^) > $@
 
+$(OUTDIR)/Principal.out: principalId.mo | $(OUTDIR)
+	$(MOC) -r $(filter-out $(OUTDIR), $^) > $@
+
 $(OUTDIR)/Array.out: array.mo | $(OUTDIR)
 	$(MOC) -r $(filter-out $(OUTDIR), $^) > $@
 

stdlib/principalId.mo

@@ -0,0 +1,5 @@
+import Prim "mo:prim";
+import Blob "blob.mo";
+module {
+  public func hash(x : Principal) : Word32 = Blob.hash (Prim.blobOfPrincipal x);
+}

test/run-drun/caller.mo

@@ -2,12 +2,12 @@ import Prim "mo:prim";
 actor a {
 
   public shared ctxt func c1 () : async () {
-    let c : Blob = ctxt.caller;
+    let c : Principal = ctxt.caller;
     return;
   };
 
   public shared {caller} func c2 () : async () {
-    let c1 : Blob = caller;
+    let c1 : Principal = caller;
     return;
   };
 
@@ -24,24 +24,27 @@ actor a {
   };
 
   public shared query {caller} func c6 () : async () {
-    let c1 : Blob = caller;
+    let c1 : Principal = caller;
     return;
   };
 
-  public shared {caller} func c7() : async Blob {
+  public shared {caller} func c7() : async Principal {
     return caller;
   };
 
+  // NB: The following tests are more about Blob than Principal
+  // Maybe move to their own tests once we have intro forms for blobs
+
   public shared query {caller} func c8() : async Word32 {
-    Prim.hashBlob caller;
+    Prim.hashBlob (Prim.blobOfPrincipal caller);
   };
 
   public shared query {caller} func c9() : async Nat {
-      caller.size();
+      (Prim.blobOfPrincipal caller).size();
   };
 
   public shared query {caller} func c10() : async ?Word8 {
-      caller.bytes().next();
+      (Prim.blobOfPrincipal caller).bytes().next();
   };
 
 };

test/run/caller.mo

@@ -1,16 +1,16 @@
 import Prim "mo:prim";
 actor a {
 
-  public shared { caller = c } func getCaller() : async Blob {
+  public shared { caller = c } func getCaller() : async Principal {
     return c;
   };
 
   public shared query { caller = c } func getCallerHash() : async Word32 {
-    Prim.hashBlob c;
+    Prim.hashBlob (Prim.blobOfPrincipal c);
   };
 
   public shared query { caller = c } func getCallerSize() : async Nat {
-      c.size();
+      (Prim.blobOfPrincipal c).size();
   };
 
   public shared {caller} func c () : async () {

test/run/multi-caller.mo

@@ -3,12 +3,12 @@
 actor a {
 
   // returns caller id
-  public shared { caller = c } func getCaller()  : async Blob {
+  public shared { caller = c } func getCaller() : async Principal {
     c
   };
 
   // returns self id when called (internally or externally)
-  public shared func getSelf()  : async Blob {
+  public shared func getSelf()  : async Principal {
     await getCaller();
   };
 
@@ -18,12 +18,12 @@ actor a {
 actor class C () {
 
   // returns caller id
-  public shared { caller = c } func getCaller()  : async Blob {
+  public shared { caller = c } func getCaller()  : async Principal {
     c
   };
 
   // returns self id when called (internally or externally)
-  public shared func getSelf()  : async Blob {
+  public shared func getSelf()  : async Principal {
     await getCaller();
   };
 
@@ -51,12 +51,12 @@ ignore async {
 actor Ping {
 
   // returns caller id
-  public shared { caller = c } func getCaller()  : async Blob {
+  public shared { caller = c } func getCaller()  : async Principal {
     c
   };
 
   // returns self id when called (internally or externally)
-  public func getSelf() : async Blob {
+  public func getSelf() : async Principal {
     await getCaller();
   };
 
@@ -71,12 +71,12 @@ actor Ping {
 actor Pong {
 
   // returns caller id
-  public shared { caller = c } func getCaller()  : async Blob {
+  public shared { caller = c } func getCaller()  : async Principal {
     c
   };
 
   // returns self id when called (internally or externally)
-  public func getSelf()  : async Blob {
+  public func getSelf()  : async Principal {
     await getCaller();
   };