diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,20 +1,24 @@ # Changelog -# v0.1.2 (2014-10-11) +## v0.1.3 (2014-10-15) -- Support GHC 7.6. -- Support aeson 0.8. -- Support criterion 1.0. -- Support transformers 0.4. +- Added the ability to change the port using the `PORT` environment variable. +- Added the ability to configure the database through the `DATABASE_URL` + environment variable. -# v0.1.1 (2014-10-11) +## v0.1.2 (2014-10-11) -- Switch PostgreSQL username from "taylor" to "postgres". +- Added support for GHC 7.6. +- Added support for aeson 0.8, criterion 1.0, and transformers 0.4. -# v0.1.0 (2014-10-11) +## v0.1.1 (2014-10-11) -- Initial release. +- Switched PostgreSQL username from "taylor" to "postgres". -# v0.0.0 (2014-10-10) +## v0.1.0 (2014-10-11) -- Initial commit. +- Initially released. + +## v0.0.0 (2014-10-10) + +- Initially committed. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -37,7 +37,7 @@ ``` sh $ cabal update -$ cabal install hairy-0.1.2 +$ cabal install hairy-0.1.3 ``` This package uses [Semantic Versioning][11]. @@ -67,14 +67,26 @@ ## Configuration -Hairy can be configured through environment variables. To configure the -environment, use the `SCOTTY_ENV` environment variable. +Hairy can be configured through environment variables. +To configure the environment, use the `SCOTTY_ENV` environment variable. +Possible environments include `Development`, `Production`, and `Test`. + ``` sh $ env SCOTTY_ENV=Production hairy ``` -Possible environments include `Development`, `Production`, and `Test`. +To configure the port, use the `PORT` environment variable. + +``` sh +$ env PORT=8080 hairy +``` + +To configure the database, use the `DATABASE_URL` environment variable. + +``` sh +$ env DATABASE_URL=postgres://postgres:postgres@localhost:5432/hairy_development hairy +``` [1]: https://github.com/tfausak/hairy [2]: https://img.shields.io/hackage/v/hairy.svg?style=flat diff --git a/hairy.cabal b/hairy.cabal --- a/hairy.cabal +++ b/hairy.cabal @@ -1,5 +1,5 @@ name: hairy -version: 0.1.2 +version: 0.1.3 cabal-version: >=1.10 build-type: Simple license: MIT @@ -31,6 +31,7 @@ base ==4.*, aeson >=0.7 && <0.9, data-default ==0.5.*, + heroku ==0.1.*, http-types ==0.8.*, mtl ==2.*, monad-logger ==0.3.*, diff --git a/library/Hairy.lhs b/library/Hairy.lhs --- a/library/Hairy.lhs +++ b/library/Hairy.lhs @@ -34,6 +34,8 @@ > import Control.Monad.Trans.Class (MonadTrans, lift) > import Data.Aeson (Value (Null), (.=), object) > import Data.Default (def) +> import qualified Data.Text as T +> import Data.Text.Encoding (encodeUtf8) > import Data.Text.Lazy (Text) > import qualified Database.Persist as DB > import qualified Database.Persist.Postgresql as DB @@ -41,18 +43,33 @@ > import Network.HTTP.Types.Status (created201, internalServerError500, > notFound404) > import Network.Wai (Middleware) -> import Network.Wai.Handler.Warp (defaultSettings) +> import Network.Wai.Handler.Warp (Settings, defaultSettings, +> setFdCacheDuration, setPort) > import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) > import System.Environment (lookupEnv) +> import Web.Heroku (parseDatabaseUrl) > import Web.Scotty.Trans (ActionT, Options, ScottyT, defaultHandler, delete, > get, json, jsonData, middleware, notFound, param, post, put, scottyOptsT, > settings, showError, status, verbose) +With all that out of the way, we can start on the actual program itself. The +top-level entry point, `main`, only has two responsibilities: get the current +configuration and run the application with that configuration. + > main :: IO () > main = do > c <- getConfig > runApplication c +We could've written this in the point-free style. + + main :: IO () + main = getConfig >>= runApplication + +Getting the current configuration involves reading the environment from the +system and then setting up the database connection pool. After doing both of +those, we create a new `Config` value with the environment and pool. + > getConfig :: IO Config > getConfig = do > e <- getEnvironment @@ -62,11 +79,25 @@ > , pool = p > } +The data type for `Config` is pretty simple. It has two fields: one for the +environment and one for the database connection pool. We'll define another data +type for the environment, and we're using Persistent's `ConnectionPool` for the +database connection pool. + > data Config = Config > { environment :: Environment > , pool :: DB.ConnectionPool > } +We want to read the environment from the `SCOTTY_ENV` environment variable, then +parse that string as our `Environment` data type and return it. If it doesn't +parse, we'll just blow up. + + $ env SCOTTY_ENV=not-an-environment cabal run + hairy: Prelude.read: no parse + +If we wanted to handle it more gracefully, we could use `Text.Read.readMaybe`. + > getEnvironment :: IO Environment > getEnvironment = do > m <- lookupEnv "SCOTTY_ENV" @@ -75,99 +106,309 @@ > Just s -> read s > return e +We could've written this point-free. + + getEnvironment :: IO Environment + getEnvironment = fmap (maybe Development read) (lookupEnv "SCOTTY_ENV") + +Now that we've seen how to get the environment, let's see what the possible +environments are. You could add more environments, like `Staging`, to suite your +particular needs. + +> data Environment +> = Development +> | Production +> | Test +> deriving (Eq, Read, Show) + +With all the environment stuff out of the way, let's take a look at the database +connection pool. It will be used by the application to make database queries, so +it's responsible for configuring the database itself. That means logging, +connection parameters, and pool size. To start, the top-level function gets the +connection parameters and pool size, then determines which kind of logging to +use. + > getPool :: Environment -> IO DB.ConnectionPool -> getPool e = +> getPool e = do +> s <- getConnectionString e +> let n = getConnectionSize e > case e of > Development -> runStdoutLoggingT (DB.createPostgresqlPool s n) > Production -> runStdoutLoggingT (DB.createPostgresqlPool s n) > Test -> runNoLoggingT (DB.createPostgresqlPool s n) -> where -> s = getConnectionString e -> n = getConnectionSize e -> getConnectionString :: Environment -> DB.ConnectionString -> getConnectionString Development = +This function is a little weird. I wish it could be written like this: + + getPool :: Environment -> IO DB.ConnectionPool + getPool e = do + s <- getConnectionString e + let n = getConnectionSize e + p = DB.createPostgresqlPool s n + t = case e of + Development -> runStdoutLoggingT + Production -> runStdoutLoggingT + Test -> runNoLoggingT + t p + +Unfortunately the type system won't allow it. `runStdoutLoggingT` and +`runNoLoggingT` work on different monad transformers. `createPostgresqlPool` is +fine with either of them, but it can't accept both simultaneously. + +Just like we looked up the environment through `SCOTTY_ENV`, we're going to look +up the database connection parameters through `DATABASE_URL`. It's expected to +look like this: `postgres://user:pass@host:port/db`. If it doesn't look like +that, we'll blow up. + + $ env DATABASE_URL=not-a-database-url cabal run + hairy: couldn't parse absolute uri + +If it's not given at all, we'll fall back to using a hard-coded default based on +the environment. + +> getConnectionString :: Environment -> IO DB.ConnectionString +> getConnectionString e = do +> m <- lookupEnv "DATABASE_URL" +> let s = case m of +> Nothing -> getDefaultConnectionString e +> Just u -> createConnectionString (parseDatabaseUrl u) +> return s + +These are the default connection parameters per environment. + +> getDefaultConnectionString :: Environment -> DB.ConnectionString +> getDefaultConnectionString Development = > "host=localhost port=5432 user=postgres dbname=hairy_development" -> getConnectionString Production = +> getDefaultConnectionString Production = > "host=localhost port=5432 user=postgres dbname=hairy_production" -> getConnectionString Test = +> getDefaultConnectionString Test = > "host=localhost port=5432 user=postgres dbname=hairy_test" +This function converts a list of text tuples into a database connection string, +which is a byte string. It joins each tuple with an equals sign and then joins +each element in the list with a space. + + > createConnectionString [("k1", "v1"), ("k2", "v2")] + "k1=v1 k2=v2" + +This is necessary to convert what `Web.Heroku.parseDatabaseUrl` gives us into +something that Persistent can understand. + +> createConnectionString :: [(T.Text, T.Text)] -> DB.ConnectionString +> createConnectionString l = +> let f (k, v) = T.concat [k, "=", v] +> in encodeUtf8 (T.unwords (map f l)) + +The last piece of the database puzzle is the size of the connection pool. In the +real world you'd need to benchmark performance using different sizes to see what +works best. A good baseline is two times the number of cores. That could be +expressed here using `GHC.Conc.numCapabilities`, but there's no guarantee that +the web server and the database server are even running on the same machine. + > getConnectionSize :: Environment -> Int > getConnectionSize Development = 1 > getConnectionSize Production = 8 > getConnectionSize Test = 1 -> data Environment -> = Development -> | Production -> | Test -> deriving (Eq, Read, Show) +So we've set up our environment and our database connection. That's enough to +let us move on to setting up the application itself. All we need to do here is +get the options for Scotty and set up a runner for reading the configuration. > runApplication :: Config -> IO () > runApplication c = do -> let o = getOptions (environment c) -> r m = runReaderT (runConfigM m) c +> o <- getOptions (environment c) + +This takes Scotty's monad `m` and adds the ability to read our custom config `c` +from it. This is called a monad transformer stack. It allows us to use any monad +in the stack. So after layering on our config reader monad, we can both deal +with requests using Scotty's monad and read our config using our monad. + +> let r m = runReaderT (runConfigM m) c > scottyOptsT o r r application -> -- GeneralizedNewtypeDeriving +Next we'll actually define our reader monad. This requires +`GeneralizedNewtypeDeriving` to easily and efficiently derive instances for our +type alias. The type signature of `runConfigM` tells us that it adds the ability +to read `Config` to the `IO` monad, which is the bottom of Scotty's monad +transformer stack. + > newtype ConfigM a = ConfigM > { runConfigM :: ReaderT Config IO a > } deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config) -> getOptions :: Environment -> Options -> getOptions Development = def -> getOptions Production = def -> { settings = defaultSettings -> , verbose = 0 -> } -> getOptions Test = def -> { verbose = 0 -> } +Let's circle back and see how we get Scotty's options. The data type exposed +only has two fields, so there's not a lot for us to do here. +> getOptions :: Environment -> IO Options +> getOptions e = do +> s <- getSettings e +> return def +> { settings = s +> , verbose = case e of +> Development -> 1 +> Production -> 0 +> Test -> 0 +> } + +I explicitly listed all of the environments here to ensure that I got all of +them. In the real world you might do something like this instead: + + verbose = case e of + Development -> 1 + _ -> 0 + +Or, if you're feeling particularly witty: + + verbose = fromEnum (e == Development) + +Most of the real options are in Wai's settings. The defaults are good for most +of them, but we want to make two changes. First, we need to remove the file +cache so that static file changes will be picked up. We only want to do this in +development since static files should be static in other environments. Then we +want to use the port in the `PORT` environment variable, if it's available. + +> getSettings :: Environment -> IO Settings +> getSettings e = do +> let s = defaultSettings + +Here I'm using primes (`'`) to mark altered versions of the settings. There are +probably better ways to do this type of modification, but this works and is +straighforward. + +> s' = case e of +> Development -> setFdCacheDuration 0 s +> Production -> s +> Test -> s +> m <- getPort +> let s'' = case m of +> Nothing -> s' +> Just p -> setPort p s' +> return s'' + +Finally we need to handle looking up the port. Like our other functions that +read from environment variables, this one will blow up if you give it something +it's not expecting. + + $ env PORT=not-a-port cabal run + hairy: Prelude.read: no parse + +> getPort :: IO (Maybe Int) +> getPort = do +> m <- lookupEnv "PORT" +> let p = case m of +> Nothing -> Nothing +> Just s -> Just (read s) +> return p + +The last bit of configuration is to set up our error type. We're going to make +it an alias for `Text`. You could do something fancier here by enumerating the +possible error states for your application. + + data Error = NotFoundError | ForbiddenError | ... + instance ScottyError Error where ... + +We're alright with the default textual errors, so we don't need anything that +fancy yet. + > type Error = Text +That wraps up all of the configuration, options, and settings. Everything from +here on out deals with the application itself. + +Our application has several responsibilities. It needs to run database +migrations, set up middlewares, install a default exception handler, and define +routes. Since everything else could conceivably depend on the database, we'll +run the migrations first. + > application :: ScottyT Error ConfigM () > application = do > runDB (DB.runMigration migrateAll) +`runDB` is a utility function we'll define a little later. It basically lifts a +database operation into the current Scotty monad. `migrateAll` comes from +`Hairy.Models` and is generated by Persistent using Template Haskell. + +Now that the database has been migrated, we can set up middlewares and exception +handlers. Both of them depend on the environment, so we have to get that from +our config reader monad first. + > e <- lift (asks environment) > middleware (loggingM e) > defaultHandler (defaultH e) +Finally we can do the routing for our application. All we need is the HTTP +method, the path, and the action to route it to. + > get "/tasks" getTasksA > post "/tasks" postTasksA > get "/tasks/:id" getTaskA > put "/tasks/:id" putTaskA > delete "/tasks/:id" deleteTaskA +Routes are matched top down, so if nothing else matched we'll render our not +found action. + > notFound notFoundA -> runDB :: (MonadTrans t, MonadIO (t ConfigM)) => DB.SqlPersistT IO a -> t ConfigM a +That's it! As your application grows you'll add more routes and middlewares, but +the basic structure shouldn't change too much. + +Let's take a look at that `runDB` helper we used. It takes a SQL query `q` and +runs it inside our monad transformer stack. It does this by asking the config +reader for the database connection pool, then running the query with that pool +in the IO monad. + +> runDB :: (MonadTrans t, MonadIO (t ConfigM)) => +> DB.SqlPersistT IO a -> t ConfigM a > runDB q = do > p <- lift (asks pool) > liftIO (DB.runSqlPool q p) +Up next is the logging middleware. In development we want colorful multiline +logs flushed every request. In production we want plain log lines flushed +sometimes. In testing we don't want logging at all. + > loggingM :: Environment -> Middleware > loggingM Development = logStdoutDev > loggingM Production = logStdout > loggingM Test = id +Before we define our default exception handler, let's create an alias for our +Scotty actions. They're all going to have the same type, so we don't want to +repeat ourselves over and over again. + > type Action = ActionT Error ConfigM () +Since our default exception handler handles uncaught exceptions in our +application, we want it print out the exceptions in development but swallow them +in production (we don't really care what happens to them in testing). In the +real world you might send the exception to another service. + > defaultH :: Environment -> Error -> Action > defaultH e x = do > status internalServerError500 -> case e of -> Development -> json (object ["error" .= showError x]) -> Production -> json Null -> Test -> json (object ["error" .= showError x]) +> let o = case e of +> Development -> object ["error" .= showError x] +> Production -> Null +> Test -> object ["error" .= showError x] +> json o +At long last we can get to the meat of our application: the actions. This is +where all of your business logic lives. Since Hairy is just a basic CRUD app, +there's not a lot going on here. This action gets all the tasks from the +database and renders them as JSON. + > getTasksA :: Action > getTasksA = do > ts <- runDB (DB.selectList [] []) > json (ts :: [DB.Entity Task]) +This one allows you to create new tasks by posting JSON to it. If the JSON isn't +valid, an exception will be raised. That means in development you'll get a +helpful error message, but in production you'll get a blank 500. + + $ curl -X POST localhost:3000/tasks -d 'not valid json' + {"error":"jsonData - no parse: not valid json"} + > postTasksA :: Action > postTasksA = do > t <- jsonData @@ -175,6 +416,9 @@ > status created201 > json (t :: Task) +This action gets a task from the database. If it was found, it renders it as +JSON. If it wasn't, it renders the generic not found action. + > getTaskA :: Action > getTaskA = do > i <- param "id" @@ -183,6 +427,9 @@ > Nothing -> notFoundA > Just t -> json (t :: Task) +This one will either update an existing task or create a new one with the given +ID. Then it renders the task as JSON. + > putTaskA :: Action > putTaskA = do > i <- param "id" @@ -190,17 +437,36 @@ > runDB (DB.repsert (toKey i) t) > json (t :: Task) +This is the last action. It will delete a task with the given ID. If there is no +such task, it returns 200 anyway. In either case, `null` is returned. + > deleteTaskA :: Action > deleteTaskA = do > i <- param "id" > runDB (DB.delete (toKey i :: TaskId)) > json Null -> -- FlexibleContexts +That wraps up the business logic. We only have a couple things to attend to. We +used `toKey`, a helper function that converts a request parameter into a +database key. It allows us to query for stuff from the database using request +parameters. + +This helper function requires the FlexibleContexts language extension, although +I can't really tell you why. If you don't have it, GHC complains. If you do have +it, everything works fine. + > toKey :: DB.ToBackendKey DB.SqlBackend a => Integer -> DB.Key a > toKey i = DB.toSqlKey (fromIntegral (i :: Integer)) +The last thing we need to do is define our not found action. All it does is set +the HTTP status to 404 and render `null`. + > notFoundA :: Action > notFoundA = do > status notFound404 > json Null + +That's all there is to it! With less than 200 lines of code we've created a JSON +REST API with some CRUD actions. It's all backed by a database and can be +configured to run in development mode on your machine or in production on +Heroku.