Add Yandexyandex

https://tech.yandex.com/oauth/

5 files changed, 96 insertions, 2 deletions

diff --git a/LICENSE b/LICENSE
index f754880..0e57558 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,5 @@
 Copyright (c) 2016, Zalora South East Asia Pte. Ltd
+Copyright (c) 2017, Igor Pashev <pashev.igor@gmail.com>
 
 Permission is hereby granted, free of charge, to any person obtaining
 a copy of this software and associated documentation files (the
diff --git a/sproxy.example.yml b/sproxy.example.yml
index 87b1f59..5a00735 100644
--- a/sproxy.example.yml
+++ b/sproxy.example.yml
@@ -121,7 +121,8 @@ ssl_key: /path/key.pem
 #   client_id     - OAuth2 client ID.
 #   client_secret - OAuth2 client secret.
 #
-# Example:
+# Examples:
+#
 # oauth2:
 #   google:
 #     client_id: "XXXXXXXXXXXX-YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY.apps.googleusercontent.com"
@@ -131,6 +132,10 @@ ssl_key: /path/key.pem
 #     client_id: "xxxxxxxxxxxxxx"
 #     client_secret: !include "/run/keys/xxxxxxxxxxxxxx"
 #
+#   yandex:
+#     client_id: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+#     client_secret: yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy
+#
 #
 # oauth2:
 #   google:
diff --git a/sproxy2.cabal b/sproxy2.cabal
index e0f4375..682517a 100644
--- a/sproxy2.cabal
+++ b/sproxy2.cabal
@@ -10,7 +10,9 @@ license: MIT
 license-file: LICENSE
 author: Igor Pashev <pashev.igor@gmail.com>
 maintainer: Igor Pashev <pashev.igor@gmail.com>
-copyright: 2016, Zalora South East Asia Pte. Ltd
+copyright:
+  2016-2017, Zalora South East Asia Pte. Ltd;
+  2017, Igor Pashev <pashev.igor@gmail.com>
 category: Databases, Web
 build-type: Simple
 cabal-version: >= 1.20
@@ -38,6 +40,7 @@ executable sproxy2
       Sproxy.Application.OAuth2.Common
       Sproxy.Application.OAuth2.Google
       Sproxy.Application.OAuth2.LinkedIn
+      Sproxy.Application.OAuth2.Yandex
       Sproxy.Application.State
       Sproxy.Config
       Sproxy.Logging
diff --git a/src/Sproxy/Application/OAuth2.hs b/src/Sproxy/Application/OAuth2.hs
index 0f7d6e8..1dec94d 100644
--- a/src/Sproxy/Application/OAuth2.hs
+++ b/src/Sproxy/Application/OAuth2.hs
@@ -9,10 +9,12 @@ import Data.Text (Text)
 import Sproxy.Application.OAuth2.Common (OAuth2Provider)
 import qualified Sproxy.Application.OAuth2.Google as Google
 import qualified Sproxy.Application.OAuth2.LinkedIn as LinkedIn
+import qualified Sproxy.Application.OAuth2.Yandex as Yandex
 
 providers :: HashMap Text OAuth2Provider
 providers = fromList [
     ("google"   , Google.provider)
   , ("linkedin" , LinkedIn.provider)
+  , ("yandex" , Yandex.provider)
   ]
 
diff --git a/src/Sproxy/Application/OAuth2/Yandex.hs b/src/Sproxy/Application/OAuth2/Yandex.hs
new file mode 100644
index 0000000..e943a39
--- /dev/null
+++ b/src/Sproxy/Application/OAuth2/Yandex.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Sproxy.Application.OAuth2.Yandex
+  ( provider
+  ) where
+
+import Control.Applicative (empty)
+import Control.Exception (Exception, throwIO)
+import Data.Aeson
+       (FromJSON, Value(Object), (.:), decode, parseJSON)
+import Data.ByteString.Lazy (ByteString)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Typeable (Typeable)
+import qualified Network.HTTP.Conduit as H
+import Network.HTTP.Types.URI (urlEncode)
+
+import Sproxy.Application.Cookie
+       (newUser, setFamilyName, setGivenName)
+import Sproxy.Application.OAuth2.Common
+       (AccessTokenBody(accessToken), OAuth2Client(..), OAuth2Provider)
+
+provider :: OAuth2Provider
+provider (client_id, client_secret) =
+  OAuth2Client
+  { oauth2Description = "Yandex"
+  , oauth2AuthorizeURL =
+      \state _redirect_uri ->
+        "https://oauth.yandex.ru/authorize" <> "?state=" <> urlEncode True state <>
+        "&client_id=" <>
+        urlEncode True client_id <>
+        "&response_type=code" <>
+        "&force_confirm=yes"
+  , oauth2Authenticate =
+      \code _redirect_uri -> do
+        let treq =
+              H.urlEncodedBody
+                [ ("grant_type", "authorization_code")
+                , ("client_id", client_id)
+                , ("client_secret", client_secret)
+                , ("code", code)
+                ] $
+              H.parseRequest_ "POST https://oauth.yandex.ru/token"
+        mgr <- H.newManager H.tlsManagerSettings
+        tresp <- H.httpLbs treq mgr
+        case decode $ H.responseBody tresp of
+          Nothing -> throwIO $ YandexException tresp
+          Just atResp -> do
+            let ureq =
+                  (H.parseRequest_ "https://login.yandex.ru/info?format=json")
+                  { H.requestHeaders =
+                      [ ( "Authorization"
+                        , "OAuth " <> encodeUtf8 (accessToken atResp))
+                      ]
+                  }
+            uresp <- H.httpLbs ureq mgr
+            case decode $ H.responseBody uresp of
+              Nothing -> throwIO $ YandexException uresp
+              Just u ->
+                return $
+                setFamilyName (lastName u) $
+                setGivenName (firstName u) $ newUser (defaultEmail u)
+  }
+
+data YandexException =
+  YandexException (H.Response ByteString)
+  deriving (Show, Typeable)
+
+instance Exception YandexException
+
+data YandexUserInfo = YandexUserInfo
+  { defaultEmail :: Text
+  , firstName :: Text
+  , lastName :: Text
+  } deriving (Eq, Show)
+
+instance FromJSON YandexUserInfo where
+  parseJSON (Object v) =
+    YandexUserInfo <$> v .: "default_email" <*> v .: "first_name" <*>
+    v .: "last_name"
+  parseJSON _ = empty