{-# 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 :: 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
[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
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"
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'
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")
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)]
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
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)
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
"*/*"]
type VehicleID = Text
type EnergyID = Integer
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
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
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 :: (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
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
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)
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)