summaryrefslogtreecommitdiff
path: root/src/interface/bcrypt.ur
diff options
context:
space:
mode:
Diffstat (limited to 'src/interface/bcrypt.ur')
-rw-r--r--src/interface/bcrypt.ur127
1 files changed, 127 insertions, 0 deletions
diff --git a/src/interface/bcrypt.ur b/src/interface/bcrypt.ur
new file mode 100644
index 0000000..fd48c12
--- /dev/null
+++ b/src/interface/bcrypt.ur
@@ -0,0 +1,127 @@
+(* bcrypt.ur -- high-level FFI to the bcrypt library
+Copyright (C) 2013 Benjamin Barenblat <benjamin@barenblat.name>
+
+This library is free software: you can redistribute it and/or modify it under
+the terms of the GNU Affero General Public License as published by the Free
+Software Foundation, either version 3 of the License, or (at your option) any
+later version.
+
+This library is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+details.
+
+You should have received a copy of the GNU Affero General Public License along
+with this library. If not, see <http://www.gnu.org/licenses/>. *)
+
+
+(********************************** Utility **********************************)
+
+(* Value-level identity *)
+fun id [t ::: Type] (x : t) : t = x
+
+(* Converts a boolean to an option. Useful for chaining a bunch of boolean
+assertions into the option monad. *)
+fun assert (cond : bool) : option unit = if cond then Some () else None
+
+
+(*** String processing functions ***)
+
+(* Removes the first 'n' characters from 's' *)
+fun drop (n : int) (s : string) : string =
+ String.substring s { Start = n, Len = String.length s - n }
+
+(* Extracts the last 'n' characters from 's' *)
+fun takeLast (n : int) (s : string) : string =
+ String.substring s { Start = String.length s - n, Len = n }
+
+(* Removes the last 'n' characters from 's' *)
+fun dropLast (n : int) (s : string) : string =
+ String.substring s { Start = 0, Len = String.length s - n }
+
+(* A predicate on characters matching [./A-Za-z0-9], the set of characters used
+in bcrypt's weird base64 representation. *)
+fun isValidHashCharacter (c : char) : bool =
+ Char.isAlnum c || c = #"." || c = #"/"
+
+
+(******************************** The setting ********************************)
+
+structure Setting = struct
+ (* I use smart constructors (primarily 'read') to ensure that this is
+ always a valid bcrypt setting. *)
+ type t = string
+
+ val eq_t = eq_string
+
+ val show_t = mkShow id
+
+ fun ofString (s : string) : option t =
+ (* Ah, what I'd give for a regular expression engine that can simply
+ recognize /\$2[axy]?\$[0-9]{2}\$[./A-Za-z0-9]{22}/! Alas, that is a
+ task for another adventurer. *)
+ assert (String.lengthGe s 28);
+ (* Rip off the $2 or $2a (or $2y or $2n) at the start. *)
+ assert (String.sub s 0 = #"$");
+ assert (String.sub s 1 = #"2");
+ withIdStripped <-
+ (let val classIdentifier = String.sub s 2 in
+ if classIdentifier = #"a"
+ || classIdentifier = #"y"
+ || classIdentifier = #"n"
+ then Some (drop 3 s)
+ else if classIdentifier = #"$"
+ then Some (drop 2 s)
+ else None
+ end);
+ (* Check for a valid number of rounds. *)
+ assert (String.sub withIdStripped 0 = #"$");
+ assert (Char.isDigit (String.sub withIdStripped 1));
+ assert (Char.isDigit (String.sub withIdStripped 2));
+ assert (String.sub withIdStripped 3 = #"$");
+ (* Check the salt's base64 representation. *)
+ let val salt = drop 4 withIdStripped in
+ assert (String.length salt = 22);
+ assert (String.all isValidHashCharacter salt);
+ return s
+ end
+
+ fun ofStringError (s : string) : t =
+ Option.get (error <xml>{[s]} is an invalid bcrypt setting</xml>)
+ (ofString s)
+
+ val read_t = mkRead ofStringError ofString
+
+ val sql_t = sql_prim
+
+ val random = BcryptFfi.randomSetting
+end
+
+
+(******************************* The algorithm *******************************)
+
+type hashedString = string
+
+val eq_hashedString = eq_string
+
+val show_hashedString = mkShow id
+
+fun setting (s : hashedString) = dropLast 31 s
+
+fun ofString (s : string) : option hashedString =
+ (* Once again, a regular expression library would be nice. In the
+ meantime, the last 31 characters must be the hash, and the others must be
+ the setting. *)
+ assert (String.lengthGe s 59);
+ assert (String.all isValidHashCharacter (takeLast 31 s));
+ Monad.ignore (@read Setting.read_t (setting s));
+ return s
+
+fun ofStringError (s : string) : hashedString =
+ Option.get (error <xml>{[s]} is an invalid bcrypt hash</xml>) (ofString s)
+
+val read_hashedString = mkRead ofStringError ofString
+
+val sql_hashedString = sql_prim
+
+val crypt setting password = BcryptFfi.crypt (show setting) password