Implement Nylas provider

Yesod/Auth/OAuth2/Nylas.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Yesod.Auth.OAuth2.Nylas
+    ( oauth2Nylas
+    , module Yesod.Auth.OAuth2
+    ) where
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>), (<*>))
+#endif
+
+import Control.Monad (mzero)
+import Control.Exception.Lifted (throwIO)
+import Data.Aeson (FromJSON, Value(..), parseJSON, decode, (.:))
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import Data.Vector ((!?))
+import Network.HTTP.Client (applyBasicAuth, parseUrl, httpLbs, responseStatus, responseBody)
+import Network.HTTP.Conduit (Manager)
+
+import Yesod.Auth
+import Yesod.Auth.OAuth2
+
+import qualified Data.Text as T
+import qualified Network.HTTP.Types as HT
+
+data NylasNamespace = NylasNamespace
+    { nylasNamespaceId :: Text
+    , nylasNamespaceAccountId :: Text
+    , nylasNamespaceEmailAddress :: Text
+    , nylasNamespaceName :: Text
+    , nylasNamespaceProvider :: Text
+    , nylasNamespaceOrganizationUnit :: Text
+    }
+
+instance FromJSON NylasNamespace where
+    parseJSON (Array singleton) = case singleton !? 0 of
+        Just (Object o) -> NylasNamespace
+            <$> o .: "id"
+            <*> o .: "account_id"
+            <*> o .: "email_address"
+            <*> o .: "name"
+            <*> o .: "provider"
+            <*> o .: "organization_unit"
+        _ -> mzero
+    parseJSON _ = mzero
+
+oauth2Nylas :: YesodAuth m
+            => Text -- ^ Client ID
+            -> Text -- ^ Client Secret
+            -> AuthPlugin m
+oauth2Nylas clientId clientSecret = oauth2NylasScoped clientId clientSecret ["email"]
+
+oauth2NylasScoped :: YesodAuth m
+                  => Text -- ^ Client ID
+                  -> Text -- ^ Client Secret
+                  -> [Text] -- ^ Scopes
+                  -> AuthPlugin m
+oauth2NylasScoped clientId clientSecret scopes = authOAuth2 "nylas" oauth fetchCreds
+  where
+    oauth = OAuth2
+        { oauthClientId = encodeUtf8 clientId
+        , oauthClientSecret = encodeUtf8 clientSecret
+        , oauthOAuthorizeEndpoint = encodeUtf8 $ "https://api.nylas.com/oauth/authorize?scope=" <> T.intercalate "," scopes
+        , oauthAccessTokenEndpoint = "https://api.nylas.com/oauth/token"
+        , oauthCallback = Nothing
+        }
+
+fetchCreds :: Manager -> AccessToken -> IO (Creds a)
+fetchCreds manager token = do
+    req <- applyBasicAuth (accessToken token) "" <$> parseUrl "https://api.nylas.com/n"
+    resp <- httpLbs req manager
+    if HT.statusIsSuccessful (responseStatus resp)
+        then case decode (responseBody resp) of
+            Just ns -> return $ toCreds ns token
+            Nothing -> throwIO $ InvalidProfileResponse "nylas" "failed to parse namespace"
+        else throwIO $ InvalidProfileResponse "nylas" "failed to get namespace"
+
+toCreds :: NylasNamespace -> AccessToken -> Creds a
+toCreds ns token = Creds
+    { credsPlugin = "nylas"
+    , credsIdent = nylasNamespaceId ns
+    , credsExtra =
+        [ ("account_id", nylasNamespaceAccountId ns)
+        , ("email_address", nylasNamespaceEmailAddress ns)
+        , ("name", nylasNamespaceName ns)
+        , ("provider", nylasNamespaceProvider ns)
+        , ("organization_unit", nylasNamespaceOrganizationUnit ns)
+        , ("access_token", decodeUtf8 $ accessToken token)
+        ]
+    }

yesod-auth-oauth2.cabal

@@ -24,6 +24,7 @@ library
 
     build-depends:   base                    >= 4.5       && < 5
                    , bytestring              >= 0.9.1.4
+                   , http-client             >= 0.4.0     && < 0.5
                    , http-conduit            >= 2.0       && < 3.0
                    , http-types              >= 0.8       && < 0.9
                    , aeson                   >= 0.6       && < 0.10
@@ -36,6 +37,7 @@ library
                    , transformers            >= 0.2.2     && < 0.5
                    , hoauth2                 >= 0.4.7     && < 0.5
                    , lifted-base             >= 0.2       && < 0.4
+                   , vector                  >= 0.10      && < 0.11
 
     exposed-modules: Yesod.Auth.OAuth2
                      Yesod.Auth.OAuth2.Github
@@ -44,6 +46,7 @@ library
                      Yesod.Auth.OAuth2.Twitter
                      Yesod.Auth.OAuth2.Upcase
                      Yesod.Auth.OAuth2.EveOnline
+                     Yesod.Auth.OAuth2.Nylas
 
     ghc-options:     -Wall