Gingersnap
Gingersnap's not a web framework: that's snap-core
's job.
More a set of lightweight idioms for building a resource-safe JSON API with
postgresql-simple
.
As it's just a set of idioms, it's easy to only use 'em where you need 'em.
An app could have only a single endpoint that uses Gingersnap, with the rest
using plain snap
or snap-core
.
How do we use it? This README is also a Literate Haskell file so it's a full
example you can run with markdown-unlit. Let's get started:
Imports at the top!
A few imports we'll need for this tutorial:
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
import Control.Monad (when)
import Data.Aeson (ToJSON, (.=), FromJSON)
import Database.PostgreSQL.Simple
-- For our automatic JSON instance:
import GHC.Generics (Generic)
import Gingersnap.Core
import Network.HTTP.Types.Status (internalServerError500, unprocessableEntity422)
import Snap.Core
-- From the 'snap-server' package:
import Snap.Http.Server (quickHttpServe)
A first endpoint
Now that we've got our imports, let's jump into defining an endpoint. We'll
define a little bit of setup code later on in the file.
data Character = Character { name :: String, age :: Int }
deriving (Show, Generic)
instance ToJSON Character
instance FromJSON Character
one :: Ctx -> Snap ()
one ctx =
pureRsp ctx $ rspGood $ Character { name = "Yoda", age = 900 }
You can run the code from this file with
$ cabal update
$ cabal install gingersnap snap-server
$ ghci -pgmL markdown-unlit README.lhs # The "-pgmL" is just for this README
And calling "main". In another window, if you call:
$ curl 'localhost:8000/one'
You should get back:
{"result":{"age":900,"name":"Yoda"}}
A few things to notice:
- The endpoint takes as an argument a "Ctx". We'll see the definition of that
later.
- The endpoint returns our data with "rspGood". More on that in a moment.
- The response came wrapped in a "result" JSON object. You can customize that
behavior but we'll use the default here.
So, what's "rspGood"? Well, it has the type
rspGood :: ToJSON x => x -> Rsp
The "Rsp" type is one of the core types in Gingersnap. Keep an eye out for it later.
Defining "main"
Let's now look at how we defined our main function.
main :: IO ()
main = do
ctx <- makeCtx
quickHttpServe $ route [
("one", one ctx)
, ("two", two ctx)
, ("three", three ctx)
, ("four", method POST $ four ctx)
]
Other than "ctx", this isn't Gingersnap-specific at all: just a simple
snap-core
server. "makeCtx" is a function we define ourselves. It creates a
value of type "Ctx", which we define ourselves, and which is an instance of
"IsCtx".
IsCtx
The idea of "IsCtx" is that it allows us to thread whatever data we need through
to our endpoints. We'll definitely need a database connection (pool), but it's a
typeclass, so you can define whatever other fields you'd like to pass to your
handlers in the type that's an instance of that class.
For example, if you're using the 'auto-update' package to efficiently run
periodic actions (like getting the current time), you may want to create another
set of fields in your "Ctx" type to easily thread auto-update's actions through
to your handlers, too.
So let's define our own! We unimaginitavely call it "Ctx":
data Ctx = Ctx { ctx_db :: Pool Connection }
instance IsCtx Ctx where
ctxConnectionPool = ctx_db
And then define a simple "makeCtx":
makeCtx :: IO Ctx
makeCtx = do
-- Setting up the DB connection pool:
let connString = " host=localhost port=5432 dbname=postgres user=postgres "
pool <- createPool (connectPostgreSQL connString) close 1 5 20
pure $ Ctx { ctx_db = pool }
And that's that!
Talking to the database
Now that we've got (through Ctx) a DB connection pool, let's query the DB:
two :: Ctx -> Snap ()
two ctx = do
inTransaction ctx $ \conn -> do
[Only x] <- query_ conn " SELECT 3 + 3 "
pure $ rspGood $ Character { name = "Calvin", age = x }
$ curl 'localhost:8000/two'
{"result":{"age":6,"name":"Calvin"}}
Nice! This uses "inTransaction", another core tool in Gingersnap:
inTransaction :: IsCtx ctx => ctx -> (Connection -> IO Rsp) -> Snap ()
We've already seen IsCtx and Rsp, so the main thing to notice here is that the
action we pass to inTransaction is passed a Connection and is in IO, not in Snap
(or MonadSnap). This gives us a few nice things:
- If you're in Snap, you can accidentally leak a Connection resource by calling
finishWith while in the middle of a transaction or DB action. We don't have this
problem.
- We can choose at any time whether to commit or rollback. The "Rsp" type carries
information about whether to commit or rollback (e.g. "rspGood" will commit,
"rspBadRollback" won't). This is in contrast to "withTransaction", that'll
only roll back if there's an exception, and in contrast to manually beginning
a transaction, which provides no check that we properly commit or rollback
(e.g. we could forget to commit/rollback in one case among many in a complicated
branching expression)
If there's an error while running the (Connection -> IO Rsp)
action:
- The transaction will be rolled back
- The
Connection
will be returned to the connection pool
- A JSON error response will be returned. If you're defining your own
ApiErr
instance, that'll be apiErr_unexpectedError
Not everything's rspGood
What if we don't want to send a successful ok200 message? Or maybe we don't even
want to commit our transaction? These might come in handy then:
rspBadCommit :: ApiErr ae => ae -> Rsp
rspBadRollback :: ApiErr ae => ae -> Rsp
(rspBad
is an alias for rspBadRollback
)
ApiErr
is a simple typeclass that ensures our error type can be converted to
a HTTP status code and JSON value.
We don't need to (and won't be) exploring the ApiErr
typeclass here directly
, since we've got a good default instance with the DefaultApiErr
type.
It'll make us write a little more (e.g. explicitly stating the status code of
our error), but it's quick and easy.
three :: Ctx -> Snap ()
three ctx =
inTransaction ctx $ \conn -> do
[Only n] <- query_ conn " SELECT random () "
pure $ if n >= (0.5 :: Double)
then rspGood n
else rspBad $
DefaultApiErr_Custom
internalServerError500
"'n' too small"
[("n" .= n)]
$ curl -v 'localhost:8000/three'
[...]
< HTTP/1.1 200 OK
[...]
{"result":0.594665706157684}
$ curl -v 'localhost:8000/three'
[...]
< HTTP/1.1 500 Internal Server Error
[...]
{"errorCode":6,"errorVals":[["n",0.2500847]],"errorMessage":"'n' too small"}
If you'd like to write your own ApiErr
instance (which you probably should if
you're building something "real":
- The definition of "errResult" for "DefaultApiErr" might be a good guide
for how to get a consistent JSON result.
- You'll want to make that type the "CtxErrType" associated type for IsCtx
Getting JSON
We've sent a lot of JSON, but let's receive some!
four :: Ctx -> Snap ()
four ctx = do
o <- reqObject ctx
character <- o .! "character"
amtToAge <- o .! "amt_to_age"
when (amtToAge < (0 :: Int)) $
errorEarlyCode $
DefaultApiErr_Custom unprocessableEntity422 "Can't age backwards!" []
inTransaction ctx $ \conn -> do
[Only newAge] <- query conn " SELECT ? + ? " (age character, amtToAge)
pure $ rspGood $ character { age = newAge }
(Note with a custom ApiErr
instance you won't have to specify the HTTP
response like 'unprocessableEntity422' etc.)
$ curl 'localhost:8000/four' --data '{"character": {"name": "Calvin", "age": 6}, "amt_to_age": 1}'
{"result":{"age":7,"name":"Calvin"}}
(.!)
requires that the value be present and short-circuits with a JSON error
if it's not or if it's malformed (i.e. if fromJSON
would fail)
(.!?)
doesn't require the value to be present - it returns a Maybe
value. If
the key is present but the value is malformed, however, it'll return a JSON error.
A few things to note:
- If everything's not okay with the JSON inputs to the function, we never even
make it to the DB.
errorEarlyCode
is like (and uses) Snap's finishWith
, but we don't have
to worry about a resource leak since inTransaction
is separate
Not everything's JSON
A JSON API is usually JSON but if you'd like to e.g. send a CSV or a file there
are functions like rspGoodCSV
and (the most general) rspGoodLBS
.
If you don't see a function you need it's easy to define your own.
Other things to discover
This tutorial is a work in progress, and these'll be the next concepts to be
touched on:
- returning JSON even when throwing an error