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 /api/hook
endpoint.
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 Other
:
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 comments_url
, NOT 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 TexthookHandler 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 BasicAuth
:
type GithubAPI = BasicAuth âGithubUserâ () :> ReqBody GitPRComment :> Post â[JSON] ()
Our 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 Servant.Client
:
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 = ...
Conclusion
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!