A couple weeks ago, we saw how to use Docker in conjunction with Heroku to deploy our Haskell application. The process resulted in a simpler Circle CI config than we had before, as we let Docker do most of the heavy lifting. In particular, we no longer needed to download and build stack ourselves. We specified the build process in our Dockerfile, and then called
docker build. We also saw a couple different ways to login to these services from our Circle CI box.
In the future, we’ll look at ways to use more diverse deployment platforms than Heroku. In particular, we’ll look at AWS. But that’s a tough nut to crack, so it might be worthy of its own series! For now, we’ll conclude our series on deployment by looking at the Github developer API. Most projects you’ll work on use Github for version control. But with the API, there are a lot of interesting tricks that can make your experience cooler! This week, we’ll see how to setup a server that will respond to events that happen within our repository. Then we’ll see how we can send our own events from the server! You can follow along with this code by looking at this Github repository!
This article builds a lot on our knowledge of the Servant library. If you’ve never used that before, I highly recommend you read our Haskell Web Skills series. You'll learn about Servant and much more! You can also download our Production Checklist for more tools to use in your applications.
Github Webhooks Primer
First let’s understand the concept of webhooks. Many services besides Github also use them. A webhook is an integration where a service will send an HTTP request to an endpoint of your choosing whenever some event happens. Webhooks are often a way for you to get some more advanced functionality out of a system. They can let you automate a lot of your processes. With Github, we can customize the events where this occurs. So for instance, we can trigger a request whenever creates a pull request.
In this article, we’ll set up a very simple server that will do just that. When they open a new PR, we’ll add a comment saying we’ll take a look at the pull request soon. We’ll also have the comment tag our account so we get a notification.
The Github part of this is easy. We go to the settings for our repository, and then find the “Webhooks” section. We’ll add a webhook for custom events, and we’ll only check the box next to “Pull Requests”. We’ll assign this to the URL of a Server that we’ll put up on a Heroku server, hitting the
Building Our Server
First let’s make a data type for a Github request. This will be a simple two-constructor type. Our first constructor will contain information about an opened pull request. We’ll want to get the user’s name out of the request object, as well as the URL for us to send our comment to. We’ll also have an
Other constructor for when the request isn’t about an open pull request.
data GithubRequest = GithubOpenPRRequest Text Text | -- User’s name, comments URL GithubOtherRequest deriving (Show)
So we need a simple server that listens for requests on a particular endpoint. As we have in the past, we’ll use Servant for this process. Our endpoint type will use our desired path. Then it will also take a request body with our GithubRequest. We’ll listen for a post request, and then return a
Text as our result, to help debug.
type ServerAPI = “api” :> “hook” :> ReqBody ‘[JSON] GithubRequest :> Post ‘[JSON] Text
Now we need to specify a
FromJSON instance for our request type. Using the documentation, we’ll find a few fields we need to read to make this happen. First, we’ll check that, indeed, this request has a pull request section and that it’s action is “opened”. If these aren’t there, we’ll return
instance FromJSON GithubRequest where parseJSON = withObject “GithubRequest” $ \o -> do (action :: Maybe Text) <- o .:? “action” prSectionMaybe <- o .:? “Pull_request” case (action, prSectionMaybe) of (Just “opened”, Just pr_section :: Maybe Value) -> do … _ -> return GithubOtherRequest
Now we can fetch the user section and the comments URL from the
pull_request section. We do this with a function on a
Data.Aeson object like so:
where fetchUserAndComments o’ = do uSection <- o’ .: “user” commentsURL <- o’ .: “comments_url” return (uSection, commentsURL)
Note we want
review_comments_url! We want to leave a single comment, rather than performing a full review of this PR. It was VERY annoying to figure out that the documentation covers this under the Issues section, NOT the section on pull requests! Once we get the user section and comments, URL, we need one more step. We’ll get the user name out of the section, and we’ll return our final request!
instance FromJSON GithubRequest where parseJSON = withObject “GithubRequest” $ \o -> do (action :: Maybe Text) <- o .:? “action” prSectionMaybe <- o .:? “Pull_request” case (action, prSectionMaybe) of (Just “opened”, Just pr_section :: Maybe Value) -> do (userSection :: Value, commentsURL :: Text) <- withObject “PR Section” fetchUserAndComments prSection userName <- withObject “User Section” (\o’ -> o’ .: “login”) userSection return $ GithubOpenPRRequest userName commentsURL _ -> return GithubOtherRequest
Handling the Endpoint
Now we need a handler function for endpoint. This handler will pattern match on the type of request and return a debugging string. If we have indeed found a request to open the PR, we’ll also want to call another
IO function that will add our comment:
hookHandler :: GithubRequest -> Handler Text hookHandler GithubOtherRequest = return “Found a non-PR opening request.” hookHandler (GithubOpenPRRequest userName commentsURL) = do liftIO $ addComment userName commentsURL return $ “User: “ <> userName <> “ opened a pull request with comments at: “ <> commentsURL addComment :: Text -> Text -> IO () ...
Adding a Comment
In order to add a comment to this pull request, we’ll need to hit the Github API with our own request. Again, we’ll do this using Servant’s magic! First, let’s make another API type to represent Github’s own developer API. Since we’re getting the full comments URL as part of our request, we don’t need any path components here. But we will need to authenticate using
type GithubAPI = BasicAuth “GithubUser” () :> ReqBody GitPRComment :> Post ‘[JSON] ()
GitPRComment will only need a
Text for the body of the comment. So let’s make a simple
newtype wrapper and add a
ToJSON instance for it:
newtype GitPRComment = GitPRComment Text instance ToJSON GitPRComment where toJSON (GitPRComment body) = object [ “body” .= body ]
We can create a client function for this API now using the magic
client function from
sendCommentClient :: BasicAuthData -> GitPRComment -> ClientM () sendCommentClient = client (Proxy :: Proxy GithubAPI)
Now to build our commenting function, we’ll start by building the auth data.
import qualified Data.ByteString.Char8 as BSC ... addComment :: Text -> Text -> IO () addComment userName commentsURL = do gitUsername <- getEnv “GITHUB_USERNAME” gitPassword <- getEnv “GITHUB_PASSWORD” let authData = BasicAuthData (BSC.pack gitUsername) (BSC.pack gitPassword) ...
Now we’ll set up our client environment using the comments URL:
addComment :: Text -> Text -> IO () addComment userName commentsURL = do ... manager <- newManager tlsManagerSettings baseUrl <- parseBaseUrl (Data.Text.unpack commentsURL) let clientEnv = clientEnv maanger baseUrl ...
We’ll add a simple function taking our admin’s username and composing the body of the comment. We’ll tag ourselves as well as the user who opened the PR:
addComment :: Text -> Text -> IO () addComment userName commentsURL = do … where commentBody adminName = GitPRComment $ “Thanks for posting this @” <> userName <> “! I’ll take a look soon! - @” <> adminName
Now we wrap everything together by making our client call. And that’s it!
addComment :: Text -> Text -> IO () addComment userName commentsURL = do gitUsername <- getEnv “GITHUB_USERNAME” gitPassword <- getEnv “GITHUB_PASSWORD” let authData = BasicAuthData (BSC.pack gitUsername) (BSC.pack gitPassword) manager <- newManager tlsManagerSettings baseUrl <- parseBaseUrl (Data.Text.unpack commentsURL) let clientEnv = clientEnv maanger baseUrl runClientM (sendCommentClient authData (commentBody gitUsername)) clientEnv return () where commentBody = ...
Services like Github do their best to provide a good user experience to all their normal users. But if you get a little bit advanced, you can often customize their behavior to a great degree! Notice how important it is to know how to setup a simple server. This gives you limitless freedom to manipulate the system and add your own behaviors. It’s a cool perk of learning these specific web skills. If you want to see the full code I wrote for this article, check it out on this Github repo!
To learn about more web skills that can magnify your programming ability, check out our Haskell Web Skills Series. It’ll walk you through some different Haskell libraries, like Persistent for databases, and Servant for web servers. You can also download our Production Checklist. It’ll give you a lot more ideas of libraries to use to enhance your Haskell experience!