diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor
index 5aab808763..b81edbd2bb 100644
--- a/basis/furnace/auth/auth-docs.factor
+++ b/basis/furnace/auth/auth-docs.factor
@@ -121,6 +121,7 @@ $nl
     "furnace.auth.providers.null"
     "furnace.auth.providers.assoc"
     "furnace.auth.providers.db"
+    "furnace.auth.providers.couchdb"
 } ;
 
 ARTICLE: "furnace.auth.features" "Optional authentication features"
diff --git a/basis/furnace/auth/providers/couchdb/couchdb-docs.factor b/basis/furnace/auth/providers/couchdb/couchdb-docs.factor
new file mode 100644
index 0000000000..be184d6af0
--- /dev/null
+++ b/basis/furnace/auth/providers/couchdb/couchdb-docs.factor
@@ -0,0 +1,40 @@
+USING: help.syntax help.markup help.vocabs furnace.auth.providers ;
+IN: furnace.auth.providers.couchdb
+
+HELP: couchdb-auth-provider
+{
+    $class-description "Implements the furnace authentication protocol for CouchDB."
+    { $table
+      { { $slot "base-url" } { "The base URL for the CouchDB database, e.g. http://foo.org:5984/mydatabase" } }
+      { { $slot "username-view" } { "A URL for a view which emits usernames as keys and user documents as values, "
+                                    "i.e. something like emit(doc.username, doc). The URL should be relative"
+                                    " to base-url (e.g. \"_design/my_views/_view/by_username\")."
+                                    " The view is not defined automatically by the library." } }
+      { { $slot "prefix" } { "In order to ensure the uniqueness of user IDs and email addresses,"
+                             " the library creates documents in the database with ids corresponding to these values. "
+                             "These ids "
+                             "are prefixed by the string given as the value for this slot. Ideally, you should guarantee that no other "
+                             "documents in the database can have ids with this prefix. However, "
+                             "the worst that can happen is for someone to falsely be told that a username "
+                             "is taken when it is in fact free." } }
+      { { $slot "field-map" } { "An assoc taking " { $link user } " slot names to CouchDB document "
+                                "field names. It is not usually necessary to set this slot - it is useful only if "
+                                "you do not wish to use the default field names." } }
+  }
+} ;
+
+ARTICLE: "furnace.auth.providers.couchdb" "CouchDB Authentication Provider"
+    { $nl } "The " { $vocab-link "furnace.auth.providers.couchdb" } " vocabulary implements an authentication provider "
+    "which looks up authentication requests in a CouchDB. It is necessary to create a view "
+    "associating usernames with user documents before using this vocabulary; see documentation "
+    "for " { $link couchdb-auth-provider } "."
+    { $nl }
+    "Although this implementation guarantees that users with duplicate IDs/emails"
+    " cannot be created in a single CouchDB database, it provides so such guarentee if you are clustering "
+    "multiple DBs. In this case, you are responsible for ensuring the uniqueness of users across "
+    "databases."
+    { $nl }
+    "Password hashes are base64 encoded."
+ ;
+
+ABOUT: "furnace.auth.providers.couchdb"
\ No newline at end of file
diff --git a/basis/furnace/auth/providers/couchdb/couchdb.factor b/basis/furnace/auth/providers/couchdb/couchdb.factor
new file mode 100644
index 0000000000..08c52c7527
--- /dev/null
+++ b/basis/furnace/auth/providers/couchdb/couchdb.factor
@@ -0,0 +1,228 @@
+USING: accessors assocs couchdb furnace.auth.providers
+json.writer kernel mirrors sequences urls urls.encoding
+arrays furnace.auth byte-arrays combinators.short-circuit
+strings continuations combinators base64 make
+locals namespaces ;
+IN: furnace.auth.providers.couchdb
+
+! !!! Implement the authentication protocol for CouchDB.
+! !!!
+! !!! 'user' tuples are copied verbatim into the DB as objects.
+! !!! Special 'reservation' records are inserted into the DB to
+! !!! reserve usernames and email addresses. These reservation records
+! !!! all have ids with the prefix given to couchdb-auth-provider.
+! !!! A reservation in the email domain for the email address "foo@bar.com"
+! !!! would have id "PREFIXemail!foo%40bar.com". Both the domain name
+! !!! and the value are url-encoded, to ensure that the use of '!' as
+! !!! a separator guarantees a unique ID for any given (domain,value)
+! !!! pairing.
+! !!!
+! !!! It would be nice to use CouchDB attachments to avoid junking the
+! !!! global namespace like this. However, attachments in CouchDB
+! !!! inherit their revision ids from their parent document, which would
+! !!! make various operations on users unnecessairly non-independent
+! !!! of each other.
+! !!!
+! !!! On the basic technique used here, see:
+! !!!
+! !!! http://kfalck.net/2009/06/29/enforcing-unique-usernames-on-couchdb
+! !!!
+
+! Many of the words below assume that this symbol is bound to an
+! appropriate instance.
+TUPLE: couchdb-auth-provider
+    base-url
+    { username-view string }
+    { prefix string initial: "user_reservation_" }
+    { field-map assoc initial: { } } ;
+
+<PRIVATE
+
+! >json does weird things for mirrors, so we copy the mirror into
+! a real hashtable before serializing it.
+: hash-mirror ( obj -- hash )
+    make-mirror H{ } assoc-like ;
+
+: is-couchdb-conflict-error? ( error -- ? )
+    { [ couchdb-error? ] [ data>> "error" swap at "conflict" = ] } 1&& ;
+: is-couchdb-not-found-error? ( error -- ? )
+    { [ couchdb-error? ] [ data>> "error" swap at "not_found" = ] } 1&& ;
+
+: get-url ( url -- url' )
+    couchdb-auth-provider get
+    base-url>> >url swap >url derive-url ;
+
+: reservation-id ( value name -- id )
+    couchdb-auth-provider get
+    prefix>> [ % url-encode-full % "!" % url-encode-full % ] "" make ;
+
+: (reserve) ( value name -- id/f )
+    reservation-id
+    get-url
+    [
+        H{ } clone >json swap couch-put
+    ] [
+        nip dup is-couchdb-conflict-error? [ drop f ] [ rethrow ] if
+    ] recover ;
+
+! Don't reserve false values (e.g. if the email field is f, don't reserve f,
+! or the first user who registers without an email address will block all
+! others who wish to do so).
+: reserve ( value name -- id/f )
+    over [ (reserve) ] [ 2drop t ] if ;
+
+: unreserve ( couch-rval -- )
+    [ "id" swap at get-url ]
+    [ "rev" swap at "rev" set-query-param ]
+    bi
+    couch-delete drop ;
+
+: unreserve-from-id ( id -- )
+    [
+        get-url dup couch-get
+        "_rev" swap at "rev" set-query-param
+        couch-delete drop
+    ] [
+        dup is-couchdb-not-found-error? [ 2drop ] [ rethrow ] if
+    ] recover ;
+
+:: (reserve-multiple) ( hash keys made -- ? )
+    keys empty? [ t ] [
+        keys first hash at keys first reserve [
+            made push
+            hash keys rest-slice made (reserve-multiple)
+        ] [
+            ! Delete reservations that were already successfully made.
+            made [ unreserve ] each
+            f
+        ] if*
+    ] if ;
+
+! Try to reserve all of the given name/value pairs; if not all reservations
+! can be made, delete those that were made.
+: reserve-multiple ( hash -- ? )
+    dup keys V{ } clone (reserve-multiple) ;
+
+: change-at* ( key assoc quot -- assoc )
+    over [ change-at ] dip ; inline
+
+! Should be given a view URL.
+: ((get-user)) ( couchdb-url -- user/f )
+    couch-get
+    "rows" swap at dup empty? [ drop f ] [ first "value" swap at ] if ;
+
+: (get-user) ( username -- user/f )
+    couchdb-auth-provider get
+    username-view>> get-url
+    swap >json "key" set-query-param
+    ((get-user)) ;
+    
+: strip-hash ( hash1 -- hash2 )
+    [ drop first CHAR: _ = not ] assoc-filter ;
+
+: at-or-k ( key hash -- newkey )
+    dupd at [ nip ] when* ;
+: value-at-or-k ( key hash -- newkey )
+    dupd value-at [ nip ] when* ;
+
+: map-fields-forward ( assoc field-map -- assoc )
+    [ swapd at-or-k swap ] curry assoc-map ;
+
+: map-fields-backward ( assoc field-map -- assoc )
+    [ swapd value-at-or-k swap ] curry assoc-map ;
+
+: user-hash>user ( hash -- user )
+    couchdb-auth-provider get field-map>> map-fields-backward
+    [ "password" swap [ base64> >byte-array ] change-at ]
+    [
+        strip-hash
+        user new dup [ make-mirror swap assoc-union! drop ] dip
+        f >>changed?
+    ]
+    bi ;
+
+: user>user-hash ( user -- hash )
+     hash-mirror
+     [ [ "password" ] dip [ >base64 >string ] change-at ] keep
+     couchdb-auth-provider get field-map>> map-fields-forward ;
+
+! Used when the user is guaranteed to exist if the logic of the Factor
+! code is correct (e.g. when update-user is called).
+! In the unlikely event that the user does not exist, an error is thrown.
+: (get-user)/throw-on-no-user ( username -- user/f )
+    (get-user) [ ] [ "User not found" throw ] if* ;
+
+: (new-user) ( user -- user/f )
+    dup
+    [
+        [ username>> "username" set ]
+        [ email>> "email" set ]
+        bi
+    ] H{ } make-assoc
+    reserve-multiple
+    [
+        user>user-hash >json
+        "" get-url
+        couch-post
+    ] [
+        drop f
+    ] if ;
+
+: unify-users ( old new -- new )
+    swap
+    [ "_rev" swap at "_rev" rot set-at ]
+    [ "_id" swap at "_id" rot set-at ]
+    [ swap assoc-union ]
+    2tri ;
+
+! If the user has changed username or email address,
+! we should let other registrants use the old ones,
+! and make sure that the new ones are reserved.
+! (This word is called by the 'update-user' method.)
+: check-update ( old new -- ? )
+    [
+        2dup [ "email" swap at ] bi@ = not [
+            [ "email" swap at ] bi@
+            [ drop "email" reservation-id unreserve-from-id ]
+            [ nip "email" reserve ]
+            2bi
+        ] [ 2drop t ] if
+    ] [
+        2dup [ "username" swap at ] bi@ = not [
+            [ "username" swap at ] bi@
+            [ drop "username" reservation-id unreserve-from-id ]
+            [ nip "username" reserve ]
+            2bi
+        ] [ 2drop t ] if
+    ] 2bi and ;
+
+PRIVATE>
+
+: <couchdb-auth-provider> ( base-url username-view -- couchdb-auth-provider )
+    couchdb-auth-provider new swap >>username-view swap >>base-url ;
+
+M: couchdb-auth-provider get-user ( username provider -- user/f )
+    [
+        couchdb-auth-provider set
+        (get-user) [ user-hash>user ] [ f ] if*
+    ] with-scope ;
+
+M: couchdb-auth-provider new-user ( user provider -- user/f )
+    [
+        couchdb-auth-provider set
+        dup (new-user) [
+            username>> couchdb-auth-provider get get-user
+        ] [ drop f ] if
+    ] with-scope ;
+
+M: couchdb-auth-provider update-user ( user provider -- )
+    [
+        couchdb-auth-provider set
+        [ username>> (get-user)/throw-on-no-user dup ]
+        [ drop "_id" swap at get-url ]
+        [ user>user-hash swapd
+          2dup check-update drop
+          unify-users >json swap couch-put drop
+        ]
+        tri
+    ] with-scope ;