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

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

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

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


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

import           Tesla.Auth
import           Tesla.Internal.HTTP

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

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

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

-- | Refresh authentication credentials using a refresh token.
refreshAuth :: AuthResponse -> IO AuthResponse
refreshAuth :: AuthResponse -> IO AuthResponse
refreshAuth AuthResponse{Int
String
_access_token :: String
_expires_in :: Int
_refresh_token :: String
_access_token :: AuthResponse -> String
_expires_in :: AuthResponse -> Int
_refresh_token :: AuthResponse -> String
..} = do
  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 Key
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 Key
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 Key
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 Key
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"
                                                        ))

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
$cshowsPrec :: Int -> VehicleState -> String -> String
showsPrec :: Int -> VehicleState -> String -> String
$cshow :: VehicleState -> String
show :: VehicleState -> String
$cshowList :: [VehicleState] -> String -> String
showList :: [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
$creadsPrec :: Int -> ReadS VehicleState
readsPrec :: Int -> ReadS VehicleState
$creadList :: ReadS [VehicleState]
readList :: ReadS [VehicleState]
$creadPrec :: ReadPrec VehicleState
readPrec :: ReadPrec VehicleState
$creadListPrec :: ReadPrec [VehicleState]
readListPrec :: ReadPrec [VehicleState]
Read, VehicleState -> VehicleState -> Bool
(VehicleState -> VehicleState -> Bool)
-> (VehicleState -> VehicleState -> Bool) -> Eq VehicleState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VehicleState -> VehicleState -> Bool
== :: VehicleState -> VehicleState -> Bool
$c/= :: VehicleState -> VehicleState -> Bool
/= :: 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
$cshowsPrec :: Int -> Product -> String -> String
showsPrec :: Int -> Product -> String -> String
$cshow :: Product -> String
show :: Product -> String
$cshowList :: [Product] -> String -> String
showList :: [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
$creadsPrec :: Int -> ReadS Product
readsPrec :: Int -> ReadS Product
$creadList :: ReadS [Product]
readList :: ReadS [Product]
$creadPrec :: ReadPrec Product
readPrec :: ReadPrec Product
$creadListPrec :: ReadPrec [Product]
readListPrec :: ReadPrec [Product]
Read, Product -> Product -> Bool
(Product -> Product -> Bool)
-> (Product -> Product -> Bool) -> Eq Product
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
/= :: 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 (Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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)
Prism' Value (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
IndexedFold Int (Vector Value) Value
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 {p}. AsValue p => p -> Maybe Product
prod)
  where
    prod :: p -> Maybe Product
prod p
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
<$> (p
o p -> Getting (First Text) p Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"display_name" ((Value -> Const (First Text) Value) -> p -> Const (First Text) p)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) p Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
                  Maybe (Text -> VehicleState -> Product)
-> Maybe Text -> Maybe (VehicleState -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Text) p Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"id_s" ((Value -> Const (First Text) Value) -> p -> Const (First Text) p)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) p Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
                  Maybe (VehicleState -> Product)
-> Maybe VehicleState -> Maybe Product
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p
-> Getting (First VehicleState) p VehicleState
-> Maybe VehicleState
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"state" ((Value -> Const (First VehicleState) Value)
 -> p -> Const (First VehicleState) p)
-> ((VehicleState -> Const (First VehicleState) VehicleState)
    -> Value -> Const (First VehicleState) Value)
-> Getting (First VehicleState) p VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First VehicleState) Text)
-> Value -> Const (First VehicleState) Value
forall t. AsValue t => Prism' t Text
Prism' Value 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
<$> (p
o p -> Getting (First EnergyID) p EnergyID -> Maybe EnergyID
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_site_id" ((Value -> Const (First EnergyID) Value)
 -> p -> Const (First EnergyID) p)
-> ((EnergyID -> Const (First EnergyID) EnergyID)
    -> Value -> Const (First EnergyID) Value)
-> Getting (First EnergyID) p 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
Prism' Value EnergyID
_Integer)
                        Maybe (Double -> Double -> Double -> Text -> Double -> Product)
-> Maybe Double
-> Maybe (Double -> Double -> Text -> Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"battery_power" ((Value -> Const (First Double) Value)
 -> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) p 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
Prism' Value Double
_Double)
                        Maybe (Double -> Double -> Text -> Double -> Product)
-> Maybe Double -> Maybe (Double -> Text -> Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_left" ((Value -> Const (First Double) Value)
 -> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) p 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
Prism' Value Double
_Double)
                        Maybe (Double -> Text -> Double -> Product)
-> Maybe Double -> Maybe (Text -> Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"percentage_charged" ((Value -> Const (First Double) Value)
 -> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) p 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
Prism' Value Double
_Double)
                        Maybe (Text -> Double -> Product)
-> Maybe Text -> Maybe (Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Text) p Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"site_name" ((Value -> Const (First Text) Value) -> p -> Const (First Text) p)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) p Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
                        Maybe (Double -> Product) -> Maybe Double -> Maybe Product
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"total_pack_energy" ((Value -> Const (First Double) Value)
 -> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
    -> Value -> Const (First Double) Value)
-> Getting (First Double) p 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
Prism' Value 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
<$> (p
o p -> Getting (First EnergyID) p EnergyID -> Maybe EnergyID
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_site_id" ((Value -> Const (First EnergyID) Value)
 -> p -> Const (First EnergyID) p)
-> ((EnergyID -> Const (First EnergyID) EnergyID)
    -> Value -> Const (First EnergyID) Value)
-> Getting (First EnergyID) p 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
Prism' Value 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 = 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 :: forall (m :: * -> *). MonadIO m => AuthInfo -> m [Product]
products = (Value -> [Product]) -> m Value -> m [Product]
forall a b. (a -> b) -> m a -> m b
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 a b. (a -> b) -> [a] -> [b]
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
IndexedFold Int [Product] Product
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
IndexedFold Int [Product] Product
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)