balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Base58: use option values instead of raising

Browse Source
This commit is contained in:
Vincent Bernardoff 2018-01-04 17:11:13 +01:00 committed by Benjamin Canou
parent 2d349b606f
commit 2d00e5a2f8
2 changed files with 58 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
lib_crypto/base58.ml
View File

@ -70,8 +70,9 @@ let count_leading_char s c =
let of_char ?(alphabet=Alphabet.default) x = let of_char ?(alphabet=Alphabet.default) x =
let pos = String.get alphabet.decode (int_of_char x) in let pos = String.get alphabet.decode (int_of_char x) in
if pos = '\255' then Pervasives.failwith "Invalid data" ; match pos with
int_of_char pos | '\255' -> None
| _ -> Some (int_of_char pos)
let to_char ?(alphabet=Alphabet.default) x = let to_char ?(alphabet=Alphabet.default) x =
alphabet.encode.[x] alphabet.encode.[x]
@ -95,20 +96,19 @@ let raw_encode ?(alphabet=Alphabet.default) s =
String.make zeros zero ^ res String.make zeros zero ^ res
let raw_decode ?(alphabet=Alphabet.default) s = let raw_decode ?(alphabet=Alphabet.default) s =
let zero = alphabet.encode.[0] in TzString.fold_left begin fun a c ->
let zeros = count_leading_char s zero in match a, of_char ~alphabet c with
let len = String.length s in | Some a, Some i -> Some Z.(add (of_int i) (mul a zbase))
let rec loop res i = | _ -> None
if i = len then res else end (Some Z.zero) s |>
let x = Z.of_int (of_char ~alphabet (String.get s i)) in Option.map ~f:begin fun res ->
let res = Z.(add x (mul res zbase)) in let res = Z.to_bits res in
loop res (i+1) let res_tzeros = count_trailing_char res '\000' in
in let len = String.length res - res_tzeros in
let res = Z.to_bits @@ loop Z.zero zeros in let zeros = count_leading_char s alphabet.encode.[0] in
let res_tzeros = count_trailing_char res '\000' in String.make zeros '\000' ^
let len = String.length res - res_tzeros in String.init len (fun i -> String.get res (len - i - 1))
String.make zeros '\000' ^ end
String.init len (fun i -> String.get res (len - i - 1))
let checksum s = let checksum s =
let hash = let hash =
@ -124,13 +124,13 @@ let safe_encode ?alphabet s =
raw_encode ?alphabet (s ^ checksum s) raw_encode ?alphabet (s ^ checksum s)
let safe_decode ?alphabet s = let safe_decode ?alphabet s =
let s = raw_decode ?alphabet s in raw_decode ?alphabet s |> Option.apply ~f:begin fun s ->
let len = String.length s in let len = String.length s in
let msg = String.sub s 0 (len-4) let msg = String.sub s 0 (len-4) in
and msg_hash = String.sub s (len-4) 4 in let msg_hash = String.sub s (len-4) 4 in
if msg_hash <> checksum msg then if msg_hash <> checksum msg then None
invalid_arg "safe_decode" ; else Some msg
msg end
type data = .. type data = ..
@ -146,7 +146,7 @@ type 'a encoding = {
let simple_decode ?alphabet { prefix ; of_raw ; _ } s = let simple_decode ?alphabet { prefix ; of_raw ; _ } s =
safe_decode ?alphabet s |> safe_decode ?alphabet s |>
TzString.remove_prefix ~prefix |> Option.apply ~f:(TzString.remove_prefix ~prefix) |>
Option.apply ~f:of_raw Option.apply ~f:of_raw
let simple_encode ?alphabet { prefix ; to_raw ; _ } d = let simple_encode ?alphabet { prefix ; to_raw ; _ } d =
@ -209,17 +209,14 @@ module MakeEncodings(E: sig
l p enc.encoded_length l p enc.encoded_length
let decode ?alphabet s = let decode ?alphabet s =
try let rec find s = function
let rec find s = function | [] -> None
| [] -> None | Encoding { prefix ; of_raw ; wrap ; _ } :: encodings ->
| Encoding { prefix ; of_raw ; wrap ; _ } :: encodings -> match TzString.remove_prefix ~prefix s with
match TzString.remove_prefix ~prefix s with | None -> find s encodings
| None -> find s encodings | Some msg -> of_raw msg |> Option.map ~f:wrap in
| Some msg -> of_raw msg |> Option.map ~f:wrap in safe_decode ?alphabet s |>
let s = safe_decode ?alphabet s in Option.apply ~f:(fun s -> find s !encodings)
find s !encodings
with Invalid_argument _ -> None
end end
@ -247,8 +244,11 @@ module MakeResolvers(R: sig
let n = String.length request in let n = String.length request in
let min = raw_decode ~alphabet (request ^ String.make (len - n) zero) in let min = raw_decode ~alphabet (request ^ String.make (len - n) zero) in
let max = raw_decode ~alphabet (request ^ String.make (len - n) last) in let max = raw_decode ~alphabet (request ^ String.make (len - n) last) in
let prefix_len = TzString.common_prefix min max in match min, max with
String.sub min 0 prefix_len | Some min, Some max ->
let prefix_len = TzString.common_prefix min max in
Some (String.sub min 0 prefix_len)
| _ -> None
let complete ?alphabet context request = let complete ?alphabet context request =
let rec find s = function let rec find s = function
@ -257,23 +257,24 @@ module MakeResolvers(R: sig
if not (TzString.has_prefix ~prefix:encoding.encoded_prefix s) then if not (TzString.has_prefix ~prefix:encoding.encoded_prefix s) then
find s resolvers find s resolvers
else else
let prefix = match partial_decode ?alphabet request encoding.encoded_length with
partial_decode ?alphabet request encoding.encoded_length in | None -> find s resolvers
let len = String.length prefix in | Some prefix ->
let ignored = String.length encoding.prefix in let len = String.length prefix in
let msg = let ignored = String.length encoding.prefix in
if len <= ignored then "" let msg =
else begin if len <= ignored then ""
assert (String.sub prefix 0 ignored = encoding.prefix) ; else begin
String.sub prefix ignored (len - ignored) assert (String.sub prefix 0 ignored = encoding.prefix) ;
end in String.sub prefix ignored (len - ignored)
resolver context msg >|= fun msgs -> end in
TzList.filter_map resolver context msg >|= fun msgs ->
(fun msg -> TzList.filter_map
let res = simple_encode encoding ?alphabet msg in (fun msg ->
TzString.remove_prefix ~prefix:request res |> let res = simple_encode encoding ?alphabet msg in
Option.map ~f:(fun _ -> res)) TzString.remove_prefix ~prefix:request res |>
msgs in Option.map ~f:(fun _ -> res))
msgs in
find request !resolvers find request !resolvers
end end

6
lib_crypto/base58.mli
View File

@ -120,13 +120,13 @@ end
(** Base58Check-encoding/decoding functions (with error detections). *) (** Base58Check-encoding/decoding functions (with error detections). *)
val safe_encode: ?alphabet:Alphabet.t -> string -> string val safe_encode: ?alphabet:Alphabet.t -> string -> string
val safe_decode: ?alphabet:Alphabet.t -> string -> string val safe_decode: ?alphabet:Alphabet.t -> string -> string option
(** Base58-encoding/decoding functions (without error detections). *) (** Base58-encoding/decoding functions (without error detections). *)
val raw_encode: ?alphabet:Alphabet.t -> string -> string val raw_encode: ?alphabet:Alphabet.t -> string -> string
val raw_decode: ?alphabet:Alphabet.t -> string -> string val raw_decode: ?alphabet:Alphabet.t -> string -> string option
(**/**) (**/**)
val partial_decode: ?alphabet:Alphabet.t -> string -> int -> string val partial_decode: ?alphabet:Alphabet.t -> string -> int -> string option
val make_encoded_prefix: string -> int -> string * int val make_encoded_prefix: string -> int -> string * int