Use consistent style throughout project

- Alphabetize imports
- Place qualified imports separate and last
- BL for ByteString.Lazy
- Don't align tokens in tuple lists or record assignments
- Two-space indent for where keyword
- Use record syntax for Creds
- Break before operators in Applicative expressions
- Consistent whitespace throughout

Resolves #19

Yesod/Auth/OAuth2.hs

@@ -23,17 +23,17 @@ import Data.Text (Text, pack)
 import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
 import Data.Text.Encoding.Error (lenientDecode)
 import Data.Typeable
+import Network.HTTP.Conduit (Manager)
 import Network.OAuth.OAuth2
-import Network.HTTP.Conduit(Manager)
 import System.Random
 import Yesod.Auth
 import Yesod.Core
 import Yesod.Form
 
-import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy as BL
 
 -- | Provider name and Aeson parse error
-data YesodOAuth2Exception = InvalidProfileResponse Text BSL.ByteString
+data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
     deriving (Show, Typeable)
 
 instance Exception YesodOAuth2Exception
@@ -52,52 +52,52 @@ authOAuth2 :: YesodAuth m
            -> AuthPlugin m
 authOAuth2 name oauth getCreds = AuthPlugin name dispatch login
 
-    where
-        url = PluginR name ["callback"]
+  where
+    url = PluginR name ["callback"]
 
-        withCallback csrfToken = do
-            tm <- getRouteToParent
-            render <- lift getUrlRender
-            return oauth
-                { oauthCallback = Just $ encodeUtf8 $ render $ tm url
-                , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth
-                    <> "&state=" <> encodeUtf8 csrfToken
-                }
+    withCallback csrfToken = do
+        tm <- getRouteToParent
+        render <- lift getUrlRender
+        return oauth
+            { oauthCallback = Just $ encodeUtf8 $ render $ tm url
+            , oauthOAuthorizeEndpoint = oauthOAuthorizeEndpoint oauth
+                <> "&state=" <> encodeUtf8 csrfToken
+            }
 
-        dispatch "GET" ["forward"] = do
-            csrfToken <- liftIO generateToken
-            setSession tokenSessionKey csrfToken
-            authUrl <- bsToText . authorizationUrl <$> withCallback csrfToken
-            lift $ redirect authUrl
+    dispatch "GET" ["forward"] = do
+        csrfToken <- liftIO generateToken
+        setSession tokenSessionKey csrfToken
+        authUrl <- bsToText . authorizationUrl <$> withCallback csrfToken
+        lift $ redirect authUrl
 
-        dispatch "GET" ["callback"] = do
-            newToken <- lookupGetParam "state"
-            oldToken <- lookupSession tokenSessionKey
-            deleteSession tokenSessionKey
-            case newToken of
-                Just csrfToken | newToken == oldToken -> do
-                    code <- lift $ runInputGet $ ireq textField "code"
-                    oauth' <- withCallback csrfToken
-                    master <- lift getYesod
-                    result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code)
-                    case result of
-                        Left _ -> permissionDenied "Unable to retreive OAuth2 token"
-                        Right token -> do
-                            creds <- liftIO $ getCreds (authHttpManager master) token
-                            lift $ setCredsRedirect creds
-                _ ->
-                    permissionDenied "Invalid OAuth2 state token"
+    dispatch "GET" ["callback"] = do
+        newToken <- lookupGetParam "state"
+        oldToken <- lookupSession tokenSessionKey
+        deleteSession tokenSessionKey
+        case newToken of
+            Just csrfToken | newToken == oldToken -> do
+                code <- lift $ runInputGet $ ireq textField "code"
+                oauth' <- withCallback csrfToken
+                master <- lift getYesod
+                result <- liftIO $ fetchAccessToken (authHttpManager master) oauth' (encodeUtf8 code)
+                case result of
+                    Left _ -> permissionDenied "Unable to retreive OAuth2 token"
+                    Right token -> do
+                        creds <- liftIO $ getCreds (authHttpManager master) token
+                        lift $ setCredsRedirect creds
+            _ ->
+                permissionDenied "Invalid OAuth2 state token"
 
-        dispatch _ _ = notFound
+    dispatch _ _ = notFound
 
-        generateToken = pack . take 30 . randomRs ('a', 'z') <$> newStdGen
+    generateToken = pack . take 30 . randomRs ('a', 'z') <$> newStdGen
 
-        tokenSessionKey :: Text
-        tokenSessionKey = "_yesod_oauth2_" <> name
+    tokenSessionKey :: Text
+    tokenSessionKey = "_yesod_oauth2_" <> name
 
-        login tm = [whamlet|
-            <a href=@{tm $ oauth2Url name}>Login via #{name}
-            |]
+    login tm = [whamlet|
+        <a href=@{tm $ oauth2Url name}>Login via #{name}
+        |]
 
 bsToText :: ByteString -> Text
 bsToText = decodeUtf8With lenientDecode

Yesod/Auth/OAuth2/Github.hs

@@ -17,27 +17,28 @@ import Control.Applicative ((<$>), (<*>))
 import Control.Exception.Lifted
 import Control.Monad (mzero)
 import Data.Aeson
-import Data.Text (Text)
 import Data.Monoid ((<>))
+import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import Network.HTTP.Conduit (Manager)
 import Yesod.Auth
 import Yesod.Auth.OAuth2
-import Network.HTTP.Conduit(Manager)
+
 import qualified Data.Text as T
 
 data GithubUser = GithubUser
-    { githubUserId    :: Int
-    , githubUserName  :: Maybe Text
+    { githubUserId :: Int
+    , githubUserName :: Maybe Text
     , githubUserLogin :: Text
     , githubUserAvatarUrl :: Text
     }
 
 instance FromJSON GithubUser where
-    parseJSON (Object o) =
-        GithubUser <$> o .: "id"
-                   <*> o .:? "name"
-                   <*> o .: "login"
-                   <*> o .: "avatar_url"
+    parseJSON (Object o) = GithubUser
+        <$> o .: "id"
+        <*> o .:? "name"
+        <*> o .: "login"
+        <*> o .: "avatar_url"
 
     parseJSON _ = mzero
 
@@ -46,8 +47,8 @@ data GithubUserEmail = GithubUserEmail
     }
 
 instance FromJSON GithubUserEmail where
-    parseJSON (Object o) =
-        GithubUserEmail <$> o .: "email"
+    parseJSON (Object o) = GithubUserEmail
+        <$> o .: "email"
 
     parseJSON _ = mzero
 
@@ -63,14 +64,14 @@ oauth2GithubScoped :: YesodAuth m
              -> [Text] -- ^ List of scopes to request
              -> AuthPlugin m
 oauth2GithubScoped clientId clientSecret scopes = authOAuth2 "github" oauth fetchGithubProfile
-    where
-        oauth = OAuth2
-                { oauthClientId            = encodeUtf8 clientId
-                , oauthClientSecret        = encodeUtf8 clientSecret
-                , oauthOAuthorizeEndpoint  = encodeUtf8 $ "https://github.com/login/oauth/authorize?scope=" <> T.intercalate "," scopes
-                , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token"
-                , oauthCallback            = Nothing
-                }
+  where
+    oauth = OAuth2
+        { oauthClientId = encodeUtf8 clientId
+        , oauthClientSecret = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://github.com/login/oauth/authorize?scope=" <> T.intercalate "," scopes
+        , oauthAccessTokenEndpoint = "https://github.com/login/oauth/access_token"
+        , oauthCallback = Nothing
+        }
 
 fetchGithubProfile :: Manager -> AccessToken -> IO (Creds m)
 fetchGithubProfile manager token = do
@@ -84,14 +85,17 @@ fetchGithubProfile manager token = do
         (_, Left err) -> throwIO $ InvalidProfileResponse "github" err
 
 toCreds :: GithubUser -> [GithubUserEmail] -> AccessToken -> Creds m
-toCreds user userMail token = Creds "github"
-    (T.pack $ show $ githubUserId user)
-    cExtra
-    where
-        cExtra = [ ("email", githubUserEmail $ head userMail)
-                 , ("login", githubUserLogin user)
-                 , ("avatar_url", githubUserAvatarUrl user)
-                 , ("access_token", decodeUtf8 $ accessToken token)
-                 ] ++ (maybeName $ githubUserName user)
-        maybeName Nothing     = []
-        maybeName (Just name) = [("name", name)]
+toCreds user userMail token = Creds
+    { credsPlugin = "github"
+    , credsIdent = T.pack $ show $ githubUserId user
+    , credsExtra =
+        [ ("email", githubUserEmail $ head userMail)
+        , ("login", githubUserLogin user)
+        , ("avatar_url", githubUserAvatarUrl user)
+        , ("access_token", decodeUtf8 $ accessToken token)
+        ] ++ maybeName (githubUserName user)
+    }
+
+  where
+    maybeName Nothing = []
+    maybeName (Just name) = [("name", name)]

Yesod/Auth/OAuth2/Spotify.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
-
+-- |
+--
+-- OAuth2 plugin for http://spotify.com
+--
 module Yesod.Auth.OAuth2.Spotify
     ( oauth2Spotify
     , module Yesod.Auth.OAuth2
@@ -16,6 +19,7 @@ import Data.Text.Encoding (encodeUtf8)
 import Network.HTTP.Conduit(Manager)
 import Yesod.Auth
 import Yesod.Auth.OAuth2
+
 import qualified Data.ByteString as B
 import qualified Data.Text as T
 
@@ -26,49 +30,50 @@ data SpotifyUserImage = SpotifyUserImage
     }
 
 instance FromJSON SpotifyUserImage where
-    parseJSON (Object v) = SpotifyUserImage <$>
-                           v .: "height" <*>
-                           v .: "width" <*>
-                           v .: "url"
+    parseJSON (Object v) = SpotifyUserImage
+        <$> v .: "height"
+        <*> v .: "width"
+        <*> v .: "url"
 
     parseJSON _ = mzero
 
 data SpotifyUser = SpotifyUser
-    { spotifyUserId          :: Text
-    , spotifyUserHref        :: Text
-    , spotifyUserUri         :: Text
+    { spotifyUserId :: Text
+    , spotifyUserHref :: Text
+    , spotifyUserUri :: Text
     , spotifyUserDisplayName :: Maybe Text
-    , spotifyUserProduct     :: Maybe Text
-    , spotifyUserCountry     :: Maybe Text
-    , spotifyUserEmail       :: Maybe Text
-    , spotifyUserImages      :: Maybe [SpotifyUserImage]
+    , spotifyUserProduct :: Maybe Text
+    , spotifyUserCountry :: Maybe Text
+    , spotifyUserEmail :: Maybe Text
+    , spotifyUserImages :: Maybe [SpotifyUserImage]
     }
 
 instance FromJSON SpotifyUser where
-    parseJSON (Object v) = SpotifyUser <$>
-                           v .: "id" <*>
-                           v .: "href" <*>
-                           v .: "uri" <*>
-                           v .:? "display_name" <*>
-                           v .:? "product" <*>
-                           v .:? "country" <*>
-                           v .:? "email" <*>
-                           v .:? "images"
+    parseJSON (Object v) = SpotifyUser
+        <$> v .: "id"
+        <*> v .: "href"
+        <*> v .: "uri"
+        <*> v .:? "display_name"
+        <*> v .:? "product"
+        <*> v .:? "country"
+        <*> v .:? "email"
+        <*> v .:? "images"
+
     parseJSON _ = mzero
 
 oauth2Spotify :: YesodAuth m
-             => Text -- ^ Client ID
-             -> Text -- ^ Client Secret
-             -> [ByteString] -- ^ Scopes
-             -> AuthPlugin m
+              => Text -- ^ Client ID
+              -> Text -- ^ Client Secret
+              -> [ByteString] -- ^ Scopes
+              -> AuthPlugin m
 oauth2Spotify clientId clientSecret scope = authOAuth2 "spotify"
-    (OAuth2
-        { oauthClientId            = encodeUtf8 clientId
-        , oauthClientSecret        = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint  = B.append "https://accounts.spotify.com/authorize?scope=" (B.intercalate "%20" scope)
+    OAuth2
+        { oauthClientId = encodeUtf8 clientId
+        , oauthClientSecret = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint = B.append "https://accounts.spotify.com/authorize?scope=" (B.intercalate "%20" scope)
         , oauthAccessTokenEndpoint = "https://accounts.spotify.com/api/token"
-        , oauthCallback            = Nothing
-        })
+        , oauthCallback = Nothing
+        }
     fetchSpotifyProfile
 
 fetchSpotifyProfile :: Manager -> AccessToken -> IO (Creds m)
@@ -79,9 +84,11 @@ fetchSpotifyProfile manager token = do
         Left err -> throwIO $ InvalidProfileResponse "spotify" err
 
 toCreds :: SpotifyUser -> Creds m
-toCreds user = Creds "spotify"
-    (spotifyUserId user)
-    (mapMaybe getExtra extrasTemplate)
+toCreds user = Creds
+    { credsPlugin = "spotify"
+    , credsIdent = spotifyUserId user
+    , credsExtra = mapMaybe getExtra extrasTemplate
+    }
 
   where
     userImage :: Maybe SpotifyUserImage
@@ -90,18 +97,15 @@ toCreds user = Creds "spotify"
     userImagePart :: (SpotifyUserImage -> Maybe a) -> Maybe a
     userImagePart getter = userImage >>= getter
 
-    extrasTemplate = [ ("href"        , Just $ spotifyUserHref user)
-                     , ("uri"         , Just $ spotifyUserUri user)
+    extrasTemplate = [ ("href", Just $ spotifyUserHref user)
+                     , ("uri", Just $ spotifyUserUri user)
                      , ("display_name", spotifyUserDisplayName user)
-                     , ("product"     , spotifyUserProduct user)
-                     , ("country"     , spotifyUserCountry user)
-                     , ("email"       , spotifyUserEmail user)
-                     , ("image_url"   , userImage >>=
-                                        return . spotifyUserImageUrl)
-                     , ("image_height", userImagePart spotifyUserImageHeight >>=
-                                        return . T.pack . show)
-                     , ("image_width" , userImagePart spotifyUserImageWidth >>=
-                                        return . T.pack . show)
+                     , ("product", spotifyUserProduct user)
+                     , ("country", spotifyUserCountry user)
+                     , ("email", spotifyUserEmail user)
+                     , ("image_url", spotifyUserImageUrl <$> userImage)
+                     , ("image_height", T.pack . show <$> userImagePart spotifyUserImageHeight)
+                     , ("image_width", T.pack . show <$> userImagePart spotifyUserImageWidth)
                      ]
 
     getExtra :: (Text, Maybe Text) -> Maybe (Text, Text)

Yesod/Auth/OAuth2/Upcase.hs

@@ -24,26 +24,26 @@ import Network.HTTP.Conduit(Manager)
 import qualified Data.Text as T
 
 data UpcaseUser = UpcaseUser
-    { upcaseUserId        :: Int
+    { upcaseUserId :: Int
     , upcaseUserFirstName :: Text
-    , upcaseUserLastName  :: Text
-    , upcaseUserEmail     :: Text
+    , upcaseUserLastName :: Text
+    , upcaseUserEmail :: Text
     }
 
 instance FromJSON UpcaseUser where
-    parseJSON (Object o) =
-        UpcaseUser <$> o .: "id"
-                  <*> o .: "first_name"
-                  <*> o .: "last_name"
-                  <*> o .: "email"
+    parseJSON (Object o) = UpcaseUser
+        <$> o .: "id"
+        <*> o .: "first_name"
+        <*> o .: "last_name"
+        <*> o .: "email"
 
     parseJSON _ = mzero
 
 data UpcaseResponse = UpcaseResponse UpcaseUser
 
 instance FromJSON UpcaseResponse where
-    parseJSON (Object o) =
-        UpcaseResponse <$> o .: "user"
+    parseJSON (Object o) = UpcaseResponse
+        <$> o .: "user"
 
     parseJSON _ = mzero
 
@@ -53,11 +53,11 @@ oauth2Upcase :: YesodAuth m
             -> AuthPlugin m
 oauth2Upcase clientId clientSecret = authOAuth2 "upcase"
     OAuth2
-        { oauthClientId            = encodeUtf8 clientId
-        , oauthClientSecret        = encodeUtf8 clientSecret
-        , oauthOAuthorizeEndpoint  = "http://upcase.com/oauth/authorize"
+        { oauthClientId = encodeUtf8 clientId
+        , oauthClientSecret = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint = "http://upcase.com/oauth/authorize"
         , oauthAccessTokenEndpoint = "http://upcase.com/oauth/token"
-        , oauthCallback            = Nothing
+        , oauthCallback = Nothing
         }
     fetchUpcaseProfile
 
@@ -70,9 +70,12 @@ fetchUpcaseProfile manager token = do
         Left err -> throwIO $ InvalidProfileResponse "upcase" err
 
 toCreds :: UpcaseUser -> Creds m
-toCreds user = Creds "upcase"
-    (T.pack $ show $ upcaseUserId user)
-    [ ("first_name", upcaseUserFirstName user)
-    , ("last_name" , upcaseUserLastName user)
-    , ("email"     , upcaseUserEmail user)
-    ]
+toCreds user = Creds
+    { credsPlugin = "upcase"
+    , credsIdent = T.pack $ show $ upcaseUserId user
+    , credsExtra =
+        [ ("first_name", upcaseUserFirstName user)
+        , ("last_name" , upcaseUserLastName user)
+        , ("email"     , upcaseUserEmail user)
+        ]
+    }