Writing a billing system in Haskell, using Stripe and Heroku

Proof that necessity is not the mother of invention.

Contents

*This post is written in literate Haskell, meaning the source can be turned into a blogpost or a working program. You can view the source.

Normally clients pay me with checks, but recently one informed me that they really really really like really really super prefer some kind of online payment form.

Fair enough. I want to accommodate them. So, this weekend I did the only logical thing: I wrote my own payment system. What, did you think I was going to use PayPal?

(Don't worry, Mom, I thought about PCI compliance and all that. Read more!)

For both ease and security I opted to use Stripe, a straightforward service which handles all the legal and regulatory concerns and provides developers with a nice API to build on top of. Here's how it works:

  1. On the actual billing page, I securely send Stripe the credit card details and a special, public token issued to me. I get back a transaction token instead of sensitive credit card information.

  2. Then, I send the amount and the transaction token up to my payment backend. The payment backend does whatever administrative work and validation it needs to before sending Stripe the transaction token, the amount, and a secret token only I know.

This is some James Bond shit.
This is some James Bond shit.

To counteract all this ease and security, I decided to write the payment backend in Haskell. I learned a lot about how Haskell web applications work and figure I'd detail some of that. Now, onward to the code!

0.1 The code

First, with any Haskell program complex enough to be useful, the first 30 lines or so are imports, viz:

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Main where

import Prelude
import Web.Stripe.Charge ( Charge(..), Amount(..), Count(..), Currency(..)
                         , Offset(..), getCharges, chargeToken
                         )
import Web.Stripe.Client ( APIKey(..), StripeConfig, defaultConfig, runStripeT )
import Web.Stripe.Token (Token(..), TokenId(..), getToken)
import System.Environment
import Network.HTTP.Types (status200, status404, status303)
import Network.HTTP.Types.URI (Query, QueryItem, parseQuery)
import Network.Wai
import Network.Wai.Handler.Warp (run, Port)
import Network.Wai.Middleware.RequestLogger (logStdout)
import Data.ByteString.Lazy.Char8 as BC hiding (map)
import Data.ByteString.Lazy as BL hiding (map)
import Data.ByteString as BS hiding (map)
import Data.Maybe hiding (catMaybes)
import Control.Monad
import Data.Map as M hiding (map)
import Data.Conduit
import Data.Conduit.List hiding (map, head)
import Data.Text.Encoding (decodeUtf8)
import Control.Monad.IO.Class (liftIO)
import Network.Wai.Util (redirect)
import Network.URI (parseURI)

That's quite a bit! I included the hs-stripe package; System.Environment in order to read the correct port number from the, uh, system environment; a lot of Network.* libraries to get access to raw connection details; and of course 30 kinds of ByteString for reasons I'm sure the creators can defend elegantly.

I also used two GHC Haskell language extensions: OverloadedStrings to accommodate the trainwreck that is mixing String, ByteString, and Text all in the same application; and ScopedTypeVariables for reasons that will make more sense in context.

Because I was short on time, I figured I'd rather not use a fancy shmancy framework to abstract my application but instead to use the Web Application Interface (WAI) directly. Boy did I waste a lot more time.

0.2 Top level application setup

withApp :: (Application -> IO ()) -> IO ()
withApp handler = handler application

application :: Application
application r@Request{requestMethod = m, pathInfo = p} = do
    case (m, p) of
        ("POST", ["charge"]) -> handlePostToken r
        _                    -> return notFound

notFound = responseLBS
    status404
    [("Content-Type", "text/plain")]
    "404 Not Found"

The application function accepts a Request value and dispatches the appropriate handler function. Here ScopedTypeVariables becomes very handy: I can refer to both the entire Request as a whole and also refer to some of its constituent parts, such as the requestMethod and pathInfo.

As you might be able to tell, we have bound one handler in this version of the application: a POST submission to the /charge path will charge the credit card. It's heating up in here!

withApp is a convenience function to make gluing everything together pretty later. You'll see below.

Go ahead and guess what the notFound handler is responsible for.

0.3 Stripe configuration

conf :: StripeConfig
conf  = defaultConfig $ APIKey "YOUR_STRIPE_SECRET_TOKEN"

conf creates a StripeConfig value based on your secret token. I omitted mine here for obvious reasons.

0.4 Handlers

Okay, now we get our hands dirty.

Let me be the first to say that this is not my finest work. I would call myself and intermediate Haskeller and I was also on a bit of a time constraint. However, I learned enough to know what I'll improve upon in due time.

Shall we begin?
Shall we begin?
handlePostToken req = do
    bodyLst <- requestBody req $$ consume

The first thing to know is that WAI uses the infamous conduit library. conduit is a Haskell library for efficiently handling large streams of data in constant memory. You see, Haskell is aggressively lazy: it defers actual computation until the last possible moment in order to avoid unnecessary calculations. While slick, this means it accumulates a lot of memory and makes IO kind of painful and slow. conduit presents a different model.

At a high level, there are Sources and Sinks. You can fuse a Source and a Sink together to create a Conduit (ahem) and start creating pipelines to transform data. Conduit is nifty.

It's also a fucking type nightmare.

Anyway, the request body, it turns out, is a Source wrapping a ByteString. I used the consume function from Data.Conduit.List to read in the request data. Why? Frankly, conduit proved to be a worthy foe and around 3 hours into this I went with whatever code examples I could find on StackOverflow.

    bodyStr <- return $ bodyLst !! 0
    bodyMap <- return $ M.fromList $ parseQuery bodyStr

After consuming the request body into a list of 1 item, I set bodyStr to the first element, a ByteString. Let's take a step back: the format of the request body is thus:

token=TRANSACTION_TOKEN&amount=35000

In other words, it's an HTTP query string. There is a function called parseQuery in Network.HTTP.Types.URI which turns query strings into lists of tuples, eg:

[("token", Maybe "TRANSACTION_TOKEN"), ("amount", Maybe "35000")]

The Maybe wrapper is there to ensure our program doesn't fail if someone leaves out the amount (sneaky buggers).

However, I want to ... query ... the query string for values easily. I could roll my own code to search through this list and find the right values, or I could not be an idiot and use Data.Map.fromlist to turn it into a map structure for me.

Which is, for the record, exactly what I do in creating bodyMap.

### Monads and Monad Transformers

Yeah, you knew this was coming. I'm not going to explain what monads are in this post. However, to actually understand this code it's important to know which monad we are in and why.

The monad in question here is ResourceT m a. According to the documentation it "keeps track of all registered actions, and calls them upon exit". Specifically, while you're busy fusing Sources and Sinks and Conduits and transforming shit all over the place, you're also allocating resources that must be deallocated or else your program will crash and you won't get paid.

ResourceT m a along with other conduit related operations and types appears to handle all of this internally. By writing code in the ResourceT m a monad and declaratively setting up your pipeline, you're getting all the bookkeeping done for free.

But wait, what does that "T" at the end of ResourceT mean? Well, ResourceT m a is a monad transformer. The problem monad transformers solve is very eloquently described here. In essence, they allow you to wrap a monad inside another monad.

Make your inception jokes here.

The "m" in its type signature represents an inner monad. For example, later on in the code we are going to dive into a special Stripe monad for handling interactions with their server. ResourceT m a allows us to be in the magical resource management monad but still call into other monads that are useful during our computation.

It's some sick shit.

### Moving on

    case M.lookup "amount" bodyMap of
        Nothing -> return $ doRespond "bad amount"

First, we see if an amount was specified. Data.Map.lookup takes a key and a map and returns a Maybe value. If the Maybe value is Nothing then I initiate the sophisticated error handling code you see above.

        Just amt -> do
            amtInt <- return $ fst . fromJust . BC.readInt $ BC.fromChunks . (:[]) $ fromJust $ amt

... and if I get something, I write complete gibberish and get sent away to an island with other crazy people like me.

Actually, this code is more complicated than strictly necessary because I'm using the package bytestring 0.9.x and not 0.10.x because logistical reasons (namely, the boilerplate code I started from to interact with Heroku uses 0.9.x and I got lazy).

amt is itself a Maybe value. Remember the ("amount", Maybe "35000") in the query string list above? So, over on the right side of the line we use Data.Maybe.fromJust to unwrap the actual ByteString. The

BC.fromChunks . (:[])

composed function is a trick I found on StackOverflow to convert from strict ByteStrings - the kind I consumed from the request body - to lazy ByteStrings so that I could use the readInt function.

However, readInt also returns a Maybe value because there is a chance that the ByteString will be some stupid shit like "100xyz" or "three" and fail. I do validation elsewhere (cough) and don't worry about it here.

Finally, for some reason the value inside the Maybe is a tuple consisting of the result and the original value. So I use the standard fst function to grab the first element from the tuple, which is our Int. And then I return it to our monad.

Fuck.

            case M.lookup "token" bodyMap of
                Nothing -> return $ doRespond "no token"

Next, I check to see if a token was given, and apply standard error handling wizardry in the event that no token was given.

                Just val -> do
                    finalVal <- runStripeT conf $ do
                        theToken <- getToken $ TokenId $ decodeUtf8 . fromJust $ val
                        chargeToken theToken (Amount amtInt) (Currency "usd") Nothing Nothing

If a token was specified, I finally get to talk to Stripe! Hooray! Money! Here I use runStripeT to take the StripeConfig value we created oh-so many years ago and dive into a special Stripe monad.

The reason for the Stripe monad is to hide the complexity of calling a remote web service in real time. The connection might fail, or Stripe's servers might fail and ask for a retry, or any number of things could happen. Stripe's monad, though, lets me declare what I would like done and handles it for me.

Though I store the result in finalVal, I don't do anything with it - yet. This isn't my final version, and I plan on handling error cases later using finalVal. For now, though, this suffices, because at my low volume I'll see erroneous payments on my Stripe dashboard and handle them case by case.

                    return $ fromJust $ redirect
                        status303
                        [] $
                        fromJust $ parseURI "http://niltag.net/billing/thankyou.html"

Here we go, the big one: we contacted Stripe with a token and an amount and got something back and now we grovel to our monied overlords and send them to a thank you page. The redirect function from the wai-util package sets up the appropriate headers and whatnot to tell the client's browser to redirect. In this case, I send them to a patronizing "thank you" page.

    where
        doRespond v = responseLBS
            status200
            [("Content-Type","text/plain")]
            v

doRespond is a simple inner function to factor out repetitive code.

0.5 Let's get the hell out of here

main = do
  portStr <- getEnv "PORT"
  let port = read portStr :: Port
  withApp (\app -> (run port) (middleware $ app))

middleware = logStdout

Finally, our main function, where the program actually starts. It's pretty boring: grab the port value from the system environment, convert it to an Int, and then ... what?

Oh yeah, there's withApp again. Did you think I'd forget? withApp here receives a lambda function which will take its argument, and do two things:

  1. Construct a web server using run and the port number; and
  2. Compose some server middleware with our actual application and feed it to the server.

Above, remember that we defined withApp as accepting a handler function as its sole argument and applying to application. Our lambda here is that handler function. If you're going cross eyed, that's perfectly normal.

The middleware is a standard middleware to log requests to the console, which I found useful during debugging.

0.6 The end is nigh

So, that's more or less the first version of my little payment gateway. I successfully charged myself a dollar, which after Stripe's 2.9% + $0.30 commission, will leave me with $0.67 in about 7 days.

The reason the port number is read from the system environment is so that I can interface with Heroku. They decide dynamically what port to assign your application and it's easier for everyone if you just read it from the environment. Don't ask questions.

I'm pretty happy with this. I learned quite a bit about the fundamentals of Haskell web applications, monad transformers, and the nightmare that was ByteString (which I didn't have the energy to write about, frankly).

If you have any comments or questions, please email me at gatlin@niltag.net.