GitHub API client

Question

Here is my Haskell program designed to list all of my GitHub repos along with their descriptions and languages via the GitHub JSON APIs:

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
import qualified Data.List as L
import Data.Maybe
import Data.Text
import qualified Data.Text.Encoding as E
import Data.Word (Word16)
import GHC.Generics (Generic)
import Network.Http.Client
import Network.HTTP.Link
import Network.URI
import OpenSSL
uriIsSsl :: URI -> Bool
uriIsSsl uri = uriScheme uri == "https:"
uriGetHostName :: URI -> Maybe String
uriGetHostName uri = uriRegName <$> uriAuthority uri
uriGetPort :: URI -> Word16 -> Maybe Word16
uriGetPort uri defaultPort = do
 auth <- uriAuthority uri
 return $ case uriPort auth of
 "" -> defaultPort
 p -> (Prelude.read $ Prelude.tail p) :: Word16
uriGetFullPath :: URI -> String
uriGetFullPath uri = uriPath uri ++ uriQuery uri ++ uriFragment uri
containsLinkParam :: Link -> LinkParam -> Text -> Bool
containsLinkParam link linkParam value =
 isJust $ L.find (\(lp, v) -> lp == linkParam && v == value) $ linkParams link
hasRelNext :: Link -> Bool
hasRelNext link = containsLinkParam link Rel "next"
findNextLink :: BS.ByteString -> Maybe Link
findNextLink value = do
 links <- parseLinkHeader $ E.decodeUtf8 value
 L.find hasRelNext links
getLinkHeader :: Response -> Maybe BS.ByteString
getLinkHeader p = getHeader p "Link"
nextLinkFromResponse :: Response -> Maybe Link
nextLinkFromResponse p = getLinkHeader p >>= findNextLink
openUri :: URI -> (Connection -> BS.ByteString -> IO a) -> IO a
openUri uri f =
 let
 isSsl = uriIsSsl uri
 hostName = C8.pack $ fromJust $ uriGetHostName uri
 port = fromJust $ uriGetPort uri (if isSsl then 443 else 80)
 fullPath = C8.pack $ uriGetFullPath uri
 wrappedF c = f c fullPath
 in
 if isSsl
 then
 withOpenSSL $ do
 ctx <- baselineContextSSL
 withConnection (openConnectionSSL ctx hostName port) wrappedF
 else
 withConnection (openConnection hostName port) wrappedF
data Repo = Repo {
 name :: String
 , description :: String
 , language :: Maybe String
} deriving (Show, Generic)
instance FromJSON Repo
fetchRepos :: URI -> IO [Repo]
fetchRepos uri =
 openUri uri $ \c fullPath -> do
 request <- buildRequest $ do
 http GET fullPath
 setAccept "application/json"
 setHeader "User-Agent" "MyGitHubApiClient"
 sendRequest c request emptyBody
 receiveResponse c $ \p i -> do
 repos <- jsonHandler p i
 nextRepos <- case nextLinkFromResponse p of
 Just link -> fetchRepos $ href link
 Nothing -> return []
 return $ repos ++ nextRepos
main :: IO ()
main = do
 repos <- fetchRepos $ fromJust $ parseURI "https://api.github.com/users/rcook/repos"
 putStrLn $ show (Prelude.length repos) ++ " repos:"
 forM_ repos $ \repo -> print repo

The trickiest thing I had to implement in this program was parsing and following "Link" headers in the HTTP response in order to deal with the API's built-in pagination behaviour. Fortunately, the http-link-header module exists so I didn't have to write the parser from scratch. However, figuring out where to follow the Rel="next" links was challenging at first.

I'm interested in hearing any constructive criticisms or suggestions, e.g.:

• Code that could be refactored into more idiomatic Haskell style
• Outright bugs
• Improvements to error handling
• Indentation!

I'd also welcome any suggestions about how I'd write automated tests for this code, given that much of the code is in the IO monad.

Answer 1

You could add comments in your code to highlight important stages that the program passes through, not only this, but the code is more readable.

• Simon Forsberg: Just because you don't understand the code doesn't mean that everyone else also doesn't understand it.