OneDrive.hs

{-# 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")]