Basic ChatGPT support

urweb · May 12, 2023 · 8c71540 · 8c71540
1 parent d71cfa8
commit 8c71540
Show file tree

Hide file tree

Showing 6 changed files with 157 additions and 0 deletions.
diff --git a/examples/chatgptDemo.ur b/examples/chatgptDemo.ur
@@ -0,0 +1,28 @@
+(* For this demo, it's necessary to create chatgptSecrets.ur,
+ * defining [api_token]. *)
+structure C = Chatgpt.Make(Chatgpt.TwoLegged(ChatgptSecrets))
+
+fun chat log =
+    C.Chat.completions {Model = readError "gpt-3.5-turbo",
+                        Messages = log}
+
+fun main () =
+    log <- source [];
+    prompt <- source "";
+    return <xml><body>
+      <ul>
+        <dyn signal={log <- signal log;
+                     return (List.mapX (fn msg =>
+                                           <xml><li><b>{[msg.Role]}:</b> {[msg.Content]}</li></xml>) log)}/>
+      </ul>
+      <ctextbox source={prompt}/>
+      <button value="Chat" onclick={fn _ => pr <- get prompt;
+                                       log' <- get log;
+                                       log' <- return (List.append log' ({Role = Chatgpt.User,
+                                                                          Content = pr} :: []));
+                                       resp <- rpc (chat log');
+                                       log' <- return (List.append log' ({Role = Chatgpt.Assistant,
+                                                                          Content = resp} :: []));
+                                       set log log';
+                                       set prompt ""}/>
+    </body></xml>
diff --git a/examples/chatgptDemo.urp b/examples/chatgptDemo.urp
@@ -0,0 +1,10 @@
+library ../src/ur
+rewrite all ChatgptDemo/*
+database dbname=chatgptDemo
+sql chatgptDemo.sql
+safeGetDefault
+allow url https://*
+prefix http://localhost:8080/
+
+chatgptSecrets
+chatgptDemo
diff --git a/examples/chatgptDemo.urs b/examples/chatgptDemo.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/src/ur/chatgpt.ur b/src/ur/chatgpt.ur
@@ -0,0 +1,88 @@
+open Json
+open Urls
+
+functor TwoLegged(M : sig
+                        val api_token : string
+                    end) = struct
+    open M
+
+    val token = return (Some api_token)
+end
+
+datatype role = System | User | Assistant
+type role' = variant [System = unit, User = unit, Assistant = unit]
+
+val read_role = mkRead' (fn s =>
+                            case s of
+                                "system" => Some System
+                              | "user" => Some User
+                              | "assistant" => Some Assistant
+                              | _ => None)
+                        "role"
+
+val show_role = mkShow (fn x =>
+                           case x of
+                               System => "system"
+                             | User => "user"
+                             | Assistant => "assistant")
+
+val json_role : json role = @json_derived readError show _
+
+
+type message = {
+     Role : role,
+     Content : string
+}
+val _ : json message = json_record
+                           {Role = "role",
+                            Content = "content"}
+
+type choice = {
+     Message : message
+}
+val _ : json choice = json_record
+                      {Message = "message"}
+
+type response = {
+    Choices : list choice
+}
+val _ : json response = json_record
+                            {Choices = "choices"}
+
+type model = string
+val read_model = _
+val show_model = _
+
+type completions_arg = {
+     Model : model,
+     Messages : list {Role : role,
+                      Content : string}
+}
+val _ : json completions_arg = json_record
+                                   {Model = "model",
+                                    Messages = "messages"}
+
+functor Make(M : sig
+                 val token : transaction (option string)
+             end) = struct
+    val token =
+        tok <- M.token;
+        case tok of
+            Some tok => return tok
+          | None => error <xml>How odd: no ChatGPT token!</xml>
+
+    val urlPrefix = "https://api.openai.com/v1/"
+
+    fun api url body =
+        debug (url ^ ": " ^ body);
+        tok <- token;
+        WorldFfi.post (bless (urlPrefix ^ url)) (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) (Some "application/json") body
+
+    structure Chat = struct
+        fun completions arg =
+            r <- api "chat/completions" (toJson arg);
+            case (fromJson r : response).Choices of
+                choice :: [] => return choice.Message.Content
+              | _ => error <xml>Unexpected number of choices in ChatGPT response</xml>
+    end
+end
diff --git a/src/ur/chatgpt.urs b/src/ur/chatgpt.urs
@@ -0,0 +1,29 @@
+functor TwoLegged(M : sig
+                        val api_token : string
+                    end) : sig
+    val token : transaction (option string)
+end
+
+(** * API records *)
+
+(* LLM models supported by ChatGPT *)
+type model
+val read_model : read model
+val show_model : show model
+
+datatype role = System | User | Assistant
+val read_role : read role
+val show_role : show role
+
+(** * Now for the actual methods.... *)
+
+functor Make(M : sig
+                 val token : transaction (option string)
+             end) : sig
+    structure Chat : sig
+        val completions : {Model : model,
+                           Messages : list {Role : role,
+                                            Content : string}}
+                          -> transaction string
+    end
+end
diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -29,3 +29,4 @@ zoom
 openIdConnect
 zenefits
 netSuite
+chatgpt