{-|
Module      : GoPro.Plus.Auth
Description : Functionality for authenticating to GoPro Plus.
Copyright   : (c) Dustin Sallings, 2020
License     : BSD3
Maintainer  : dustin@spy.net
Stability   : experimental

GoPro Plus authentication.
-}

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

module GoPro.Plus.Auth (
  authenticate, refreshAuth,
  AuthInfo(..), access_token, expires_in, refresh_token, resource_owner_id,
  HasGoProAuth(..), withAuth, AuthReader, Token
  ) where

import           Control.Lens
import           Control.Monad.IO.Class   (MonadIO (..))
import           Control.Monad.Reader     (ReaderT (..), ask, runReaderT)
import           Data.Aeson               (FromJSON (..), genericParseJSON)
import           Data.Text                (Text)
import           Generics.Deriving.Base   (Generic)
import           Network.Wreq             (FormParam (..))


import           GoPro.Plus.Internal.HTTP

apiClientID, apiClientSecret :: String
apiClientID :: String
apiClientID = String
"71611e67ea968cfacf45e2b6936c81156fcf5dbe553a2bf2d342da1562d05f46"
apiClientSecret :: String
apiClientSecret = String
"3863c9b438c07b82f39ab3eeeef9c24fefa50c6856253e3f1d37e0e3b1ead68d"

authURL :: String
authURL :: String
authURL = String
"https://api.gopro.com/v1/oauth2/token"

type Token = Text

-- | An Authentication response.
data AuthInfo = AuthInfo {
  AuthInfo -> Token
_access_token        :: Token
  , AuthInfo -> Int
_expires_in        :: Int
  , AuthInfo -> Token
_refresh_token     :: Text
  , AuthInfo -> Token
_resource_owner_id :: Text
  } deriving((forall x. AuthInfo -> Rep AuthInfo x)
-> (forall x. Rep AuthInfo x -> AuthInfo) -> Generic AuthInfo
forall x. Rep AuthInfo x -> AuthInfo
forall x. AuthInfo -> Rep AuthInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthInfo x -> AuthInfo
$cfrom :: forall x. AuthInfo -> Rep AuthInfo x
Generic, Int -> AuthInfo -> ShowS
[AuthInfo] -> ShowS
AuthInfo -> String
(Int -> AuthInfo -> ShowS)
-> (AuthInfo -> String) -> ([AuthInfo] -> ShowS) -> Show AuthInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthInfo] -> ShowS
$cshowList :: [AuthInfo] -> ShowS
show :: AuthInfo -> String
$cshow :: AuthInfo -> String
showsPrec :: Int -> AuthInfo -> ShowS
$cshowsPrec :: Int -> AuthInfo -> ShowS
Show)

-- | A Monad may have a 'HasGoProAuth' instance to indicate it knows
-- how to authenticate against the GoPro Plus service.
class Monad m => HasGoProAuth m where
  -- | Get the GoPro 'AuthInfo' to use.
  goproAuth :: m AuthInfo

instance FromJSON AuthInfo where
  parseJSON :: Value -> Parser AuthInfo
parseJSON = Options -> Value -> Parser AuthInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOpts

makeLenses ''AuthInfo

-- | Authenticate against the GoPro Plus service.
authenticate :: MonadIO m
             => String -- ^ Email/username
             -> String -- ^ Password
             -> m AuthInfo
authenticate :: String -> String -> m AuthInfo
authenticate String
username String
password =
  Options -> String -> [FormParam] -> m AuthInfo
forall (m :: * -> *) a r.
(MonadIO m, Postable a, FromJSON r) =>
Options -> String -> a -> m r
jpostWith Options
defOpts String
authURL [ByteString
"grant_type" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (String
"password" :: String),
                             ByteString
"client_id" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
apiClientID,
                             ByteString
"client_secret" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
apiClientSecret,
                             ByteString
"scope" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (String
"root root:channels public me upload media_library_beta live" :: String),
                             ByteString
"username" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
username,
                             ByteString
"password" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
password]

-- | Refresh authentication credentials using a refresh token.
refreshAuth :: MonadIO m => AuthInfo -> m AuthInfo
refreshAuth :: AuthInfo -> m AuthInfo
refreshAuth AuthInfo{Int
Token
_resource_owner_id :: Token
_refresh_token :: Token
_expires_in :: Int
_access_token :: Token
_resource_owner_id :: AuthInfo -> Token
_refresh_token :: AuthInfo -> Token
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Token
..} =
  Options -> String -> [FormParam] -> m AuthInfo
forall (m :: * -> *) a r.
(MonadIO m, Postable a, FromJSON r) =>
Options -> String -> a -> m r
jpostWith Options
defOpts String
authURL [ByteString
"grant_type" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (String
"refresh_token" :: String),
                             ByteString
"client_id" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
apiClientID,
                             ByteString
"client_secret" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
apiClientSecret,
                             ByteString
"refresh_token" ByteString -> Token -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Token
_refresh_token]

-- | AuthReader is a convenience type that's useful for doing small
-- experiments where you don't already have your own Reader or
-- similar.  e.g., in ghci you might type:
--
-- > (m :: Medium) <- withAuth (AuthInfo accessToken 0 "" "") $ medium mediumID
type AuthReader = ReaderT AuthInfo

instance Monad m => HasGoProAuth (AuthReader m) where
  goproAuth :: AuthReader m AuthInfo
goproAuth = AuthReader m AuthInfo
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Convenient function for passing around auth info.  You probably
-- don't want to uset his, but it can be convenient when
-- experimenting.
withAuth :: AuthInfo -> AuthReader m a -> m a
withAuth :: AuthInfo -> AuthReader m a -> m a
withAuth = (AuthReader m a -> AuthInfo -> m a)
-> AuthInfo -> AuthReader m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AuthReader m a -> AuthInfo -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT