Implement different exceptions for different cases

I had hoped to get away from this entirely, to an Either-based
interface, but that seems to be stalling as an initiative. So in the
meantime, let's at least make our exceptions more meaningful.

src/Yesod/Auth/OAuth2/Exception.hs

@@ -5,15 +5,25 @@ module Yesod.Auth.OAuth2.Exception
     ) where
 
 import Control.Exception.Safe
-import qualified Data.ByteString.Lazy as BL
+import Data.ByteString.Lazy (ByteString)
 import Data.Text (Text)
 
--- | Provider name and error
---
--- The error is a lazy bytestring because it's most often encoded JSON.
---
--- Deprecated. Eventually, we'll return @Either@s all the way up.
---
-data YesodOAuth2Exception = InvalidProfileResponse Text BL.ByteString
+data YesodOAuth2Exception
+    = OAuth2Error Text ByteString
+    -- ^ HTTP error during OAuth2 handshake
+    --
+    -- Plugin name and JSON-encoded @OAuth2Error@ from @hoauth2@.
+    --
+    | JSONDecodingError Text String
+    -- ^ User profile was not as expected
+    --
+    -- Plugin name and Aeson parse error message.
+    --
+    | GenericError Text String
+    -- ^ Other error conditions
+    --
+    -- Plugin name and error message.
+    --
     deriving (Show, Typeable)
+
 instance Exception YesodOAuth2Exception

src/Yesod/Auth/OAuth2/Nylas.hs

@@ -10,6 +10,7 @@ import Control.Monad (unless)
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import Network.HTTP.Client
 import qualified Network.HTTP.Types as HT
+import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
 
 newtype User = User Text
 
@@ -34,31 +35,34 @@ oauth2Nylas clientId clientSecret =
         -- FIXME: was this working? I'm 95% sure that the client will throw its
         -- own exception on unsuccessful status codes.
         unless (HT.statusIsSuccessful $ responseStatus resp)
-            $ throwIO $ InvalidProfileResponse pluginName
-            $ "Unsuccessful HTTP response: " <> userResponse
-
+            $ throwIO
+            $ YesodOAuth2Exception.GenericError pluginName
+            $ "Unsuccessful HTTP response: "
+            <> BL8.unpack userResponse
 
         either
-            (throwIO . InvalidProfileResponse pluginName . BL8.pack)
-            (\(User userId) -> pure Creds
-                { credsPlugin = pluginName
-                , credsIdent = userId
-                , credsExtra = setExtra token userResponse
-                }
-            )
+                (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
+                (\(User userId) -> pure Creds
+                    { credsPlugin = pluginName
+                    , credsIdent = userId
+                    , credsExtra = setExtra token userResponse
+                    }
+                )
             $ eitherDecode userResponse
   where
     oauth = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
-        , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize" `withQuery`
-            [ ("response_type", "code")
-            , ("client_id", encodeUtf8 clientId)
+        , oauthOAuthorizeEndpoint = "https://api.nylas.com/oauth/authorize"
+            `withQuery` [ ("response_type", "code")
+                        , ( "client_id"
+                          , encodeUtf8 clientId
+                          )
             -- N.B. The scopes delimeter is unknown/untested. Verify that before
             -- extracting this to an argument and offering a Scoped function. In
             -- its current state, it doesn't matter because it's only one scope.
-            , scopeParam "," defaultScopes
-            ]
+                        , scopeParam "," defaultScopes
+                        ]
         , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
         , oauthCallback = Nothing
         }

src/Yesod/Auth/OAuth2/Prelude.hs

@@ -52,7 +52,6 @@ module Yesod.Auth.OAuth2.Prelude
     , module URI.ByteString.Extension
 
     -- * Temporary, until I finish re-structuring modules
-    , YesodOAuth2Exception(..)
     , authOAuth2
     , authOAuth2Widget
     ) where
@@ -61,7 +60,6 @@ import Control.Exception.Safe
 import Data.Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Char8 as BL8
 import Data.Semigroup ((<>))
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -72,7 +70,7 @@ import URI.ByteString
 import URI.ByteString.Extension
 import Yesod.Auth
 import Yesod.Auth.OAuth2
-import Yesod.Auth.OAuth2.Exception
+import qualified Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
 
 -- | Retrieve a user's profile as JSON
 --
@@ -92,18 +90,17 @@ authGetProfile name manager token url = do
     decoded <- fromAuthJSON name resp
     pure (decoded, resp)
 
--- | Throws a @Left@ result as an @'InvalidProfileResponse'@
+-- | Throws a @Left@ result as an @'YesodOAuth2Exception'@
 fromAuthGet
     :: Text -> Either (OAuth2Error Value) BL.ByteString -> IO BL.ByteString
 fromAuthGet _ (Right bs) = pure bs -- nice
 fromAuthGet name (Left err) =
-    throwIO $ InvalidProfileResponse name $ encode err
+    throwIO $ YesodOAuth2Exception.OAuth2Error name $ encode err
 
--- | Throws a decoding error as an @'InvalidProfileResponse'@
+-- | Throws a decoding error as an @'YesodOAuth2Exception'@
 fromAuthJSON :: FromJSON a => Text -> BL.ByteString -> IO a
 fromAuthJSON name =
-    -- FIXME: unique exception constructors
-    either (throwIO . InvalidProfileResponse name . BL8.pack) pure
+    either (throwIO . YesodOAuth2Exception.JSONDecodingError name) pure
         . eitherDecode
 
 -- | A tuple of @\"scope\"@ and the given scopes separated by a delimiter

src/Yesod/Auth/OAuth2/Slack.hs

@@ -15,6 +15,7 @@ import Yesod.Auth.OAuth2.Prelude
 
 import Network.HTTP.Client
     (httpLbs, parseUrlThrow, responseBody, setQueryString)
+import Yesod.Auth.OAuth2.Exception as YesodOAuth2Exception
 
 data SlackScope
     = SlackBasicScope
@@ -53,21 +54,20 @@ oauth2SlackScoped scopes clientId clientSecret =
         userResponse <- responseBody <$> httpLbs req manager
 
         either
-            (const $ throwIO $ InvalidProfileResponse pluginName userResponse)
-            (\(User userId) -> pure Creds
-                { credsPlugin = pluginName
-                , credsIdent = userId
-                , credsExtra = setExtra token userResponse
-                }
-            )
+                (throwIO . YesodOAuth2Exception.JSONDecodingError pluginName)
+                (\(User userId) -> pure Creds
+                    { credsPlugin = pluginName
+                    , credsIdent = userId
+                    , credsExtra = setExtra token userResponse
+                    }
+                )
             $ eitherDecode userResponse
   where
     oauth2 = OAuth2
         { oauthClientId = clientId
         , oauthClientSecret = clientSecret
-        , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize" `withQuery`
-            [ scopeParam "," $ map scopeText scopes
-            ]
+        , oauthOAuthorizeEndpoint = "https://slack.com/oauth/authorize"
+            `withQuery` [scopeParam "," $ map scopeText scopes]
         , oauthAccessTokenEndpoint = "https://slack.com/api/oauth.access"
         , oauthCallback = Nothing
         }