*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:
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.
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.
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.
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 Source
s and Sink
s. 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 Source
s and Sink
s and Conduit
s 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 ByteString
s - the kind I consumed from the request body - to lazy ByteString
s 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:
- Construct a web server using
run
and the port number; and - 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.