tesla 0.4.1.3 → 0.5.0.0

raw patch · 8 files changed

+147/−23 lines, 8 filesdep +finite-typelitsPVP ok

version bump matches the API change (PVP)

Dependencies added: finite-typelits

API changes (from Hackage documentation)

Files

• ChangeLog.md +12/−0
• src/Tesla.hs +7/−3
• src/Tesla/Car.hs +14/−14
• src/Tesla/Car/Command.hs +35/−1
• src/Tesla/Car/Command/Charging.hs +16/−1
• src/Tesla/Car/Command/Climate.hs +47/−1
• tesla.cabal +5/−3
• test/Spec.hs +11/−0

@@ -1,5 +1,17 @@ # Changelog for tesla +# Release 0.5.0.0++Added:++1. maxDefrost+2. bioweapon defense mode controls+3. setAmps+4. scheduled charging configuration+5. scheduled departure configuration++Also added a prism for viewing `VehicleData` as an Aeson `Value`.+ # Release 0.3.1.0  Authentication is supported again (though not yet MFA path).

@@ -41,7 +41,7 @@ import           Data.Foldable              (asum) import           Data.Map.Strict            (Map) import qualified Data.Map.Strict            as Map-import           Data.Maybe                 (catMaybes, mapMaybe)+import           Data.Maybe                 (catMaybes) import           Data.Text                  (Text) import qualified Data.Text                  as T import qualified Data.Text.Encoding         as TE@@ -124,8 +124,12 @@                  . filter (\t -> isTagOpenName "input" t && fromAttrib "value" t /= "")                  . parseTags     fopts = aOpts & header "content-type" .~ ["application/x-www-form-urlencoded"]-    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)-+    xcode u = head [v | q <- tail (T.splitOn "?" (T.pack u)),+                        kv <- T.splitOn "&" q,+                        (k,v) <- paird (T.splitOn "=" kv),+                        k == "code"]+    paird [a,b] = [(a,b)]+    paird _     = []      findRedirect u opts a = preview (_Just . responseHeader "Location") <$> (inBody `catch` inException)       where

@@ -30,16 +30,15 @@   -- * Charger Info   Location(..), DestinationCharger(..), Supercharger(..), Charger(..),   superchargers, destinationChargers,-  -- * Lenses+  -- * Lenses/Prisms   lat, lon, _SC, _DC,-  name, location, distance_miles, available_stalls, total_stalls, site_closed,+  vdata, name, location, distance_miles, available_stalls, total_stalls, site_closed,   -- * Probably uninteresting internals   vehicleURL, currentVehicleID       ) where  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,9 +46,10 @@ import           Control.Monad.Logger    (MonadLogger) 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, _String)+                                          encode, fieldLabelModifier, fromJSON, genericParseJSON, withObject, (.:))+import           Data.Aeson.Lens         (_Bool, _Integer, _String, key, values) import qualified Data.ByteString.Lazy    as BL+import           Data.Foldable           (fold) import qualified Data.Map.Strict         as Map import           Data.Maybe              (fromJust, fromMaybe) import           Data.Ratio@@ -131,8 +131,7 @@ 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+  pure $ (r :: Value) ^?! (key "response" . key "state" . _String . to vsFromString)  -- | isAwake returns true if the current vehicle is awake and online. isAwake :: MonadIO m => Car m Bool@@ -147,21 +146,21 @@   pure . fromJust . inner $ r ^. responseBody     where inner = BL.stripPrefix "{\"response\":" <=< BL.stripSuffix "}" --- | Get an Aeson Value from this VehicleData.-maybeVal :: VehicleData -> Maybe Value-maybeVal = decode+-- | Prism for viewing 'VehicleData' as an Aeson 'Value'.+vdata :: Prism' VehicleData Value+vdata = prism' encode decode  -- | True if a user is present in the vehicle. isUserPresent :: VehicleData -> Bool-isUserPresent = (Just True ==) . preview (_Just . key "vehicle_state" . key "is_user_present" . _Bool) . maybeVal+isUserPresent = (Just True ==) . preview (vdata . key "vehicle_state" . key "is_user_present" . _Bool)  -- | True of the vehicle is currently charging. isCharging :: VehicleData -> Bool-isCharging = maybe False (> 0) . preview (_Just . key "charge_state" . key "charger_power" . _Integer) . maybeVal+isCharging = maybe False (> 0) . preview (vdata . key "charge_state" . key "charger_power" . _Integer)  -- | Get the timestamp from this VehicleData if present. maybeTeslaTS :: VehicleData -> Maybe UTCTime-maybeTeslaTS b = maybeVal b ^? _Just . key "vehicle_state" . key "timestamp" . _Integer . to pt+maybeTeslaTS b = b ^? vdata . key "vehicle_state" . key "timestamp" . _Integer . to pt   where pt x = posixSecondsToUTCTime . fromRational $ x % 1000  -- | Get the timestamp from this VehicleData or error if there isn't one.@@ -192,7 +191,8 @@ doors :: VehicleData -> Maybe [OpenState Door] doors b = traverse ds $ zip ["df", "dr", "pf", "pr", "ft", "rt"] [minBound..]   where-    ds (k,d) = c d <$> maybeVal b ^? _Just . key "vehicle_state" . key k . _Integer+    vs = b ^? vdata . key "vehicle_state"+    ds (k,d) = c d <$> vs ^? _Just . key k . _Integer     c d 0 = Closed d     c d _ = Open   d 

@@ -1,5 +1,9 @@+{-# LANGUAGE DataKinds           #-} {-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE TypeOperators       #-} {-| Module      : Tesla.Car.Command Description : Commands executed on a car.@@ -9,6 +13,7 @@ {-# OPTIONS_GHC -Wno-orphans #-}  module Tesla.Car.Command (+  Time(..), mkTime, fromTime,   runCmd, runCmd', CommandResponse, Car,   -- * TH support for generating commands.   mkCommand, mkCommands, mkNamedCommands) where@@ -16,9 +21,11 @@ import           Control.Lens import           Control.Monad.IO.Class (MonadIO (..)) import           Data.Aeson-import           Data.Aeson.Lens        (key, _Bool, _String)+import           Data.Aeson.Lens        (_Bool, _String, key) import qualified Data.ByteString.Lazy   as BL+import           Data.Finite            (Finite, getFinite, modulo) import           Data.Text              (Text)+import           GHC.TypeNats import           Language.Haskell.TH import           Network.Wreq.Types     (FormValue (..), Postable) import           Text.Casing            (fromSnake, toCamel)@@ -29,6 +36,33 @@ -- | A CommandResponse wraps an Either such that Left represents a -- failure message and Right suggests the command was successful. type CommandResponse = Either Text ()++-- | Data type representing local time in minutes since midnight.+newtype Time = Time (Finite 1440)++instance Show Time where show (Time t) = show (toInteger t)++instance Num Time where+  fromInteger = Time . modulo+  abs = id+  signum = const 1+  (Time f1) * (Time f2) = Time (f1 * f2)+  (Time f1) + (Time f2) = Time (f1 + f2)+  (Time f1) - (Time f2) = Time (f1 - f2)++instance FormValue Time where+  renderFormValue (Time x) = renderFormValue (getFinite x)++-- | Make a 'Time' with the given hours and minutes.+mkTime :: Finite 24 -> Finite 60 -> Time+mkTime h m = Time $ modulo (toInteger h * 60 + toInteger m)++-- | Get the hours and minutes out of a 'Time'.+fromTime :: Time -> (Finite 24, Finite 60)+fromTime (Time t) = bimap f f (t `divMod` 60)+  where+    f :: forall m n. (KnownNat m, KnownNat n, n <= m) => Finite m -> Finite n+    f = modulo . toInteger  -- | Run a command with a payload. runCmd :: (MonadIO m, Postable p) => String -> p -> Car m CommandResponse

@@ -2,7 +2,9 @@ {-# LANGUAGE TemplateHaskell   #-}  module Tesla.Car.Command.Charging (-  startCharging, stopCharging, setLimit, openChargePort, closeChargePort+  startCharging, stopCharging, setLimit, openChargePort, closeChargePort,+  setAmps,+  scheduledChargingOff, scheduleCharging   ) where  import           Control.Monad.IO.Class (MonadIO (..))@@ -10,8 +12,21 @@  import           Tesla.Car.Command +-- | Set the desired charge level (percent). setLimit :: MonadIO m => Int -> Car m CommandResponse setLimit to = runCmd "set_charge_limit" ["percent" := to ]++-- | Set the charge current.+setAmps :: MonadIO m => Int -> Car m CommandResponse+setAmps to = runCmd "set_charging_amps" ["charging_amps" := to]++-- | Disable scheduled charging.+scheduledChargingOff :: MonadIO m => Car m CommandResponse+scheduledChargingOff = runCmd "set_scheduled_charging" [ "enable" := False ]++-- | Schedule charging for the given number of minutes after midnight (local time).+scheduleCharging :: MonadIO m => Time -> Car m CommandResponse+scheduleCharging mins = runCmd "set_scheduled_charging" [ "enable" := True, "time" := mins ]  mkNamedCommands [("startCharging", "charge_start"),                  ("stopCharging", "charge_stop"),

@@ -1,10 +1,15 @@+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell   #-}  module Tesla.Car.Command.Climate (   hvacOn, hvacOff, heatSeat, Seat(..),   setTemps, wheelHeater, wheelHeaterOff, wheelHeaterOn,-  wakeUp+  maxDefrost,+  wakeUp,+  bioweaponMode,+  Sometimes(..), OffPeakConfig(..), Preconditioning,+  scheduledDepartureOff, scheduleDeparture   ) where  import           Control.Monad.IO.Class (MonadIO (..))@@ -22,6 +27,12 @@ wheelHeaterOff :: MonadIO m => Car m CommandResponse wheelHeaterOff = wheelHeater False +-- | Turn on or off bioweapon defense mode.+--+-- If HVAC is off, turning on bioweapon defense mode will also turn on HVAC.+bioweaponMode :: MonadIO m => Bool -> Car m CommandResponse+bioweaponMode on = runCmd "set_bioweapon_mode" ["on" := on]+ data Seat = DriverSeat | PassengerSeat | RearLeftSeat | RearCenterSeat | RearRightSeat  -- | Set heating levels for various seats.@@ -39,6 +50,41 @@ setTemps :: MonadIO m => (Double, Double) -> Car m CommandResponse setTemps (driver, passenger) = runCmd "set_temps" ["driver_temp" := driver, "passenger_temp" := passenger] +maxDefrost :: MonadIO m => Bool -> Car m CommandResponse+maxDefrost on = runCmd "set_preconditioning_max" ["on" := on]++scheduledDepartureOff :: MonadIO m => Car m CommandResponse+scheduledDepartureOff = runCmd "set_scheduled_departure" [ "enable" := False ]++-- | When configuring scheduled departure, preconditioning and+-- off-peak charging both have weekday only options.+data Sometimes = Never | Always | WeekdaysOnly++-- | Type alias to make 'scheduleDeparture' more readable.+type Preconditioning = Sometimes++-- | Configuration for off-peak charging for a schedule departure.+data OffPeakConfig = OffPeakConfig {+  _offPeakEnabled :: Sometimes,+  _offPeakEndTime :: Time+  }++-- | Schedule a departure.+--+-- For this to do anything useful, you need to specify at least one of+-- 'Preconditioning' and/or 'OffPeakConfig'.+scheduleDeparture :: MonadIO m => Time -> Preconditioning -> Maybe OffPeakConfig -> Car m CommandResponse+scheduleDeparture t p o = runCmd "set_scheduled_departure" (["enable" := True, "departure_time" := t] <> pp <> op o)+  where+    pp = s "preconditioning_enabled" "preconditioning_weekdays_only" p+    op Nothing  = opp (OffPeakConfig Never (Time 0))+    op (Just x) = opp x+    opp OffPeakConfig{..} = ("end_off_peak_time" := _offPeakEndTime) : s "off_peak_charging_enabled" "off_peak_charging_weekdays_only" _offPeakEnabled++    s e w = \case+           Never        -> [e := False, w := False]+           Always       -> [e := True, w := False]+           WeekdaysOnly -> [e := True, w := True]  mkNamedCommands [("hvacOn", "auto_conditioning_start"),                  ("hvacOff", "auto_conditioning_stop"),

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack ----- hash: 5822d046f556526df7df83678077d331881386b90f7f164b89597b8f4997c04b+-- hash: 4b13596c9991ae6a3294f3b1f6ac466fe9c7bf0a81479506fbd15c939f169d02  name:           tesla-version:        0.4.1.3+version:        0.5.0.0 synopsis:       Tesla API client. description:    Please see the README on GitHub at <https://github.com/dustin/tesla#readme> category:       Web@@ -67,6 +67,7 @@     , containers ==0.6.*     , cryptonite     , exceptions+    , finite-typelits     , generic-deriving >=1.12 && <1.15     , http-client     , lens >=4.17 && <5.2@@ -107,6 +108,7 @@     , containers ==0.6.*     , cryptonite     , exceptions+    , finite-typelits     , generic-deriving >=1.12 && <1.15     , http-client     , lens >=4.17 && <5.2

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds         #-} {-# LANGUAGE OverloadedStrings #-}  import           Test.Tasty@@ -5,14 +6,17 @@ import           Test.Tasty.QuickCheck as QC  import           Data.Aeson+import           Data.Finite import qualified Data.Map.Strict       as Map import           Data.Maybe            (fromJust) import           Data.Ratio import           Data.Time.Clock       (UTCTime) import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import           GHC.TypeNats          (KnownNat (..))  import           Tesla import           Tesla.Car+import           Tesla.Car.Command  sampleVehicleData :: VehicleData sampleVehicleData = "{\"id\":484265022836,\"user_id\":872475,\"vehicle_id\":842742,\"vin\":\"5YJXCDE2XHF000001\",\"display_name\":\"Bob\",\"option_codes\":\"AD15,MDL3,PBSB,RENA,BT37,ID3W,RF3G,S3PB,DRLH,DV2W,W39B,APF0,COUS,BC3B,CH07,PC30,FC3P,FG31,GLFR,HL31,HM31,IL31,LTPB,MR31,FM3B,RS3H,SA3P,STCP,SC04,SU3C,T3CA,TW00,TM00,UT3P,WR00,AU3P,APH3,AF00,ZCST,MI00,CDM0\",\"color\":null,\"tokens\":[\"token1\",\"token2\"],\"state\":\"online\",\"in_service\":false,\"id_s\":\"484265022836\",\"calendar_enabled\":true,\"api_version\":6,\"backseat_token\":null,\"backseat_token_updated_at\":null,\"charge_state\":{\"battery_heater_on\":false,\"battery_level\":79,\"battery_range\":225.71,\"charge_current_request\":48,\"charge_current_request_max\":48,\"charge_enable_request\":false,\"charge_energy_added\":0.0,\"charge_limit_soc\":80,\"charge_limit_soc_max\":100,\"charge_limit_soc_min\":50,\"charge_limit_soc_std\":90,\"charge_miles_added_ideal\":0.0,\"charge_miles_added_rated\":0.0,\"charge_port_cold_weather_mode\":null,\"charge_port_door_open\":true,\"charge_port_latch\":\"Engaged\",\"charge_rate\":0.0,\"charge_to_max_range\":false,\"charger_actual_current\":0,\"charger_phases\":null,\"charger_pilot_current\":48,\"charger_power\":13,\"charger_voltage\":0,\"charging_state\":\"Stopped\",\"conn_charge_cable\":\"SAE\",\"est_battery_range\":161.61,\"fast_charger_brand\":\"<invalid>\",\"fast_charger_present\":false,\"fast_charger_type\":\"ACSingleWireCAN\",\"ideal_battery_range\":282.78,\"managed_charging_active\":false,\"managed_charging_start_time\":null,\"managed_charging_user_canceled\":false,\"max_range_charge_counter\":0,\"minutes_to_full_charge\":20,\"not_enough_power_to_heat\":false,\"scheduled_charging_pending\":true,\"scheduled_charging_start_time\":1569738600,\"time_to_full_charge\":0.33,\"timestamp\":1569718275490,\"trip_charging\":false,\"usable_battery_level\":79,\"user_charge_enable_request\":null},\"climate_state\":{\"battery_heater\":false,\"battery_heater_no_power\":false,\"climate_keeper_mode\":\"off\",\"defrost_mode\":0,\"driver_temp_setting\":22.0,\"fan_status\":0,\"inside_temp\":22.3,\"is_auto_conditioning_on\":false,\"is_climate_on\":false,\"is_front_defroster_on\":false,\"is_preconditioning\":false,\"is_rear_defroster_on\":false,\"left_temp_direction\":317,\"max_avail_temp\":28.0,\"min_avail_temp\":15.0,\"outside_temp\":15.5,\"passenger_temp_setting\":22.0,\"remote_heater_control_enabled\":false,\"right_temp_direction\":317,\"seat_heater_left\":0,\"seat_heater_rear_center\":0,\"seat_heater_rear_left\":0,\"seat_heater_rear_right\":0,\"seat_heater_right\":0,\"side_mirror_heaters\":false,\"smart_preconditioning\":false,\"steering_wheel_heater\":false,\"timestamp\":1569718275490,\"wiper_blade_heater\":false},\"drive_state\":{\"gps_as_of\":1569718274,\"heading\":125,\"latitude\":34.13245,\"longitude\":-120.823475,\"native_latitude\":34.13245,\"native_location_supported\":1,\"native_longitude\":-120.823475,\"native_type\":\"wgs\",\"power\":0,\"shift_state\":\"P\",\"speed\":null,\"timestamp\":1569718275490},\"gui_settings\":{\"gui_24_hour_time\":true,\"gui_charge_rate_units\":\"kW\",\"gui_distance_units\":\"mi/hr\",\"gui_range_display\":\"Rated\",\"gui_temperature_units\":\"C\",\"show_range_units\":true,\"timestamp\":1569718275490},\"vehicle_config\":{\"can_accept_navigation_requests\":true,\"can_actuate_trunks\":true,\"car_special_type\":\"base\",\"car_type\":\"modelx\",\"charge_port_type\":\"US\",\"eu_vehicle\":false,\"exterior_color\":\"SteelGrey\",\"has_air_suspension\":true,\"has_ludicrous_mode\":false,\"motorized_charge_port\":true,\"plg\":true,\"rear_seat_heaters\":3,\"rear_seat_type\":4,\"rhd\":false,\"roof_color\":\"None\",\"seat_type\":0,\"spoiler_type\":\"Passive\",\"sun_roof_installed\":0,\"third_row_seats\":\"None\",\"timestamp\":1569718275490,\"trim_badging\":\"100d\",\"use_range_badging\":false,\"wheel_type\":\"AeroTurbine20\"},\"vehicle_state\":{\"api_version\":6,\"autopark_state_v2\":\"standby\",\"autopark_style\":\"standard\",\"calendar_supported\":true,\"car_version\":\"2019.32.11 bac8c51\",\"center_display_state\":0,\"df\":0,\"dr\":0,\"fd_window\":0,\"fp_window\":0,\"ft\":0,\"homelink_device_count\":1,\"homelink_nearby\":false,\"is_user_present\":true,\"last_autopark_error\":\"no_error\",\"locked\":true,\"media_state\":{\"remote_control_enabled\":true},\"notifications_supported\":true,\"odometer\":49081.642123,\"parsed_calendar_supported\":true,\"pf\":0,\"pr\":0,\"rd_window\":0,\"remote_start\":false,\"remote_start_enabled\":true,\"remote_start_supported\":true,\"rp_window\":0,\"rt\":32,\"sentry_mode\":false,\"sentry_mode_available\":true,\"smart_summon_available\":true,\"software_update\":{\"download_perc\":0,\"expected_duration_sec\":2700,\"install_perc\":1,\"status\":\"\",\"version\":\"\"},\"speed_limit_mode\":{\"active\":false,\"current_limit_mph\":80.0,\"max_limit_mph\":90,\"min_limit_mph\":50,\"pin_code_set\":true},\"summon_standby_mode_enabled\":true,\"timestamp\":1569718275489,\"valet_mode\":false,\"vehicle_name\":\"Bob\"}}"@@ -29,6 +33,9 @@ testTimestamp :: Assertion testTimestamp = assertEqual "timestamp" (posixSecondsToUTCTime . fromRational $ 1569718275489 % 1000) (teslaTS sampleVehicleData) +instance KnownNat n => Arbitrary (Finite n) where+  arbitrary = arbitraryBoundedEnum+ testDoors :: Assertion testDoors = assertEqual "doors" (Just [Closed DriverFront,                                        Closed DriverRear,@@ -47,8 +54,12 @@   assertEqual "vehicles" (Map.fromList [("MyCar", "848528")]) $ vehicles prods   assertEqual "energy" [2848535] $ energyIDs prods +propTimeConversion :: Finite 24 -> Finite 60 -> Property+propTimeConversion h m = (h, m) === fromTime (mkTime h m)+ tests :: [TestTree] tests = [+  testProperty "time conversion" propTimeConversion,   testCase "is user present" testIsUserPresent,   testCase "charging" testIsCharging,   testCase "timestamp" testTimestamp,