{-|
Module:      Tesla
Description: Tesla API implementation.

'Tesla' is intended to provide access to all known Tesla APIs as
documented at https://www.teslaapi.io/
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}

module Tesla
    ( authenticate, refreshAuth, AuthResponse(..),
      Product(..), vehicleName, vehicleID, vehicleState,
      energyID, _ProductVehicle, _ProductEnergy, _ProductPowerwall,
      pwBatteryPower, pwCharged, pwEnergyLeft, pwID, pwName, pwTotal,
      VehicleID, vehicles, products, productsRaw,
      VehicleState(..), vsFromString,
      EnergyID, energyIDs,
      fromToken, authOpts, baseURL,
      decodeProducts
    ) where


import           Control.Lens
import           Control.Monad.IO.Class     (MonadIO (..))
import           Data.Aeson                 (FromJSON, Value (..), encode)
import           Data.Aeson.Lens            (_Array, _Double, _Integer, _String, key)
import           Data.Foldable              (asum)
import           Data.Map.Strict            (Map)
import qualified Data.Map.Strict            as Map
import           Data.Maybe                 (catMaybes)
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import           Network.Wreq               (Options, defaults, header)

import           Tesla.Auth
import           Tesla.Internal.HTTP

baseURL :: String
baseURL :: String
baseURL =  String
"https://owner-api.teslamotors.com/"
authRefreshURL :: String
authRefreshURL :: String
authRefreshURL = String
"https://auth.tesla.com/oauth2/v3/token"
productsURL :: String
productsURL :: String
productsURL = String
baseURL forall a. Semigroup a => a -> a -> a
<> String
"api/1/products"

{-# DEPRECATED authenticate "Tesla busted authentication pretty hard.  See https://github.com/dustin/tesla for more info." #-}

-- | Fail to authenticate to the Tesla service.
authenticate :: AuthInfo -> IO AuthResponse
authenticate :: AuthInfo -> IO AuthResponse
authenticate AuthInfo
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Tesla busted authentication pretty hard.  See https://github.com/dustin/tesla for more info."

-- | Refresh authentication credentials using a refresh token.
refreshAuth :: AuthResponse -> IO AuthResponse
refreshAuth :: AuthResponse -> IO AuthResponse
refreshAuth AuthResponse{Int
String
_refresh_token :: AuthResponse -> String
_expires_in :: AuthResponse -> Int
_access_token :: AuthResponse -> String
_refresh_token :: String
_expires_in :: Int
_access_token :: String
..} = do
  forall j a (m :: * -> *).
(FromJSON j, Postable a, MonadIO m) =>
Options -> String -> a -> m j
jpostWith Options
jOpts String
authRefreshURL (forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (forall a. Monoid a => a
mempty
                                                         forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"grant_type" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"refresh_token"
                                                         forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"client_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"ownerapi"
                                                         forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"refresh_token" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String (String -> Text
T.pack String
_refresh_token)
                                                         forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"scope" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"openid email offline_access"
                                                        ))

jOpts :: Options
jOpts :: Options
jOpts = Options
aOpts forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"content-type" forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/json"]

aOpts :: Options
aOpts :: Options
aOpts = Options
defaults forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"*/*"]

-- | A VehicleID.
type VehicleID = Text

-- | An energy site ID.
type EnergyID = Integer

-- | Possible states a vehicle may be in.
data VehicleState = VOnline | VOffline | VAsleep | VWaking | VUnknown
  deriving (Int -> VehicleState -> ShowS
[VehicleState] -> ShowS
VehicleState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VehicleState] -> ShowS
$cshowList :: [VehicleState] -> ShowS
show :: VehicleState -> String
$cshow :: VehicleState -> String
showsPrec :: Int -> VehicleState -> ShowS
$cshowsPrec :: Int -> VehicleState -> ShowS
Show, ReadPrec [VehicleState]
ReadPrec VehicleState
Int -> ReadS VehicleState
ReadS [VehicleState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VehicleState]
$creadListPrec :: ReadPrec [VehicleState]
readPrec :: ReadPrec VehicleState
$creadPrec :: ReadPrec VehicleState
readList :: ReadS [VehicleState]
$creadList :: ReadS [VehicleState]
readsPrec :: Int -> ReadS VehicleState
$creadsPrec :: Int -> ReadS VehicleState
Read, VehicleState -> VehicleState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VehicleState -> VehicleState -> Bool
$c/= :: VehicleState -> VehicleState -> Bool
== :: VehicleState -> VehicleState -> Bool
$c== :: VehicleState -> VehicleState -> Bool
Eq)

vsFromString :: Text -> VehicleState
vsFromString :: Text -> VehicleState
vsFromString Text
"online"  = VehicleState
VOnline
vsFromString Text
"offline" = VehicleState
VOffline
vsFromString Text
"asleep"  = VehicleState
VAsleep
vsFromString Text
"waking"  = VehicleState
VWaking
vsFromString Text
_         = VehicleState
VUnknown

-- | Tesla Product Types.
data Product = ProductVehicle { Product -> Text
_vehicleName :: Text, Product -> Text
_vehicleID :: VehicleID, Product -> VehicleState
_vehicleState :: VehicleState }
             | ProductEnergy { Product -> EnergyID
_energyID :: EnergyID }
             | ProductPowerwall { Product -> EnergyID
_pwID           :: EnergyID
                                , Product -> Double
_pwBatteryPower :: Double
                                , Product -> Double
_pwEnergyLeft   :: Double
                                , Product -> Double
_pwCharged      :: Double
                                , Product -> Text
_pwName         :: Text
                                , Product -> Double
_pwTotal        :: Double }
             deriving (Int -> Product -> ShowS
[Product] -> ShowS
Product -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Product] -> ShowS
$cshowList :: [Product] -> ShowS
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> ShowS
$cshowsPrec :: Int -> Product -> ShowS
Show, ReadPrec [Product]
ReadPrec Product
Int -> ReadS Product
ReadS [Product]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Product]
$creadListPrec :: ReadPrec [Product]
readPrec :: ReadPrec Product
$creadPrec :: ReadPrec Product
readList :: ReadS [Product]
$creadList :: ReadS [Product]
readsPrec :: Int -> ReadS Product
$creadsPrec :: Int -> ReadS Product
Read, Product -> Product -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c== :: Product -> Product -> Bool
Eq)

makePrisms ''Product
makeLenses ''Product

-- | Decode a products response into a list of products.
decodeProducts :: Value -> [Product]
decodeProducts :: Value -> [Product]
decodeProducts = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall t. AsValue t => Key -> Traversal' t Value
key Key
"response" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {p}. AsValue p => p -> Maybe Product
prod)
  where
    prod :: p -> Maybe Product
prod p
o = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Maybe Product
prodCar, Maybe Product
prodPowerwall, Maybe Product
prodSolar, forall a. Maybe a
Nothing ]
      where
        prodCar :: Maybe Product
prodCar = Text -> Text -> VehicleState -> Product
ProductVehicle
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"display_name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"id_s" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"state" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> VehicleState
vsFromString)
        prodPowerwall :: Maybe Product
prodPowerwall = EnergyID -> Double -> Double -> Double -> Text -> Double -> Product
ProductPowerwall
                        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_site_id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t EnergyID
_Integer)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"battery_power" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Double
_Double)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_left" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Double
_Double)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"percentage_charged" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Double
_Double)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"site_name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"total_pack_energy" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Double
_Double)
        prodSolar :: Maybe Product
prodSolar = EnergyID -> Product
ProductEnergy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p
o forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_site_id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t EnergyID
_Integer)

-- | productsRaw retrieves the complete response for products
productsRaw :: (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw :: forall j (m :: * -> *). (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw AuthInfo
ai = forall j (m :: * -> *).
(FromJSON j, MonadIO m) =>
Options -> String -> m j
jgetWith (AuthInfo -> Options
authOpts AuthInfo
ai) String
productsURL

-- | Get all products associated with this account.
products :: MonadIO m => AuthInfo -> m [Product]
products :: forall (m :: * -> *). MonadIO m => AuthInfo -> m [Product]
products = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> [Product]
decodeProducts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall j (m :: * -> *). (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw

-- | Get a mapping of vehicle name to vehicle ID.
vehicles :: [Product] -> Map Text Text
vehicles :: [Product] -> Map Text Text
vehicles = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
a,Text
b,VehicleState
_) -> (Text
a,Text
b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Product (Text, Text, VehicleState)
_ProductVehicle)

-- | Get a list of Solar ID installations.
energyIDs :: [Product] -> [EnergyID]
energyIDs :: [Product] -> [EnergyID]
energyIDs = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' Product EnergyID
energyID)