summaryrefslogblamecommitdiff
path: root/bin/leda.ml
blob: 4b863309f25725b0343670b4232cdd2b0c61c867 (plain) (tree)
1
2
3
4
5
6
7
8
9


                




                
                                               
 
                                                            
 
                                   
                                                                                  
 

                    

                                                                                            



                                                    

                      
                               
                                       
                







                                                                                        
                   
                                       
                         
                                
     
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.request, string) Base.Result.t = 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) -> I.string A.empty c
           | _ -> I.empty in
         let%lwt () = Term.image t (h <-> c) in
         let%lwt () = Term.refresh t in
         loop t
       | Error m ->
         let%lwt () = Term.release t in
         Lwt_io.printl m)
    | Error m -> Lwt_io.printl m
  end