Created
August 5, 2015 15:25
-
-
Save liangzan/ed550b428bf6f5d2c19c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
module Main where | |
import Keys (oneDriveKey) | |
import Network.OAuth.OAuth2 | |
import Control.Monad (liftM) | |
import Data.Aeson (FromJSON) | |
import Data.Aeson.TH (defaultOptions, deriveJSON) | |
import qualified Data.ByteString.Char8 as BS | |
import qualified Data.ByteString.Lazy.Internal as BL | |
import Data.Text (Text) | |
import Network.HTTP.Conduit | |
import Prelude hiding (id) | |
import qualified Prelude as P (id) | |
import System.Environment (getArgs) | |
-------------------------------------------------- | |
data Token = Token { issued_to :: Text | |
, audience :: Text | |
, user_id :: Maybe Text | |
, scope :: Text | |
, expires_in :: Integer | |
-- , email :: Maybe Text | |
-- , verified_email :: Maybe Bool | |
, access_type :: Text | |
} deriving (Show) | |
$(deriveJSON defaultOptions ''Token) | |
data User = User { id :: Text | |
, name :: Text | |
, given_name :: Text | |
, family_name :: Text | |
, link :: Text | |
, picture :: Text | |
, gender :: Text | |
, birthday :: Text | |
, locale :: Text | |
} deriving (Show) | |
$(deriveJSON defaultOptions ''User) | |
-------------------------------------------------- | |
main :: IO () | |
main = do | |
mgr <- newManager conduitManagerSettings | |
offlineCase mgr | |
closeManager mgr | |
offlineCase :: Manager -> IO () | |
offlineCase mgr = do | |
BS.putStrLn $ authorizationUrl oneDriveKey `appendQueryParam` oneDriveScope | |
putStrLn "visit the url and paste code here: " | |
code <- fmap BS.pack getLine | |
(Right token) <- fetchAccessToken mgr oneDriveKey code | |
f token | |
-- | |
-- obtain a new access token with refresh token, which turns out only in response at first time. | |
-- Revoke Access https://www.google.com/settings/security | |
-- | |
case refreshToken token of | |
Nothing -> putStrLn "Failed to fetch refresh token" | |
Just tk -> do | |
(Right token') <- fetchRefreshToken mgr oneDriveKey tk | |
f token' | |
where f token = do | |
print token | |
oneDriveScope :: QueryParams | |
oneDriveScope = [("scope", "onedrive.readwrite,wl.offline_access")] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment