Using user authentication with CouchDB and couchdb-conduit

I've started getting back into working on my Sekrit Haskell Application, for which I plan on using a CouchDB back-end.

This left me with a choice between couchdb-conduit and CoucbDB. I went with couchdb-conduit for a couple of reasons.

A large part of it was simply that conduit is a well-supported, fairly well-documented base for building this sort of higher-level library. The other part was that the older CouchDB library was using the json library, and I wanted to use aeson.

(I freely concede that some of this is about libraries that are mindshare-winners, rather than necessarily the best from a technical standpoint; I recognize that pipes may have a better theoretical foundation than counduit, and I don't have a clear idea which is more sophisticated between json and aeson.)

Anyway, I found myself having to contribute a couple of fixes to couchdb-conduit to bring it up to date with the 1.0 release of conduit. And then yesterday, I noticed that it wasn't setting up per-user authentication properly. But at this point, I believe that things are set up to work.

So, just for reference, here's the code I wrote to actually do something. I can create a database, named for the user, with authentication open to just that user, with the passed in password:

data UserCredentials = UserCredentials {
    credentialEmail :: ByteString, -- ^The email address of the new user
    credentialPassword :: ByteString  -- ^The password for the new user
} deriving (Show)

connection :: CouchConnection
connection = def {couchLogin = "administrator", couchPass = "ThisIsn'tReallyThePassword"}

userDb :: ByteString -> ByteString
userDb = (intercalate "/") . reverse . splitWith (`elem` "@.")

authId :: ByteString -> ByteString
authId email = concat ["org.couchdb.user:", email]

authRecord :: AntilibrationCredentials -> Value
authRecord (AntilibrationCredentials email password) = object ["name" .= email, "roles" .= ([] :: [ByteString]), "type" .= ("user" :: ByteString), "password" .= password]

createUserDB :: UserCredentials -> IO ()
createUserDB credentials =
  runCouch connection $ do
    _ <- couchPut "_users" (authId $ credentialEmail credentials) "" [] (authRecord credentials)
    couchPutDB_ (userDb $ credentialEmail credentials)
    couchSecureDB (userDb $ credentialEmail credentials) [] [] [] [(credentialEmail credentials)]

It's taken me a while to feel comfortable enough with Haskell to get to where I could write this code, but now that it's done, I'm impressed with how straightforward it ends up being.