{-|
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, mapMaybe)
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 String -> String -> String
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 = RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO AuthResponse)
-> IO AuthResponse
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] ((RetryStatus -> IO AuthResponse) -> IO AuthResponse)
-> (RetryStatus -> IO AuthResponse) -> IO AuthResponse
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ -> do
  Session
sess <- IO Session
Sess.newSession
  ByteString
verifier <- [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (StdGen -> [Word8]) -> StdGen -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
86 ([Word8] -> [Word8]) -> (StdGen -> [Word8]) -> StdGen -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [Word8]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms (StdGen -> ByteString) -> IO StdGen -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
getStdGen
  Text
state <- ByteString -> Text
clean64 (ByteString -> Text) -> (StdGen -> ByteString) -> StdGen -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (StdGen -> [Word8]) -> StdGen -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
16 ([Word8] -> [Word8]) -> (StdGen -> [Word8]) -> StdGen -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [Word8]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms (StdGen -> Text) -> IO StdGen -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StdGen
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 = Int -> RetryPolicy
exponentialBackoff Int
2000000 RetryPolicyM IO -> RetryPolicyM IO -> RetryPolicyM IO
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
9
    retryOnAnyStatus :: RetryStatus -> Handler IO Bool
retryOnAnyStatus = (SomeException -> IO Bool)
-> (Bool -> SomeException -> RetryStatus -> IO ())
-> RetryStatus
-> Handler IO Bool
forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> m Bool)
-> (Bool -> e -> RetryStatus -> m ())
-> RetryStatus
-> Handler m Bool
logRetries SomeException -> IO Bool
retryOnAnyError Bool -> SomeException -> RetryStatus -> IO ()
forall e. Exception e => Bool -> e -> RetryStatus -> IO ()
reportError
    retryOnAnyError :: SomeException -> IO Bool
    retryOnAnyError :: SomeException -> IO Bool
retryOnAnyError SomeException
_ = Bool -> IO Bool
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> e -> RetryStatus -> String
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 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
61) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
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 (ByteString -> [FormParam])
-> (Response ByteString -> ByteString)
-> Response ByteString
-> [FormParam]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString (Response ByteString) ByteString
-> Response ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody (Response ByteString -> [FormParam])
-> IO (Response ByteString) -> IO [FormParam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> Session -> String -> IO (Response ByteString)
Sess.getWith (Options
aOpts Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
params (([(Text, Text)] -> Identity [(Text, Text)])
 -> Options -> Identity Options)
-> [(Text, Text)] -> Options -> Options
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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FormParam] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FormParam]
form) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
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 [FormParam] -> [FormParam] -> [FormParam]
forall a. Semigroup a => a -> a -> a
<> [ByteString
"identity" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
_email, ByteString
"credential" ByteString -> String -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= String
_password]
  Just Text
code <- (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
xcode (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack) (Maybe ByteString -> Maybe Text)
-> IO (Maybe ByteString) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Options -> [FormParam] -> IO (Maybe ByteString)
forall a.
Postable a =>
String -> Options -> a -> IO (Maybe ByteString)
findRedirect String
authURL (Options
fopts
                                                                  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
params (([(Text, Text)] -> Identity [(Text, Text)])
 -> Options -> Identity Options)
-> [(Text, Text)] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text, Text)]
gparams
                                                                  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> Options -> Identity Options
Lens' Options Int
redirects ((Int -> Identity Int) -> Options -> Identity Options)
-> Int -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0
                                                                  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options
Lens' Options (Maybe ResponseChecker)
checkResponse ((Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
 -> Options -> Identity Options)
-> ResponseChecker -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\Request
_ Response (IO ByteString)
_ -> () -> IO ()
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 = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
forall a. Monoid a => a
mempty
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"grant_type" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"authorization_code"
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"client_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"ownerapi"
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"code" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
code
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"code_verifier" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
verifierHash
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"redirect_uri" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
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 <- Getting AuthResponse (Response AuthResponse) AuthResponse
-> Response AuthResponse -> AuthResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AuthResponse (Response AuthResponse) AuthResponse
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody (Response AuthResponse -> AuthResponse)
-> IO (Response AuthResponse) -> IO AuthResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options
-> Session -> String -> ByteString -> IO (Response ByteString)
forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
Sess.postWith Options
jOpts Session
sess String
authRefreshURL ByteString
jreq IO (Response ByteString)
-> (Response ByteString -> IO (Response AuthResponse))
-> IO (Response AuthResponse)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response ByteString -> IO (Response AuthResponse)
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 (ByteString -> Text)
-> (Digest SHA256 -> ByteString) -> Digest SHA256 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (Digest SHA256 -> [Word8]) -> Digest SHA256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (Digest SHA256 -> Text) -> Digest SHA256 -> Text
forall a b. (a -> b) -> a -> b
$ SHA256 -> ByteString -> Digest SHA256
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 = (Tag ByteString -> FormParam) -> [Tag ByteString] -> [FormParam]
forall a b. (a -> b) -> [a] -> [b]
map (\Tag ByteString
t -> ByteString -> Tag ByteString -> ByteString
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"name" Tag ByteString
t ByteString -> ByteString -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= ByteString -> Tag ByteString -> ByteString
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"value" Tag ByteString
t)
                 ([Tag ByteString] -> [FormParam])
-> (ByteString -> [Tag ByteString]) -> ByteString -> [FormParam]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag ByteString -> Bool) -> [Tag ByteString] -> [Tag ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Tag ByteString
t -> ByteString -> Tag ByteString -> Bool
forall str. Eq str => str -> Tag str -> Bool
isTagOpenName ByteString
"input" Tag ByteString
t Bool -> Bool -> Bool
&& ByteString -> Tag ByteString -> ByteString
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"value" Tag ByteString
t ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"")
                 ([Tag ByteString] -> [Tag ByteString])
-> (ByteString -> [Tag ByteString])
-> ByteString
-> [Tag ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Tag ByteString]
forall str. StringLike str => str -> [Tag str]
parseTags
    fopts :: Options
fopts = Options
aOpts Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"content-type" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
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 = [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Text
s -> let [Text
k,Text
v] = Text -> Text -> [Text]
T.splitOn Text
"=" Text
s in if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"code" then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v else Maybe Text
forall a. Maybe a
Nothing) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"&" (Text -> Text -> [Text]
T.splitOn Text
"?" (String -> Text
T.pack String
u) [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
1)


    findRedirect :: String -> Options -> a -> IO (Maybe ByteString)
findRedirect String
u Options
opts a
a = Getting (First ByteString) (Maybe (Response ByteString)) ByteString
-> Maybe (Response ByteString) -> Maybe ByteString
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Response ByteString
 -> Const (First ByteString) (Response ByteString))
-> Maybe (Response ByteString)
-> Const (First ByteString) (Maybe (Response ByteString))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Response ByteString
  -> Const (First ByteString) (Response ByteString))
 -> Maybe (Response ByteString)
 -> Const (First ByteString) (Maybe (Response ByteString)))
-> ((ByteString -> Const (First ByteString) ByteString)
    -> Response ByteString
    -> Const (First ByteString) (Response ByteString))
-> Getting
     (First ByteString) (Maybe (Response ByteString)) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> Traversal' (Response ByteString) ByteString
forall body. HeaderName -> Traversal' (Response body) ByteString
responseHeader HeaderName
"Location") (Maybe (Response ByteString) -> Maybe ByteString)
-> IO (Maybe (Response ByteString)) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Maybe (Response ByteString))
inBody IO (Maybe (Response ByteString))
-> (HttpException -> IO (Maybe (Response ByteString)))
-> IO (Maybe (Response ByteString))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` HttpException -> IO (Maybe (Response ByteString))
forall (f :: * -> *).
Applicative f =>
HttpException -> f (Maybe (Response ByteString))
inException)
      where
        inBody :: IO (Maybe (Response ByteString))
inBody = Getting
  (First (Response ByteString))
  (HistoriedResponse ByteString)
  (Response ByteString)
-> HistoriedResponse ByteString -> Maybe (Response ByteString)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First (Response ByteString))
  (HistoriedResponse ByteString)
  (Response ByteString)
forall body. Lens' (HistoriedResponse body) (Response body)
hrFinalResponse (HistoriedResponse ByteString -> Maybe (Response ByteString))
-> IO (HistoriedResponse ByteString)
-> IO (Maybe (Response ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Options
-> Session
-> String
-> a
-> IO (HistoriedResponse ByteString)
forall a.
Postable a =>
String
-> Options
-> Session
-> String
-> a
-> IO (HistoriedResponse ByteString)
Sess.customHistoriedPayloadMethodWith String
"POST" Options
opts Session
sess String
u a
a
        inException :: HttpException -> f (Maybe (Response ByteString))
inException (HttpExceptionRequest Request
_ (TooManyRedirects (Response ByteString
r:[Response ByteString]
_))) = Maybe (Response ByteString) -> f (Maybe (Response ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response ByteString -> Maybe (Response ByteString)
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 = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
forall a. Monoid a => a
mempty
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"grant_type" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"urn:ietf:params:oauth:grant-type:jwt-bearer"
                               Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"client_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
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 <- Options -> String -> ByteString -> IO AuthResponse
forall j a (m :: * -> *).
(FromJSON j, Postable a, MonadIO m) =>
Options -> String -> a -> m j
jpostWith (Options
jOpts Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BC.pack String
_access_token]) String
authTokenURL ByteString
jreq2
  AuthResponse -> IO AuthResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthResponse
ar AuthResponse -> (AuthResponse -> AuthResponse) -> AuthResponse
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> AuthResponse -> Identity AuthResponse
Lens' AuthResponse String
refresh_token ((String -> Identity String)
 -> AuthResponse -> Identity AuthResponse)
-> String -> AuthResponse -> AuthResponse
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
ai 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
  AuthResponse
ar <- Options -> String -> ByteString -> IO AuthResponse
forall j a (m :: * -> *).
(FromJSON j, Postable a, MonadIO m) =>
Options -> String -> a -> m j
jpostWith Options
jOpts String
authRefreshURL (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
forall a. Monoid a => a
mempty
                                                         Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"grant_type" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"refresh_token"
                                                         Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"client_id" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"ownerapi"
                                                         Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"refresh_token" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String (String -> Text
T.pack String
_refresh_token)
                                                         Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"scope" ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"openid email offline_access"
                                                        ))
  AuthInfo -> AuthResponse -> IO AuthResponse
translateCreds AuthInfo
ai AuthResponse
ar

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

aOpts :: Options
aOpts :: Options
aOpts = Options
defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
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 -> String -> String
[VehicleState] -> String -> String
VehicleState -> String
(Int -> VehicleState -> String -> String)
-> (VehicleState -> String)
-> ([VehicleState] -> String -> String)
-> Show VehicleState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [VehicleState] -> String -> String
$cshowList :: [VehicleState] -> String -> String
show :: VehicleState -> String
$cshow :: VehicleState -> String
showsPrec :: Int -> VehicleState -> String -> String
$cshowsPrec :: Int -> VehicleState -> String -> String
Show, ReadPrec [VehicleState]
ReadPrec VehicleState
Int -> ReadS VehicleState
ReadS [VehicleState]
(Int -> ReadS VehicleState)
-> ReadS [VehicleState]
-> ReadPrec VehicleState
-> ReadPrec [VehicleState]
-> Read 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
(VehicleState -> VehicleState -> Bool)
-> (VehicleState -> VehicleState -> Bool) -> Eq VehicleState
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 -> String -> String
[Product] -> String -> String
Product -> String
(Int -> Product -> String -> String)
-> (Product -> String)
-> ([Product] -> String -> String)
-> Show Product
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Product] -> String -> String
$cshowList :: [Product] -> String -> String
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> String -> String
$cshowsPrec :: Int -> Product -> String -> String
Show, ReadPrec [Product]
ReadPrec Product
Int -> ReadS Product
ReadS [Product]
(Int -> ReadS Product)
-> ReadS [Product]
-> ReadPrec Product
-> ReadPrec [Product]
-> Read 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
(Product -> Product -> Bool)
-> (Product -> Product -> Bool) -> Eq Product
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 = [Maybe Product] -> [Product]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Product] -> [Product])
-> (Value -> [Maybe Product]) -> Value -> [Product]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Maybe Product]) Value (Maybe Product)
-> Value -> [Maybe Product]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"response" ((Value -> Const (Endo [Maybe Product]) Value)
 -> Value -> Const (Endo [Maybe Product]) Value)
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Value -> Const (Endo [Maybe Product]) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
 -> Value -> Const (Endo [Maybe Product]) Value)
-> ((Maybe Product -> Const (Endo [Maybe Product]) (Maybe Product))
    -> Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Maybe Product]) Value)
-> Vector Value -> Const (Endo [Maybe Product]) (Vector Value)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((Value -> Const (Endo [Maybe Product]) Value)
 -> Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
-> (Maybe Product -> Const (Endo [Maybe Product]) (Maybe Product))
-> Vector Value
-> Const (Endo [Maybe Product]) (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Product)
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Value -> Maybe Product
forall s. AsValue s => s -> Maybe Product
prod)
  where
    prod :: s -> Maybe Product
prod s
o = [Maybe Product] -> Maybe Product
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Maybe Product
prodCar, Maybe Product
prodPowerwall, Maybe Product
prodSolar, Maybe Product
forall a. Maybe a
Nothing ]
      where
        prodCar :: Maybe Product
prodCar = Text -> Text -> VehicleState -> Product
ProductVehicle
                  (Text -> Text -> VehicleState -> Product)
-> Maybe Text -> Maybe (Text -> VehicleState -> Product)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s
o s -> Getting (First Text) s Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"display_name" ((Value -> Const (First Text) Value) -> s -> Const (First Text) s)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)
                  Maybe (Text -> VehicleState -> Product)
-> Maybe Text -> Maybe (VehicleState -> Product)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s -> Getting (First Text) s Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id_s" ((Value -> Const (First Text) Value) -> s -> Const (First Text) s)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)
                  Maybe (VehicleState -> Product)
-> Maybe VehicleState -> Maybe Product
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s
-> Getting (First VehicleState) s VehicleState
-> Maybe VehicleState
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"state" ((Value -> Const (First VehicleState) Value)
 -> s -> Const (First VehicleState) s)
-> ((VehicleState -> Const (First VehicleState) VehicleState)
    -> Value -> Const (First VehicleState) Value)
-> Getting (First VehicleState) s VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First VehicleState) Text)
-> Value -> Const (First VehicleState) Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const (First VehicleState) Text)
 -> Value -> Const (First VehicleState) Value)
-> ((VehicleState -> Const (First VehicleState) VehicleState)
    -> Text -> Const (First VehicleState) Text)
-> (VehicleState -> Const (First VehicleState) VehicleState)
-> Value
-> Const (First VehicleState) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> VehicleState)
-> (VehicleState -> Const (First VehicleState) VehicleState)
-> Text
-> Const (First VehicleState) Text
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
                        (EnergyID
 -> Double -> Double -> Double -> Text -> Double -> Product)
-> Maybe EnergyID
-> Maybe (Double -> Double -> Double -> Text -> Double -> Product)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s
o s -> Getting (First EnergyID) s EnergyID -> Maybe EnergyID
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"energy_site_id" ((Value -> Const (First EnergyID) Value)
 -> s -> Const (First EnergyID) s)
-> ((EnergyID -> Const (First EnergyID) EnergyID)
    -> Value -> Const (First EnergyID) Value)
-> Getting (First EnergyID) s EnergyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnergyID -> Const (First EnergyID) EnergyID)
-> Value -> Const (First EnergyID) Value
forall t. AsNumber t => Prism' t EnergyID
_Integer)
                        Maybe (Double -> Double -> Double -> Text -> Double -> Product)
-> Maybe Double
-> Maybe (Double -> Double -> Text -> Double -> Product)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s -> Getting (First Double) s Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"battery_power" ((Value -> Const (First Double) Value)
 -> s -> Const (First Double) s)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) s Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
_Double)
                        Maybe (Double -> Double -> Text -> Double -> Product)
-> Maybe Double -> Maybe (Double -> Text -> Double -> Product)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s -> Getting (First Double) s Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"energy_left" ((Value -> Const (First Double) Value)
 -> s -> Const (First Double) s)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) s Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
_Double)
                        Maybe (Double -> Text -> Double -> Product)
-> Maybe Double -> Maybe (Text -> Double -> Product)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s -> Getting (First Double) s Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"percentage_charged" ((Value -> Const (First Double) Value)
 -> s -> Const (First Double) s)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) s Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
_Double)
                        Maybe (Text -> Double -> Product)
-> Maybe Text -> Maybe (Double -> Product)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s -> Getting (First Text) s Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"site_name" ((Value -> Const (First Text) Value) -> s -> Const (First Text) s)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) s Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsPrimitive t => Prism' t Text
_String)
                        Maybe (Double -> Product) -> Maybe Double -> Maybe Product
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s
o s -> Getting (First Double) s Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"total_pack_energy" ((Value -> Const (First Double) Value)
 -> s -> Const (First Double) s)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) s Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
_Double)
        prodSolar :: Maybe Product
prodSolar = EnergyID -> Product
ProductEnergy (EnergyID -> Product) -> Maybe EnergyID -> Maybe Product
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s
o s -> Getting (First EnergyID) s EnergyID -> Maybe EnergyID
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"energy_site_id" ((Value -> Const (First EnergyID) Value)
 -> s -> Const (First EnergyID) s)
-> ((EnergyID -> Const (First EnergyID) EnergyID)
    -> Value -> Const (First EnergyID) Value)
-> Getting (First EnergyID) s EnergyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnergyID -> Const (First EnergyID) EnergyID)
-> Value -> Const (First EnergyID) Value
forall t. AsNumber t => Prism' t EnergyID
_Integer)

-- | productsRaw retrieves the complete response for products
productsRaw :: (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw :: AuthInfo -> m j
productsRaw AuthInfo
ai = Options -> String -> m j
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 :: AuthInfo -> m [Product]
products = (Value -> [Product]) -> m Value -> m [Product]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> [Product]
decodeProducts (m Value -> m [Product])
-> (AuthInfo -> m Value) -> AuthInfo -> m [Product]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthInfo -> m Value
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 = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> ([Product] -> [(Text, Text)]) -> [Product] -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text, VehicleState) -> (Text, Text))
-> [(Text, Text, VehicleState)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
a,Text
b,VehicleState
_) -> (Text
a,Text
b)) ([(Text, Text, VehicleState)] -> [(Text, Text)])
-> ([Product] -> [(Text, Text, VehicleState)])
-> [Product]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Endo [(Text, Text, VehicleState)])
  [Product]
  (Text, Text, VehicleState)
-> [Product] -> [(Text, Text, VehicleState)]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Product -> Const (Endo [(Text, Text, VehicleState)]) Product)
-> [Product] -> Const (Endo [(Text, Text, VehicleState)]) [Product]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((Product -> Const (Endo [(Text, Text, VehicleState)]) Product)
 -> [Product]
 -> Const (Endo [(Text, Text, VehicleState)]) [Product])
-> (((Text, Text, VehicleState)
     -> Const
          (Endo [(Text, Text, VehicleState)]) (Text, Text, VehicleState))
    -> Product -> Const (Endo [(Text, Text, VehicleState)]) Product)
-> Getting
     (Endo [(Text, Text, VehicleState)])
     [Product]
     (Text, Text, VehicleState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text, VehicleState)
 -> Const
      (Endo [(Text, Text, VehicleState)]) (Text, Text, VehicleState))
-> Product -> Const (Endo [(Text, Text, VehicleState)]) Product
Prism' Product (Text, Text, VehicleState)
_ProductVehicle)

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