open Base open Base.Result open Notty open Notty.Infix open Notty_lwt module M = Gemini.MimeTextGemini.MimeTextGemini let test_parse s = M.gemini_to_canon_str (M.str_to_gemini s) module T = Gemini.MimeType.MimeType module R = Gemini.GeminiTransaction.GeminiTransaction(T)(Gemini.TlsUtils.TlsUtils) let () = Lwt_main.run begin let%lwt () = Mirage_crypto_rng_lwt.initialize () in let request = R.make_request (Sys.get_argv()).(1) in let rec loop t = match%lwt Lwt_stream.next (Term.events t) with | `Key _ -> Lwt.return () | _ -> loop t in match request with | Ok request -> let t = Term.create () in (match%lwt R.session request with | Ok r -> let h = (I.string A.empty ("STATUS: " ^ (R.name_of_response r))) <-> (I.string A.empty ("STATUS LINE: " ^ (R.header_of_response r))) in let c = match r with | SUCCESS (_, c) | SUCCESS_EOCSS (_, c) -> (try let parsed = M.str_to_gemini c in List.fold parsed ~init:I.empty ~f:(fun acc -> fun l -> acc <-> (I.string A.empty (M.gemini_line_to_str l))) with | M.ParseError m -> I.string A.empty ("Failed to parse contents: " ^ m)) | _ -> I.empty in let _ = (fun _ -> ()) (h, c) in let%lwt () = Term.image t (h <-> c) in let%lwt () = Term.refresh t in loop t | Error R.TOO_MANY_REDIRECTS -> let%lwt () = Term.release t in Lwt_io.printl "Too many redirects" | Error (R.X_DOMAIN_REDIR _) -> let%lwt () = Term.release t in Lwt_io.printl ("Attempted to redirect across domains") | Error (UNKNOWN_RESPONSE s) -> let%lwt () = Term.release t in Lwt_io.printl ("Unknown response: " ^ s) | Error (MISC s) -> let%lwt () = Term.release t in Lwt_io.printl ("Error: " ^ s)) | Error m -> Lwt_io.printl m end