{-|
Module:      Tesla.Auth
Description: Tesla Authentication structures.

Authentication related data structures.
-}

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Tesla.Auth (AuthInfo(..),
                   clientID, clientSecret, email, password, bearerToken,
                   fromToken,
                   AuthResponse(..), access_token, expires_in, refresh_token,
                   HasTeslaAuth(..)
                  ) where

import           Control.Lens
import           Data.Aeson             (FromJSON (..), Options, ToJSON (..), defaultOptions, fieldLabelModifier,
                                         genericParseJSON, genericToJSON)
import           Generics.Deriving.Base (Generic)

-- | An Authentication request.
data AuthInfo = AuthInfo {
  AuthInfo -> String
_clientID       :: String
  , AuthInfo -> String
_clientSecret :: String
  , AuthInfo -> String
_email        :: String
  , AuthInfo -> String
_password     :: String
  , AuthInfo -> String
_bearerToken  :: String
  } deriving(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)

makeLenses ''AuthInfo

-- | Get an AuthInfo instance from a bearer token.
fromToken :: String -> AuthInfo
fromToken :: String -> AuthInfo
fromToken String
t = AuthInfo :: String -> String -> String -> String -> String -> AuthInfo
AuthInfo{_bearerToken :: String
_bearerToken=String
t, _clientID :: String
_clientID=String
"", _clientSecret :: String
_clientSecret=String
"", _email :: String
_email=String
"", _password :: String
_password=String
""}

jsonOpts :: Data.Aeson.Options
jsonOpts :: Options
jsonOpts = Options
defaultOptions {
  fieldLabelModifier :: ShowS
fieldLabelModifier = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
  }

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

makeLenses ''AuthResponse

-- | A Monad may have a 'HasTeslaAuth' instance to indicate it knows
-- how to authenticate against the Tesla service.
class Monad m => HasTeslaAuth m where
  teslaAuth :: m AuthInfo

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

instance ToJSON AuthResponse where
  toJSON :: AuthResponse -> Value
toJSON = Options -> AuthResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts