3 files changed, 56 insertions(+), 33 deletions(-)

M bin/cgi.ml
M lib/calc.ml
M test/calc_test.ml

@@ 23,19 23,6 @@ let globe = "🌐"
 open Lib
 open Lib.Cgi
 
-let handle_query_string qs =
-  let prec =
-    (* rough estimate: digits ~ length - q= and  3 separators
-     * bits = digits * ln(10)/ln(2)
-     * geohash has 5 bit per char, *)
-    float ((qs |> String.length) - 5) *. 3.3219 /. 5.
-    |> ceil |> truncate
-    (* but no less than 2 and no more than 12 *)
-    |> max 2
-    |> min 12
-  in
-  Result.bind (qs |> Route.coord_from_qs) (prec |> Lib.Calc.encode)
-
 let handle_hash req =
   match req.path_info |> String.split_on_char '/' with
   | [ ""; hash ] -> (


@@ 82,11 69,25 @@ let handle req =
       | "/" -> (
           match req.query_string with
           | "" -> uri ^ mercator_birth |> redirect
-          | s -> (
-              match s |> handle_query_string with
-              | Ok hash -> hash |> redirect
-              | Error (`NoMatch (_, _)) ->
-                  error 406 "Cannot parse query string."
-              | Error _ -> error 406 "Cannot encode coords."))
+          | qs -> (
+              match qs |> Route.coord_from_qs with
+              | Error (`NoMatch (_, s')) ->
+                  error 406 ("Cannot encode coords: '" ^ s' ^ "'")
+              | Error (`ConverterFailure _) -> error 406 "Cannot encode coords."
+              | Ok co -> (
+                  (* actually logic :-( *)
+                  let prec =
+                    (* rough estimate: digits ~ length - q= and  3 separators
+                     * bits = digits * ln(10)/ln(2)
+                     * geohash has 5 bit per char, *)
+                    float ((qs |> String.length) - 5) *. 3.3219 /. 5.
+                    |> ceil |> truncate
+                    (* but no less than 2 and no more than 12 *)
+                    |> max 2
+                    |> min 12
+                  in
+                  match co |> Lib.Calc.encode prec with
+                  | Error _ -> error 406 "Cannot encode coords."
+                  | Ok hash -> hash |> redirect)))
       | _ -> handle_hash req)
   | _ -> error 405 "Method Not Allowed"

@@ 83,20 83,26 @@ let base32_encode chars x =
   chars |> Bytes.create |> f (chars - 1) x |> Bytes.to_string
 
 let base32_decode hash =
-  let len = String.length hash in
-  let rec f idx x =
-    match len - idx with
-    | 0 -> Ok x
-    | _ ->
-        Result.bind
-          (hash.[idx] |> Iter.P.b32_int_of_char)
-          (fun v -> v |> of_int |> logor (shift_left x 5) |> f (idx + 1))
-  in
-  f 0 zero
+  let len = hash |> String.length in
+  match len <= 12 with
+  | false -> Error '_'
+  | true ->
+      let rec f idx x =
+        match len - idx with
+        | 0 -> Ok x
+        | _ ->
+            Result.bind
+              (hash.[idx] |> Iter.P.b32_int_of_char)
+              (fun v -> v |> of_int |> logor (shift_left x 5) |> f (idx + 1))
+      in
+      f 0 zero
 
 let encode chars wgs84 =
-  let h60 = wgs84 |> quantize30 |> interleave in
-  Ok (shift_right h60 (60 - (5 * chars)) |> base32_encode chars)
+  match 0 <= chars && chars <= 12 with
+  | false -> Error chars
+  | true ->
+      let h60 = wgs84 |> quantize30 |> interleave in
+      Ok (shift_right h60 (60 - (5 * chars)) |> base32_encode chars)
 
 let error_with_precision bits =
   let latBits = bits / 2 in

@@ 24,6 24,15 @@ open Lib.Calc
 let assert_equals_int64 (test_name : string) (expected : t) (result : t) : 'a =
   Assert.assert_equals test_name to_string expected result
 
+let test_len () =
+  assert ("zzzzzzzzzzzZ" < "zzzzzzzzzzzz");
+  assert ("zzzzzzzzzzzz" < "zzzzzzzzzzzz ");
+  assert ("zzzzzzzzzzzz" < "zzzzzzzzzzzz1");
+  assert ("zzzzzzzzzzzz" > "u28brs0s00040");
+  assert ("z" > "aa");
+  assert ("a" < "b");
+  assert (12 < ("u28brs0s00040" |> String.length))
+
 (*
 
 let test_spread () =


@@ 129,14 138,21 @@ let test_decode_sunshine () =
   t 20 "u28brs0s0004"
     ((47.879105, 12.634964), (8.38190317154e-08, 1.67638063431e-07))
 
+let test_decode_fail () =
+  assert ("u28brs0s00040" |> decode = Error '_');
+  assert ("u28brs0s00041" |> decode = Error '_');
+  assert ("_" |> decode = Error '_')
+
 let () =
+  test_len ();
   (* test_spread ();
               test_interleave ();
            test_deinterleave ();
         test_quantize ();
      test_base32_decode ();
      test_base32_encode ();
-     test_quantize ();
   *)
+  test_quantize ();
   test_encode_a ();
-  test_decode_sunshine ()
+  test_decode_sunshine ();
+  test_decode_fail ()