From c54c7e3541d548f0d1f206277e9cf04baff07051 Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <benjamin@barenblat.name>
Date: Fri, 28 Jun 2013 18:25:45 -0700
Subject: Initial commit

---
 src/interface/bcrypt.ur | 127 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 127 insertions(+)
 create mode 100644 src/interface/bcrypt.ur

(limited to 'src/interface/bcrypt.ur')

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
-- 
cgit v1.2.3