{-|
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.Exception          (catch)
import           Control.Lens
import           Control.Monad              (when)
import           Control.Monad.Catch        (SomeException)
import           Control.Monad.IO.Class     (MonadIO (..))
import           Control.Retry              (defaultLogMsg, exponentialBackoff, limitRetries, logRetries, recovering)
import           Crypto.Hash                (SHA256 (..), hashWith)
import           Data.Aeson                 (FromJSON, Value (..), encode)
import           Data.Aeson.Lens            (_Array, _Double, _Integer, _String, key)
import qualified Data.ByteArray             as BA
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.ByteString.Char8      as BC
import qualified Data.ByteString.Lazy       as BL
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 qualified Data.Text.Encoding         as TE
import           Network.HTTP.Client        (HttpException (..), HttpExceptionContent (TooManyRedirects))
import           Network.Wreq               (FormParam (..), Options, asJSON, checkResponse, defaults, header,
                                             hrFinalResponse, params, redirects, responseBody, responseHeader)
import qualified Network.Wreq.Session       as Sess
import           System.Random
import           Text.HTML.TagSoup          (fromAttrib, isTagOpenName, parseTags)

import           Tesla.Auth
import           Tesla.Internal.HTTP

baseURL :: String
baseURL :: String
baseURL =  String
"https://owner-api.teslamotors.com/"
authURL :: String
authURL :: String
authURL = String
"https://auth.tesla.com/oauth2/v3/authorize"
authTokenURL :: String
authTokenURL :: String
authTokenURL = String
"https://owner-api.teslamotors.com/oauth/token"
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"

-- | Authenticate to the Tesla service.
authenticate :: AuthInfo -> IO AuthResponse
authenticate :: AuthInfo -> IO AuthResponse
authenticate AuthInfo
ai = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering RetryPolicyM IO
policy [RetryStatus -> Handler IO Bool
retryOnAnyStatus] forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ -> do
  Session
sess <- IO Session
Sess.newSession
  ByteString
verifier <- [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
86 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => g -> [a]
randoms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m StdGen
getStdGen
  Text
state <- ByteString -> Text
clean64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. (Random a, RandomGen g) => g -> [a]
randoms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => m StdGen
getStdGen
  Session -> ByteString -> Text -> AuthInfo -> IO AuthResponse
authenticate' Session
sess ByteString
verifier Text
state AuthInfo
ai

  where
    policy :: RetryPolicyM IO
policy = forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
exponentialBackoff Int
2000000 forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
9
    retryOnAnyStatus :: RetryStatus -> Handler IO Bool
retryOnAnyStatus = forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> m Bool)
-> (Bool -> e -> RetryStatus -> m ())
-> RetryStatus
-> Handler m Bool
logRetries SomeException -> IO Bool
retryOnAnyError forall {e}. Exception e => Bool -> e -> RetryStatus -> IO ()
reportError
    retryOnAnyError :: SomeException -> IO Bool
    retryOnAnyError :: SomeException -> IO Bool
retryOnAnyError SomeException
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    reportError :: Bool -> e -> RetryStatus -> IO ()
reportError Bool
retriedOrCrashed e
err RetryStatus
retryStatus = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall e. Exception e => Bool -> e -> RetryStatus -> String
defaultLogMsg Bool
retriedOrCrashed e
err RetryStatus
retryStatus

clean64 :: BC.ByteString -> Text
clean64 :: ByteString -> Text
clean64 = ByteString -> Text
TE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (forall a. Eq a => a -> a -> Bool
== Word8
61) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode

authenticate' :: Sess.Session -> BC.ByteString -> Text -> AuthInfo -> IO AuthResponse
authenticate' :: Session -> ByteString -> Text -> AuthInfo -> IO AuthResponse
authenticate' Session
sess ByteString
verifier Text
state ai :: AuthInfo
ai@AuthInfo{String
_bearerToken :: AuthInfo -> String
_password :: AuthInfo -> String
_email :: AuthInfo -> String
_clientSecret :: AuthInfo -> String
_clientID :: AuthInfo -> String
_bearerToken :: String
_password :: String
_email :: String
_clientSecret :: String
_clientID :: String
..} = do
  -- 1. First, grab the form.
  [FormParam]
form <- ByteString -> [FormParam]
formFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Session -> String -> IO (Response ByteString)
Sess.getWith (Options
aOpts forall a b. a -> (a -> b) -> b
& Lens' Options [(Text, Text)]
params forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Text)]
gparams) Session
sess String
authURL
  -- There are required hidden fields -- if we didn't get them, we got the wrong http response
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FormParam]
form) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"tesla didn't return login form"

  -- 2. Now we post the form with all of our credentials.
  let form' :: [FormParam]
form' = [FormParam]
form forall a. Semigroup a => a -> a -> a
<> [ByteString
"identity" forall v. FormValue v => ByteString -> v -> FormParam
:= String
_email, ByteString
"credential" forall v. FormValue v => ByteString -> v -> FormParam
:= String
_password]
  Just Text
code <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
xcode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {p}.
Postable p =>
String -> Options -> p -> IO (Maybe ByteString)
findRedirect String
authURL (Options
fopts
                                                                  forall a b. a -> (a -> b) -> b
& Lens' Options [(Text, Text)]
params forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Text)]
gparams
                                                                  forall a b. a -> (a -> b) -> b
& Lens' Options Int
redirects forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0
                                                                  forall a b. a -> (a -> b) -> b
& Lens' Options (Maybe ResponseChecker)
checkResponse forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\Request
_ Response (IO ByteString)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                                                                 ) [FormParam]
form'
  -- Extract the "code" from the URL we were redirected to... we can't actually follow the redirect :/
  let jreq :: ByteString
jreq = 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
"authorization_code"
                               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
"code" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
code
                               forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"code_verifier" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
verifierHash
                               forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"redirect_uri" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"https://auth.tesla.com/void/callback")

  -- 3. Posting that code and other junk back to the token URL gets us temporary credentials.
  AuthResponse
ar <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
Sess.postWith Options
jOpts Session
sess String
authRefreshURL ByteString
jreq forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
asJSON)
  AuthInfo -> AuthResponse -> IO AuthResponse
translateCreds AuthInfo
ai AuthResponse
ar

  where
    verifierHash :: Text
verifierHash = ByteString -> Text
clean64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack forall a b. (a -> b) -> a -> b
$ forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 ByteString
verifier
    gparams :: [(Text, Text)]
gparams = [(Text
"client_id", Text
"ownerapi"),
                 (Text
"code_challenge", Text
verifierHash),
                 (Text
"code_challenge_method", Text
"S256"),
                 (Text
"redirect_uri", Text
"https://auth.tesla.com/void/callback"),
                 (Text
"response_type", Text
"code"),
                 (Text
"scope", Text
"openid email offline_access"),
                 (Text
"state", Text
state)]
    -- extract all the non-empty form fields from an HTML response
    formFields :: ByteString -> [FormParam]
formFields = forall a b. (a -> b) -> [a] -> [b]
map (\Tag ByteString
t -> forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"name" Tag ByteString
t forall v. FormValue v => ByteString -> v -> FormParam
:= forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"value" Tag ByteString
t)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Tag ByteString
t -> forall str. Eq str => str -> Tag str -> Bool
isTagOpenName ByteString
"input" Tag ByteString
t Bool -> Bool -> Bool
&& forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"value" Tag ByteString
t forall a. Eq a => a -> a -> Bool
/= ByteString
"")
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. StringLike str => str -> [Tag str]
parseTags
    fopts :: Options
fopts = 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/x-www-form-urlencoded"]
    xcode :: String -> Text
xcode String
u = forall a. [a] -> a
head [Text
v | Text
q <- forall a. [a] -> [a]
tail (Text -> Text -> [Text]
T.splitOn Text
"?" (String -> Text
T.pack String
u)),
                        Text
kv <- Text -> Text -> [Text]
T.splitOn Text
"&" Text
q,
                        (Text
k,Text
v) <- forall {b}. [b] -> [(b, b)]
paird (Text -> Text -> [Text]
T.splitOn Text
"=" Text
kv),
                        Text
k forall a. Eq a => a -> a -> Bool
== Text
"code"]
    paird :: [b] -> [(b, b)]
paird [b
a,b
b] = [(b
a,b
b)]
    paird [b]
_     = []

    findRedirect :: String -> Options -> p -> IO (Maybe ByteString)
findRedirect String
u Options
opts p
a = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. HeaderName -> Traversal' (Response body) ByteString
responseHeader HeaderName
"Location") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Maybe (Response ByteString))
inBody forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall {f :: * -> *}.
Applicative f =>
HttpException -> f (Maybe (Response ByteString))
inException)
      where
        inBody :: IO (Maybe (Response ByteString))
inBody = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall body. Lens' (HistoriedResponse body) (Response body)
hrFinalResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Postable a =>
String
-> Options
-> Session
-> String
-> a
-> IO (HistoriedResponse ByteString)
Sess.customHistoriedPayloadMethodWith String
"POST" Options
opts Session
sess String
u p
a
        inException :: HttpException -> f (Maybe (Response ByteString))
inException (HttpExceptionRequest Request
_ (TooManyRedirects (Response ByteString
r:[Response ByteString]
_))) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Response ByteString
r)


translateCreds :: AuthInfo -> AuthResponse -> IO AuthResponse
translateCreds :: AuthInfo -> AuthResponse -> IO AuthResponse
translateCreds AuthInfo{String
_bearerToken :: String
_password :: String
_email :: String
_clientSecret :: String
_clientID :: String
_bearerToken :: AuthInfo -> String
_password :: AuthInfo -> String
_email :: AuthInfo -> String
_clientSecret :: AuthInfo -> String
_clientID :: AuthInfo -> String
..} 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
  -- 4. And we finally get the useful credentials by exchanging the temporary credentials.
  let jreq2 :: ByteString
jreq2 = 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
"urn:ietf:params:oauth:grant-type:jwt-bearer"
                               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
?~ Text -> Value
String (String -> Text
T.pack String
_clientID)
                              )

  AuthResponse
ar <- forall j a (m :: * -> *).
(FromJSON j, Postable a, MonadIO m) =>
Options -> String -> a -> m j
jpostWith (Options
jOpts forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Authorization" forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"bearer " forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BC.pack String
_access_token]) String
authTokenURL ByteString
jreq2
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthResponse
ar forall a b. a -> (a -> b) -> b
& Lens' AuthResponse String
refresh_token forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
_refresh_token) -- replace the refresh token with the one from step 3


-- | Refresh authentication credentials using a refresh token.
refreshAuth :: AuthInfo -> AuthResponse -> IO AuthResponse
refreshAuth :: AuthInfo -> AuthResponse -> IO AuthResponse
refreshAuth AuthInfo
_ AuthResponse{Int
String
_refresh_token :: String
_expires_in :: Int
_access_token :: String
_refresh_token :: AuthResponse -> String
_expires_in :: AuthResponse -> Int
_access_token :: AuthResponse -> 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)