tesla 0.3.1.0 → 0.4.0.0
raw patch · 3 files changed
+64/−34 lines, 3 filesdep ~aesondep ~lensdep ~template-haskell
Dependency ranges changed: aeson, lens, template-haskell
Files
- src/Tesla.hs +22/−11
- src/Tesla/Car.hs +15/−2
- tesla.cabal +27/−21
src/Tesla.hs view
@@ -13,8 +13,10 @@ module Tesla ( authenticate, refreshAuth, AuthResponse(..),- Product(..), vehicleName, vehicleID, energyID, _ProductVehicle, _ProductEnergy, _ProductPowerWall,+ Product(..), vehicleName, vehicleID, vehicleState,+ energyID, _ProductVehicle, _ProductEnergy, _ProductPowerWall, VehicleID, vehicles, products,+ VehicleState(..), vsFromString, EnergyID, energyIDs, fromToken, authOpts, baseURL, decodeProducts@@ -123,7 +125,7 @@ xcode u = head . mapMaybe (\s -> let [k,v] = T.splitOn "=" s in if k == "code" then Just v else Nothing) $ T.splitOn "&" (T.splitOn "?" (T.pack u) !! 1) translateCreds :: AuthInfo -> AuthResponse -> IO AuthResponse-translateCreds ai@AuthInfo{..} AuthResponse{..} = do+translateCreds AuthInfo{..} AuthResponse{..} = do -- 4. And we finally get the useful credentials by exchanging the temporary credentials. let jreq2 = encode $ Object (mempty & at "grant_type" ?~ "urn:ietf:params:oauth:grant-type:jwt-bearer"@@ -149,12 +151,7 @@ jOpts = aOpts & header "content-type" .~ ["application/json"] aOpts :: Options-aOpts = defaults- & header "Accept" .~ ["*/*"]- & header "User-Agent" .~ [ua]- & header "x-tesla-user-agent" .~ [userAgent]- & header "X-Requested-With" .~ ["com.teslamotors.tesla"]- where ua = "Mozilla/5.0 (Linux; Android 10; Pixel 3 Build/QQ2A.200305.002; wv) AppleWebKit/537.36 (KHTML, like Gecko) Version/4.0 Chrome/85.0.4183.81 Mobile Safari/537.36"+aOpts = defaults & header "Accept" .~ ["*/*"] -- | A VehicleID. type VehicleID = Text@@ -162,8 +159,19 @@ -- | An energy site ID. type EnergyID = Integer +-- | Possible states a vehicle may be in.+data VehicleState = VOnline | VOffline | VAsleep | VWaking | VUnknown+ deriving (Show, Read, Eq)++vsFromString :: Text -> VehicleState+vsFromString "online" = VOnline+vsFromString "offline" = VOffline+vsFromString "asleep" = VAsleep+vsFromString "waking" = VWaking+vsFromString _ = VUnknown+ -- | Tesla Product Types.-data Product = ProductVehicle { _vehicleName :: Text, _vehicleID :: VehicleID }+data Product = ProductVehicle { _vehicleName :: Text, _vehicleID :: VehicleID, _vehicleState :: VehicleState } | ProductEnergy { _energyID :: EnergyID } | ProductPowerWall deriving (Show, Read, Eq) @@ -175,7 +183,10 @@ where prod o = asum [ prodCar, prodSolar, Nothing ] where- prodCar = ProductVehicle <$> (o ^? key "display_name" . _String) <*> (o ^? key "id_s" . _String)+ prodCar = ProductVehicle+ <$> (o ^? key "display_name" . _String)+ <*> (o ^? key "id_s" . _String)+ <*> (o ^? key "state" . _String . to vsFromString) prodSolar = ProductEnergy <$> (o ^? key "energy_site_id" . _Integer) -- | Get all products associated with this account.@@ -184,7 +195,7 @@ -- | Get a mapping of vehicle name to vehicle ID. vehicles :: [Product] -> Map Text Text-vehicles = Map.fromList . toListOf (folded . _ProductVehicle)+vehicles = Map.fromList . fmap (\(a,b,_) -> (a,b)) . toListOf (folded . _ProductVehicle) -- | Get a list of Solar ID installations. energyIDs :: [Product] -> [EnergyID]
src/Tesla/Car.hs view
@@ -23,7 +23,7 @@ Car, runCar, runNamedCar, VehicleID, -- * Requests- vehicleData, nearbyChargers,+ vehicleData, nearbyChargers, vehicleStatus, isAwake, -- * Convenience functions for examining VehicleData VehicleData, isUserPresent, isCharging, teslaTS, maybeTeslaTS, Door(..), OpenState(..), _Open, _Closed, doors, openDoors,@@ -39,6 +39,7 @@ import Control.Exception (Exception, throwIO) import Control.Lens+import Data.Foldable (fold) import Control.Monad ((<=<)) import Control.Monad.Catch (MonadCatch (..), MonadMask (..), MonadThrow (..)) import Control.Monad.IO.Class (MonadIO (..))@@ -47,7 +48,7 @@ import Control.Monad.Reader (MonadReader, ReaderT (..), asks, runReaderT) import Data.Aeson (FromJSON (..), Options (..), Result (..), Value (..), decode, defaultOptions, fieldLabelModifier, fromJSON, genericParseJSON, withObject, (.:))-import Data.Aeson.Lens (key, values, _Bool, _Integer)+import Data.Aeson.Lens (key, values, _Bool, _Integer, _String) import qualified Data.ByteString.Lazy as BL import qualified Data.Map.Strict as Map import Data.Maybe (fromJust, fromMaybe)@@ -124,6 +125,18 @@ -- Lens when you need it but some convenience methods for common -- | A VehicleIDaccesses are available in this module. type VehicleData = BL.ByteString++-- | vehicleStatus returns the current status of the current vehicle.+vehicleStatus :: MonadIO m => Car m VehicleState+vehicleStatus = do+ v <- currentVehicleID+ r <- jgetAuth (fold [baseURL, "api/1/vehicles/", unpack v])+ let (Just x) = (r :: Value) ^? (key "response" . key "state" . _String . to vsFromString)+ pure x++-- | isAwake returns true if the current vehicle is awake and online.+isAwake :: MonadIO m => Car m Bool+isAwake = (== VOnline) <$> vehicleStatus -- | Fetch the VehicleData. vehicleData :: MonadIO m => Car m VehicleData
tesla.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 236741807bd9077d0f64ee24d77b18f02891eb559659adf6c66a91c5b5216fe5+-- hash: 24dfc3529bdcf280c4391d9a54fb35f858c54887d78fd748fb93b47ef664b88d name: tesla-version: 0.3.1.0+version: 0.4.0.0 synopsis: Tesla API client. description: Please see the README on GitHub at <https://github.com/dustin/tesla#readme> category: Web@@ -53,32 +53,35 @@ Paths_tesla hs-source-dirs: src- default-extensions: OverloadedStrings RecordWildCards NamedFieldPuns+ default-extensions:+ OverloadedStrings+ RecordWildCards+ NamedFieldPuns ghc-options: -Wall build-depends:- aeson >=1.4.5 && <1.5+ aeson >=1.4.5 && <1.6 , base >=4.7 && <5 , base64-bytestring- , bytestring >=0.10 && <0.11+ , bytestring ==0.10.* , casing >=0.1.4 && <0.2- , containers >=0.6 && <0.7+ , containers ==0.6.* , cryptonite , exceptions , generic-deriving >=1.12 && <1.14- , lens >=4.17 && <4.19+ , lens >=4.17 && <4.20 , lens-aeson >=1.0 && <1.2 , memory , monad-logger- , mtl >=2.2 && <2.3+ , mtl ==2.2.* , random , retry , tagsoup- , template-haskell >=2.14 && <2.16- , text >=1.2 && <1.3+ , template-haskell >=2.14 && <2.17+ , text ==1.2.* , time >=1.8 && <1.10 , unliftio-core , vector >=0.12.0 && <0.13- , wreq >=0.5 && <0.6+ , wreq ==0.5.* default-language: Haskell2010 test-suite tesla-test@@ -88,35 +91,38 @@ Paths_tesla hs-source-dirs: test- default-extensions: OverloadedStrings RecordWildCards NamedFieldPuns+ default-extensions:+ OverloadedStrings+ RecordWildCards+ NamedFieldPuns ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit- , aeson >=1.4.5 && <1.5+ , aeson >=1.4.5 && <1.6 , base >=4.7 && <5 , base64-bytestring- , bytestring >=0.10 && <0.11+ , bytestring ==0.10.* , casing >=0.1.4 && <0.2- , containers >=0.6 && <0.7+ , containers ==0.6.* , cryptonite , exceptions , generic-deriving >=1.12 && <1.14- , lens >=4.17 && <4.19+ , lens >=4.17 && <4.20 , lens-aeson >=1.0 && <1.2 , memory , monad-logger- , mtl >=2.2 && <2.3+ , mtl ==2.2.* , random , retry , tagsoup , tasty , tasty-hunit , tasty-quickcheck- , template-haskell >=2.14 && <2.16+ , template-haskell >=2.14 && <2.17 , tesla- , text >=1.2 && <1.3+ , text ==1.2.* , time >=1.8 && <1.10 , unliftio-core , vector >=0.12.0 && <0.13- , wreq >=0.5 && <0.6+ , wreq ==0.5.* default-language: Haskell2010