hasbolt-sample-app

Sample Movie Database application with Haskell backend

Feel free to copy this example and use hasbolt as you with :)

Build

To build the project just clone it and run build command by stack:

git clone https://github.com/zmactep/hasbolt-sample-app.git
cd hasbolt-sample-app
stack build

Usage

PORT=8080 stack exec hasbolt-sample-app-exe

Cloud deployment

To deploy on Heroku just follow these steps:

export app=neo4j-movies-haskell-`whoami`
heroku apps:create $app

# Add neo4j addon and make it available from application
heroku addons:add graphenedb:chalk --app $app

# Set Haskell Stack buildpack
heroku buildpacks:set https://github.com/mfine/heroku-buildpack-stack

# deploy to heroku
git push heroku master

# open application
heroku open --app $app

# open addon admin page
heroku addons:open graphenedb

In the Graphenedb-UI use “Launch Neo4j Admin UI”. In the Neo4j-Browser import the :play movies dataset.

Under the hood

Here I use static jQuery html from movies-python-bolt and the same API.

Http backend uses Scotty web framework. To store the internal state with connection pool I use a ReaderT monad transformer.

Server state

First, we need to create a connection pool to out Neo4j database (source):

-- |A pool of connections to Neo4j server
data ServerState = ServerState { pool :: Pool Pipe }

-- |Reader monad over IO to store connection pool
type WebM = ReaderT ServerState IO

To create new connection pool we use connect :: BoltCfg -> IO Pipe and close :: Pipe -> IO () functions from hasbolt to tell resource-pool how to create a new connection and how to close one (source):

-- |Create pool of connections (4 stripes, 500 ms timeout, 1 resource per stripe)
constructState :: BoltCfg -> IO ServerState
constructState bcfg = do pool <- createPool (connect bcfg) close 4 500 1
                         return (ServerState pool)

Simple server

After we created a representation of our server state, we can create a simple server on given port (source):

runServer :: Port -> BoltCfg -> IO ()
runServer port config = do state <- constructState config
                           scottyT port (`runReaderT` state) $ do
                             middleware logStdoutDev
                             get  "/"             mainR
                             get  "/graph"        graphR
                             get  "/search"       searchR
                             get  "/movie/:title" movieR

Here we construct a new state by constrictState :: BoltCfg -> ServerState function from hardcoded default configuration and set routes. Let's implement these routes.

First of all we need to respond with static index.html on "/" route (source):

-- |Main page route
mainR :: ActionT Text WebM ()
mainR = file "index.html"

On a search request we get a text "q" parameter and perform a movie search, then respond it as json (source):

-- |Search response route
searchR :: ActionT Text WebM ()
searchR = do q <- param "q" :: ActionT Text WebM Text
             results <- runQ $ querySearch (toStrict q)
             json results

A movie select is quick and unsafe way to get a json with movie info by it's exact title (source):

-- |Movie response route
movieR :: ActionT Text WebM ()
movieR = do t <- param "title" :: ActionT Text WebM Text
            movieInfo <- runQ $ queryMovie (toStrict t)
            json movieInfo

At last we have to return a graph of movies and actors (source):

-- |Graph response route
graphR :: ActionT Text WebM ()
graphR = do limit <- param "limit" `rescue` const (return 100)
            graph <- runQ $ queryGraph limit
            json graph

Frontend <-> backend JSON protocol serialization

TODO: Uninteresting JSON data serialization (source).

Database queries by hasbolt

To run queries we need to get a connection pool, get one Pipe and do a request by this pipe. All of this in the runQ function (source):

-- |Run BOLT action in scotty 'ActionT' monad transformer
runQ :: BoltActionT IO a -> ActionT Text WebM a
runQ act = do ss <- lift ask
              liftIO $ withResource (pool ss) (`run` act)

See comments in the code to understand the query functions.

Search (source):

-- |Search movie by title pattern
querySearch :: Text -> BoltActionT IO [Movie]
querySearch q = do records <- queryP cypher params           -- get record list by cypher query and params
                   nodes <- traverse (`at` "movie") records  -- from each record get only "movie" field
                   traverse toMovie nodes                    -- serialize movies to jsonable data
  where cypher = "MATCH (movie:Movie) WHERE movie.title =~ {title} RETURN movie"
        params = fromList [("title", T $ "(?i).*" <> q <> ".*")]

Movie (source):

-- |Returns movie by title
queryMovie :: Text -> BoltActionT IO MovieInfo
queryMovie title = do result <- head <$> queryP cypher params -- get first record from received record list by cypher query and params
                      T title <- result `at` "title"          -- get movie title as text (you also can use exact function here)
                      L members <- result `at` "cast"         -- get movie cast as list
                      cast <- traverse toCast members         -- serialize cast to jsonable data
                      return $ MovieInfo title cast           -- serialize all to json object
  where cypher = "MATCH (movie:Movie {title:{title}}) " <>
                 "OPTIONAL MATCH (movie)<-[r]-(person:Person) " <>
                 "RETURN movie.title as title," <>
                 "collect([person.name, " <>
                 "         head(split(lower(type(r)), '_')), r.roles]) as cast " <>
                 "LIMIT 1"
        params = fromList [("title", T title)]

Graph (source):

-- |Returns movies with all it's actors
queryGraph :: Int -> BoltActionT IO MGraph
queryGraph limit = do records <- queryP cypher params                        -- get first record from received record
                      nodeTuples <- traverse toNodes records                 -- convert records to list of tuples (movie, [actors])
                      let movies = fst <$> nodeTuples                        -- get list of movies
                      let actors = nub $ concatMap snd nodeTuples            -- get list of actors
                      let actorIdx = fromJust . (`lookup` zip actors [0..])  -- some magic here to obtain relations
                      let modifyTpl (m, as) = (m, actorIdx <$> as)
                      let indexMap = fromList $ modifyTpl <$> nodeTuples
                      let mkTuples (m, t) = (`MRel` t) <$> indexMap ! m
                      let relations = concatMap mkTuples $ zip movies [length actors..]
                      return $ MGraph (actors <> movies) relations           -- serialize all to json object
  where cypher = "MATCH (m:Movie)<-[:ACTED_IN]-(a:Person) " <>
                 "RETURN m.title as movie, collect(a.name) as cast " <>
                 "LIMIT {limit}"
        params = fromList [("limit", I limit)]