tesla (empty) → 0.1.0.0
raw patch · 23 files changed
+906/−0 lines, 23 filesdep +HUnitdep +aesondep +basesetup-changed
Dependencies added: HUnit, aeson, base, bytestring, casing, containers, generic-deriving, lens, lens-aeson, mtl, tasty, tasty-hunit, tasty-quickcheck, template-haskell, tesla, text, time, vector, wreq
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- src/Tesla.hs +110/−0
- src/Tesla/Car.hs +241/−0
- src/Tesla/Command.hs +87/−0
- src/Tesla/Command/Alerts.hs +11/−0
- src/Tesla/Command/Charging.hs +19/−0
- src/Tesla/Command/Climate.hs +46/−0
- src/Tesla/Command/Doors.hs +18/−0
- src/Tesla/Command/Homelink.hs +11/−0
- src/Tesla/Command/Media.hs +18/−0
- src/Tesla/Command/RemoteStart.hs +14/−0
- src/Tesla/Command/Sentry.hs +12/−0
- src/Tesla/Command/Sharing.hs +20/−0
- src/Tesla/Command/Software.hs +19/−0
- src/Tesla/Command/SpeedLimit.hs +24/−0
- src/Tesla/Command/Valet.hs +15/−0
- src/Tesla/Command/Windows.hs +28/−0
- src/Tesla/Commands.hs +25/−0
- tesla.cabal +101/−0
- test/Spec.hs +47/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for tesla++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Dustin Sallings (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Dustin Sallings nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# tesla++Tesla API for Haskell.++See also: https://tesla-api.timdorr.com/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Tesla.hs view
@@ -0,0 +1,110 @@+{-|+Module: Tesla+Description: Tesla API implementation.++'Tesla' is intended to provide access to all known Tesla APIs as+documented at https://tesla-api.timdorr.com/+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Tesla+ ( authenticate, refreshAuth, AuthResponse(..),+ AuthInfo(..),+ vehicles,+ fromToken, authOpts, baseURL+ ) where+++import Control.Lens+import Control.Monad.IO.Class (MonadIO (..))+import Data.Aeson (FromJSON (..), Options (..),+ Value (..), defaultOptions,+ fieldLabelModifier, genericParseJSON)+import Data.Aeson.Lens (key, values, _String)+import qualified Data.ByteString.Char8 as BC+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import Generics.Deriving.Base (Generic)+import Network.Wreq (FormParam (..), Options, Response,+ asJSON, defaults, getWith, header,+ postWith, responseBody)++baseURL :: String+baseURL = "https://owner-api.teslamotors.com/"+authURL :: String+authURL = baseURL <> "oauth/token"+authRefreshURL :: String+authRefreshURL = baseURL <> "oauth/token"+vehiclesURL :: String+vehiclesURL = baseURL <> "api/1/vehicles"+++userAgent :: BC.ByteString+userAgent = "github.com/dustin/tesla 0.1"++defOpts :: Network.Wreq.Options+defOpts = defaults & header "User-Agent" .~ [userAgent]++-- | An Authentication request.+data AuthInfo = AuthInfo {+ _clientID :: String+ , _clientSecret :: String+ , _email :: String+ , _password :: String+ , _bearerToken :: String+ } deriving(Show)++-- | Get an AuthInfo instance from a bearer token.+fromToken :: String -> AuthInfo+fromToken t = AuthInfo{_bearerToken=t, _clientID="", _clientSecret="", _email="", _password=""}++jsonOpts :: Data.Aeson.Options+jsonOpts = defaultOptions {+ fieldLabelModifier = dropWhile (== '_')+ }++-- | An Authentication response.+data AuthResponse = AuthResponse {+ _access_token :: String+ , _expires_in :: Int+ , _refresh_token :: String+ } deriving(Generic, Show)++instance FromJSON AuthResponse where+ parseJSON = genericParseJSON jsonOpts++-- | Authenticate to the Tesla service.+authenticate :: AuthInfo -> IO AuthResponse+authenticate AuthInfo{..} = do+ r <- asJSON =<< postWith defOpts authURL ["grant_type" := ("password" :: String),+ "client_id" := _clientID,+ "client_secret" := _clientSecret,+ "email" := _email,+ "password" := _password] :: IO (Response AuthResponse)+ pure $ r ^. responseBody++-- | Refresh authentication credentials using a refresh token.+refreshAuth :: AuthInfo -> AuthResponse -> IO AuthResponse+refreshAuth AuthInfo{..} AuthResponse{..} = do+ r <- asJSON =<< postWith defOpts authRefreshURL ["grant_type" := ("refresh_token" :: String),+ "client_id" := _clientID,+ "client_secret" := _clientSecret,+ "refresh_token" := _refresh_token] :: IO (Response AuthResponse)+ pure $ r ^. responseBody+++-- | Get a set of wreq options from an 'AuthInfo'.+authOpts :: AuthInfo -> Network.Wreq.Options+authOpts AuthInfo{..} = defOpts & header "Authorization" .~ ["Bearer " <> BC.pack _bearerToken]++-- | Get a mapping of vehicle name to vehicle ID.+vehicles :: MonadIO m => AuthInfo -> m (Map Text Text)+vehicles ai = do+ r <- liftIO (asJSON =<< getWith (authOpts ai) vehiclesURL :: IO (Response Value))+ let vals = r ^.. responseBody . key "response" . values . key "id_s" . _String+ keys = r ^.. responseBody . key "response" . values . key "display_name" . _String+ pure (Map.fromList $ zip keys vals)
+ src/Tesla/Car.hs view
@@ -0,0 +1,241 @@+{-|+Module: Tesla.Car+Description: Tesla car-specific APIs.++Access of car-specific APIs.+-}++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Car (+ -- * Car Monad and related types.+ Car, runCar, runNamedCar,+ VehicleID,+ -- * Requests+ vehicleData, nearbyChargers,+ -- * Convenience functions for examining VehicleData+ VehicleData, isUserPresent, isCharging, teslaTS, maybeTeslaTS,+ Door(..), OpenState(..), doors, openDoors,+ -- * Charger Info+ Location(..), DestinationCharger(..), Supercharger(..), Charger(..),+ superchargers, destinationChargers,+ -- * Lenses+ lat, lon, _SC, _DC,+ name, location, distance_miles, available_stalls, total_stalls, site_closed,+ -- * Probably uninteresting internals+ vehicleURL, authInfo, vehicleID+ ) where++import Control.Lens+import Control.Monad ((<=<))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Reader (ReaderT (..), asks, runReaderT)+import Data.Aeson (FromJSON (..), Options (..),+ Result (..), Value (..), decode,+ defaultOptions, fieldLabelModifier,+ fromJSON, genericParseJSON, withObject,+ (.:))+import Data.Aeson.Lens (key, _Array, _Bool, _Integer)+import qualified Data.ByteString.Lazy as BL+import qualified Data.Map.Strict as Map+import Data.Maybe (fromJust, fromMaybe)+import Data.Ratio+import Data.Text (Text, unpack)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import qualified Data.Vector as V+import Generics.Deriving.Base (Generic)+import Network.Wreq (Response, asJSON, getWith,+ responseBody)++import Tesla++-- | Get the URL for a named endpoint for a given vehicle.+vehicleURL :: VehicleID -> String -> String+vehicleURL v c = mconcat [baseURL, "api/1/vehicles/", unpack v, "/", c]++-- | A VehicleID.+type VehicleID = Text++data CarEnv = CarEnv {+ _authInfo :: IO AuthInfo,+ _vid :: VehicleID+ }++-- | Get authInfo from the Car Monad.+authInfo :: MonadIO m => Car m AuthInfo+authInfo = liftIO =<< asks _authInfo++-- | Get the current vehicle ID from the Car Monad.+vehicleID :: Monad m => Car m VehicleID+vehicleID = asks _vid++-- | Car Monad for accessing car-specific things.+type Car = ReaderT CarEnv++-- | Run a Car Monad with the given Vehicle ID+runCar :: MonadIO m => IO AuthInfo -> VehicleID -> Car m a -> m a+runCar ai vi f = runReaderT f (CarEnv ai vi)++-- | Run a Car Monad by looking up a car by name.+runNamedCar :: MonadIO m => Text -> IO AuthInfo -> Car m a -> m a+runNamedCar name ai f = do+ a <- liftIO ai+ vs <- vehicles a+ runCar ai (vs Map.! name) f++-- | Giant blob of VehicleData describing all known state of the vehicle.+--+-- This is not separated into discrete+-- A VehicleIDfields because that's easy enough to do with Aeson and+-- Lens when you need it but some convenience methods for common+-- | A VehicleIDaccesses are available in this module.+type VehicleData = BL.ByteString++-- | Fetch the VehicleData.+vehicleData :: MonadIO m => Car m VehicleData+vehicleData = do+ a <- authInfo+ v <- vehicleID+ r <- liftIO $ getWith (authOpts a) (vehicleURL v "vehicle_data")+ 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++-- | True if a user is present in the vehicle.+isUserPresent :: VehicleData -> Bool+isUserPresent b = let mb = maybeVal b ^? _Just . key "vehicle_state" . key "is_user_present" . _Bool in+ fromMaybe False mb++-- | True of the vehicle is currently charging.+isCharging :: VehicleData -> Bool+isCharging b = let mi = maybeVal b ^? _Just . key "charge_state" . key "charger_power" . _Integer in+ fromMaybe 0 mi > 0++-- | Get the timestamp from this VehicleData if present.+maybeTeslaTS :: VehicleData -> Maybe UTCTime+maybeTeslaTS b = pt <$> mv+ where mv = maybeVal b ^? _Just . key "vehicle_state" . key "timestamp" . _Integer+ pt x = posixSecondsToUTCTime . fromRational $ x % 1000++-- | Get the timestamp from this VehicleData or error if there isn't one.+teslaTS :: VehicleData -> UTCTime+teslaTS b = fromMaybe (error . show $ b) . maybeTeslaTS $ b++-- | The various doors.+data Door = DriverFront+ | DriverRear+ | PassengerFront+ | PassengerRear+ | FrontTrunk+ | RearTrunk+ deriving (Show, Bounded, Enum, Eq)++-- I only care about 0, but these are the observed values:+-- 0 or 1 for df+-- 0 or 2 for pf+-- 0 or 4 for dr+-- 0 or 8 for pr+-- 0 or 16 for ft+-- 0 or 32 for rt+data OpenState a = Closed a | Open a deriving (Show, Eq)++-- | True if the given OpenState represents an open door.+isOpen :: OpenState a -> Bool+isOpen (Closed _) = False+isOpen _ = True++-- | Return the thing that is open in this OpenState.+fromOpenState :: OpenState a -> a+fromOpenState (Open d) = d+fromOpenState (Closed d) = d++-- | Return a list of doors and their OpenState.+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+ c d 0 = Closed d+ c d _ = Open d++-- | Return a list of open doors.+openDoors :: VehicleData -> [Door]+openDoors b = maybe [] (map fromOpenState . filter isOpen) (doors b)++-- | Location, Location, Location.+data Location = Location { _lat :: Double, _lon :: Double } deriving (Show, Generic)++makeLenses ''Location++instance FromJSON Location where+ parseJSON = withObject "location" $ \v -> Location <$> v .: "lat" <*> v .: "long"++chargeOpts :: Data.Aeson.Options+chargeOpts = defaultOptions {+ fieldLabelModifier = dropWhile (== '_')+ }++-- | A destination charger (provided by nearbyChargers).+data DestinationCharger = DestinationCharger {+ _location :: Location,+ _name :: Text,+ _distance_miles :: Double+ } deriving (Show, Generic)++makeFieldsNoPrefix ''DestinationCharger++instance FromJSON DestinationCharger where+ parseJSON = genericParseJSON chargeOpts++-- | A supercharger (provided by nearbyChargers).+data Supercharger = Supercharger {+ _location :: Location,+ _name :: Text,+ _distance_miles :: Double,+ _available_stalls :: Int,+ _total_stalls :: Int,+ _site_closed :: Bool+ } deriving(Show, Generic)++makeFieldsNoPrefix ''Supercharger++instance FromJSON Supercharger where+ parseJSON = genericParseJSON chargeOpts++-- | Eitehr a Supercharger or Destination charger.+data Charger = SC Supercharger | DC DestinationCharger deriving(Show)++makePrisms ''Charger++-- | Return only the superchargers from a Charger list.+superchargers :: [Charger] -> [Supercharger]+superchargers = toListOf (folded . _SC)++-- | Return only the destination chargers from a Charger list.+destinationChargers :: [Charger] -> [DestinationCharger]+destinationChargers = toListOf (folded . _DC)++-- | Get the nearby chargers.+nearbyChargers :: MonadIO m => Car m [Charger]+nearbyChargers = do+ a <- authInfo+ v <- vehicleID+ r <- liftIO (asJSON =<< getWith (authOpts a) (vehicleURL v "nearby_charging_sites") :: IO (Response Value))+ let rb = r ^. responseBody+ chargers = parseOne rb SC "superchargers" <> parseOne rb DC "destination_charging"+ pure (V.toList chargers)++ where+ parseOne rb f k = let rs = traverse fromJSON (rb ^. key "response" . key k . _Array) in+ f <$> case rs of+ Error e -> error e+ Success s -> s
+ src/Tesla/Command.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module : Tesla.Command+Description : Commands executed on a car.++Executing commands within the Car Monad.+-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Tesla.Command (+ runCmd, runCmd', CommandResponse, Car,+ -- * TH support for generating commands.+ mkCommand, mkCommands, mkNamedCommands) where++import Control.Lens+import Control.Monad.IO.Class (MonadIO (..))+import Data.Aeson+import Data.Aeson.Lens (key, _Bool, _String)+import qualified Data.ByteString.Lazy as BL+import Data.Text (Text)+import Language.Haskell.TH+import Network.Wreq (Response, asJSON, postWith,+ responseBody)+import Network.Wreq.Types (FormValue (..), Postable)+import Text.Casing (fromSnake, toCamel)+++import Tesla+import Tesla.Car++-- | A CommandResponse wraps an Either such that Left represents a+-- failure message and Right suggests the command was successful.+type CommandResponse = Either Text ()++-- | Run a command with a payload.+runCmd :: (MonadIO m, Postable p) => String -> p -> Car m CommandResponse+runCmd cmd p = do+ a <- authInfo+ v <- vehicleID+ r <- liftIO (asJSON =<< postWith (authOpts a) (vehicleURL v $ "command/" <> cmd) p :: IO (Response Value))+ pure $ case r ^? responseBody . key "response" . key "result" . _Bool of+ Just True -> Right ()+ _ -> Left $ r ^. responseBody . key "response" . key "reason" . _String++-- | Run command without a payload+runCmd' :: MonadIO m => String -> Car m CommandResponse+runCmd' cmd = runCmd cmd BL.empty++instance FormValue Bool where+ renderFormValue True = "true"+ renderFormValue False = "false"+++-- | Build a simple named command car that posts to the given named endpoint.+mkCommand :: String -> String -> Q [Dec]+mkCommand s u = do+ let m = mkName "m"+ pure $ [+ SigD (mkName s) (ForallT [PlainTV m] [AppT (ConT (mkName "MonadIO")) (VarT m)]+ (AppT (AppT (ConT (mkName "Car")) (VarT m)) (ConT (mkName "CommandResponse")))),+ FunD (mkName s) [Clause [] (NormalB expr) []]]+ where expr = LamE [] (AppE (VarE (mkName "runCmd'")) (LitE (StringL u)))++cmapM :: (Monoid b, Applicative f) => (a -> f b) -> [a] -> f b+cmapM f xs = mconcat <$> traverse f xs++-- | Build a bunch of commands from a list of named endpoints, defining+-- functions by removing the common prefix.+mkCommands :: [String] -> Q [Dec]+mkCommands targets = cmapM easyCMD targets+ where+ prefix = commonPrefix targets+ easyCMD :: String -> Q [Dec]+ easyCMD target = do+ let s = drop (length prefix) target+ mn = (toCamel . fromSnake) s+ mkCommand mn target++ commonPrefix = fmap head . takeWhile (\(x:xs) -> all (== x) xs) . tp+ where+ tp xs+ | any null xs = []+ | otherwise = (head <$> xs) : tp (tail <$> xs)++-- Make commands with given names.+mkNamedCommands :: [(String, String)] -> Q [Dec]+mkNamedCommands = cmapM (uncurry mkCommand)
+ src/Tesla/Command/Alerts.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Command.Alerts (+ honkHorn, flashLights+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Tesla.Command++mkCommands ["honk_horn", "flash_lights"]
+ src/Tesla/Command/Charging.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Command.Charging (+ startCharging, stopCharging, setLimit, openChargePort, closeChargePort+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))++import Tesla.Command++setLimit :: MonadIO m => Int -> Car m CommandResponse+setLimit to = runCmd "set_charge_limit" ["percent" := to ]++mkNamedCommands [("startCharging", "charge_start"),+ ("stopCharging", "charge_stop"),+ ("openChargePort", "charge_port_door_open"),+ ("closeChargePort", "charge_port_door_close")]
+ src/Tesla/Command/Climate.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Command.Climate (+ hvacOn, hvacOff, heatSeat, Seat(..),+ setTemps, wheelHeater, wheelHeaterOff, wheelHeaterOn,+ wakeUp+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))++import Tesla.Command++-- | Turn on the steering wheel heater+wheelHeater :: MonadIO m => Bool -> Car m CommandResponse+wheelHeater on = runCmd "remote_steering_wheel_heater_request" ["on" := on]++wheelHeaterOn :: MonadIO m => Car m CommandResponse+wheelHeaterOn = wheelHeater True++wheelHeaterOff :: MonadIO m => Car m CommandResponse+wheelHeaterOff = wheelHeater False++data Seat = DriverSeat | PassengerSeat | RearLeftSeat | RearCenterSeat | RearRightSeat++-- | Set heating levels for various seats.+heatSeat :: MonadIO m => Seat -> Int -> Car m CommandResponse+heatSeat seat level = runCmd "remote_seat_heater_request" ["heater" := seatNum seat, "level" := level]+ where+ seatNum :: Seat -> Int+ seatNum DriverSeat = 0+ seatNum PassengerSeat = 1+ seatNum RearLeftSeat = 2+ seatNum RearCenterSeat = 4+ seatNum RearRightSeat = 5++-- | Set the main HVAC temperatures.+setTemps :: MonadIO m => (Double, Double) -> Car m CommandResponse+setTemps (driver, passenger) = runCmd "set_temps" ["driver_temp" := driver, "passenger_temp" := passenger]+++mkNamedCommands [("hvacOn", "auto_conditioning_start"),+ ("hvacOff", "auto_conditioning_stop"),+ ("wakeUp", "wake_up")]+
+ src/Tesla/Command/Doors.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.Doors (+ actuateFrontTrunk, actuateRearTrunk+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))+import Tesla.Command++atr :: MonadIO m => String -> Car m CommandResponse+atr w = runCmd "actuate_trunk" [ "which_trunk" := w ]++actuateFrontTrunk :: MonadIO m => Car m CommandResponse+actuateFrontTrunk = atr "front"++actuateRearTrunk :: MonadIO m => Car m CommandResponse+actuateRearTrunk = atr "rear"
+ src/Tesla/Command/Homelink.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.Homelink (trigger) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))+import Tesla.Command++-- | Trigger nearby homelink with the given (lat,lon)+trigger :: MonadIO m => (Double, Double) -> Car m CommandResponse+trigger (lat,lon) = runCmd "flash_lights" ["lat" := lat, "lon" := lon]
+ src/Tesla/Command/Media.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Command.Media where++import Control.Monad.IO.Class (MonadIO (..))++import Tesla.Command++mkCommands [+ "media_toggle_playback",+ "media_next_track",+ "media_prev_track",+ "media_next_fav",+ "media_prev_fav",+ "media_volume_up",+ "media_volume_down"+ ]
+ src/Tesla/Command/RemoteStart.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.RemoteStart where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))++import Tesla.Command++-- | Enables keyless driving.+--+-- This requires your account password, so, you know, be careful where you use it.+remoteStart :: MonadIO m => String -> Car m CommandResponse+remoteStart pw = runCmd "remote_start_drive" ["password" := pw]
+ src/Tesla/Command/Sentry.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.Sentry (+ setSentryMode+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))+import Tesla.Command++setSentryMode :: MonadIO m => Bool -> Car m CommandResponse+setSentryMode on = runCmd "set_sentry_mode" [ "on" := on ]
+ src/Tesla/Command/Sharing.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.Sharing (share) where++import Control.Monad.IO.Class (MonadIO (..))+import Data.Aeson+import Data.Text (Text)+import Data.Time.Clock.POSIX (getCurrentTime, utcTimeToPOSIXSeconds)++import Tesla.Command++share :: MonadIO m => Text -> Car m CommandResponse+share to = do+ now <- fst . properFraction . utcTimeToPOSIXSeconds <$> liftIO getCurrentTime+ runCmd "share" $ object [+ "type" .= ("share_ext_content_raw" :: Text),+ "value" .= object [ "android.intent.extra.TEXT" .= to ],+ "locale" .= ("en-US" :: Text),+ "timestamp_ms" .= (now * (1000::Int))+ ]
+ src/Tesla/Command/Software.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Command.Software (+ scheduleUpdate, cancelUpdate+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))++import Tesla.Command++-- | Schedule a software update in this many seconds.+scheduleUpdate :: MonadIO m => Int -> Car m CommandResponse+scheduleUpdate secs = runCmd "schedule_software_update" ["offset_sec" := secs]++-- | Cancel a scheduled software update.+mkCommand "cancelUpdate" "cancel_software_update"+
+ src/Tesla/Command/SpeedLimit.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.SpeedLimit (+ speedLimit, activateSpeedLimit, deactivateSpeedLimit, clearSpeedLimitPIN+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))+import Tesla.Command++speedLimit :: MonadIO m => Int -> Car m CommandResponse+speedLimit to = runCmd "speed_limit_set_limit" ["limit_mph" := to ]++speedo :: MonadIO m => String -> Int -> Car m CommandResponse+speedo c pin = runCmd c ["pin" := pin ]++activateSpeedLimit :: MonadIO m => Int -> Car m CommandResponse+activateSpeedLimit = speedo "speed_limit_activate"++deactivateSpeedLimit :: MonadIO m => Int -> Car m CommandResponse+deactivateSpeedLimit = speedo "speed_limit_deactivate"++clearSpeedLimitPIN :: MonadIO m => Int -> Car m CommandResponse+clearSpeedLimitPIN = speedo "speed_limit_clear_pin"
+ src/Tesla/Command/Valet.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Tesla.Command.Valet (+ setValetMode, clearValetPIN+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Network.Wreq (FormParam (..))+import Tesla.Command++setValetMode :: MonadIO m => Bool -> Int -> Car m CommandResponse+setValetMode on pin = runCmd "set_valet_mode" [ "on" := on, "password" := pin]++mkCommand "clearValetPIN" "reset_valet_pin"
+ src/Tesla/Command/Windows.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Tesla.Command.Windows (+ ventWindows, closeWindows, ventSunroof, closeSunroof+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Data.Text (Text)+import Network.Wreq (FormParam (..))+import Tesla.Command++windowControl :: MonadIO m => Text -> (Double, Double) -> Car m CommandResponse+windowControl x (lat,lon) = runCmd "window_control" [ "command" := x, "lat" := lat, "lon" := lon]++ventWindows :: MonadIO m => Car m CommandResponse+ventWindows = windowControl "vent" (0,0)++closeWindows :: MonadIO m => (Double, Double) -> Car m CommandResponse+closeWindows = windowControl "close"++sc :: MonadIO m => Text -> Car m CommandResponse+sc c = runCmd "sun_roof_control" [ "state" := c ]++ventSunroof :: MonadIO m => Car m CommandResponse+ventSunroof = sc "vent"++closeSunroof :: MonadIO m => Car m CommandResponse+closeSunroof = sc "close"
+ src/Tesla/Commands.hs view
@@ -0,0 +1,25 @@+{-|+Module: Tesla.Commands+Description: Convenience module for importing all commands at once.++All of the commands supported by this library.++This is meant to be imported qualified, e.g.:++> import qualified Tesla.Commands as CMD+-}++module Tesla.Commands ( module CMD ) where++import Tesla.Command.Alerts as CMD+import Tesla.Command.Charging as CMD+import Tesla.Command.Climate as CMD+import Tesla.Command.Doors as CMD+import Tesla.Command.Homelink as CMD+import Tesla.Command.Media as CMD+import Tesla.Command.Sentry as CMD+import Tesla.Command.Sharing as CMD+import Tesla.Command.Software as CMD+import Tesla.Command.SpeedLimit as CMD+import Tesla.Command.Valet as CMD+import Tesla.Command.Windows as CMD
+ tesla.cabal view
@@ -0,0 +1,101 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 8cdeecd446c907e59d314404de69be9fd58fd7e9276d2d0e1b34f4f222b77c1f++name: tesla+version: 0.1.0.0+synopsis: Tesla API client.+description: Please see the README on GitHub at <https://github.com/dustin/tesla#readme>+category: Web+homepage: https://github.com/dustin/tesla#readme+bug-reports: https://github.com/dustin/tesla/issues+author: Dustin Sallings+maintainer: dustin@spy.net+copyright: MIT+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/dustin/tesla++library+ exposed-modules:+ Tesla+ Tesla.Car+ Tesla.Command+ Tesla.Command.Alerts+ Tesla.Command.Charging+ Tesla.Command.Climate+ Tesla.Command.Doors+ Tesla.Command.Homelink+ Tesla.Command.Media+ Tesla.Command.RemoteStart+ Tesla.Command.Sentry+ Tesla.Command.Sharing+ Tesla.Command.Software+ Tesla.Command.SpeedLimit+ Tesla.Command.Valet+ Tesla.Command.Windows+ Tesla.Commands+ other-modules:+ Paths_tesla+ hs-source-dirs:+ src+ default-extensions: OverloadedStrings RecordWildCards NamedFieldPuns+ ghc-options: -Wall+ build-depends:+ aeson >=1.4.5 && <1.5+ , base >=4.7 && <5+ , bytestring >=0.10 && <0.11+ , casing >=0.1.4 && <0.2+ , containers >=0.6 && <0.7+ , generic-deriving >=1.12 && <1.14+ , lens >=4.17 && <4.19+ , lens-aeson >=1.0 && <1.2+ , mtl >=2.2 && <2.3+ , template-haskell >=2.14 && <2.16+ , text >=1.2 && <1.3+ , time >=1.8 && <1.10+ , vector >=0.12.0 && <0.13+ , wreq >=0.5 && <0.6+ default-language: Haskell2010++test-suite tesla-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_tesla+ hs-source-dirs:+ test+ default-extensions: OverloadedStrings RecordWildCards NamedFieldPuns+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HUnit+ , aeson >=1.4.5 && <1.5+ , base >=4.7 && <5+ , bytestring >=0.10 && <0.11+ , casing >=0.1.4 && <0.2+ , containers >=0.6 && <0.7+ , generic-deriving >=1.12 && <1.14+ , lens >=4.17 && <4.19+ , lens-aeson >=1.0 && <1.2+ , mtl >=2.2 && <2.3+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , template-haskell >=2.14 && <2.16+ , tesla+ , text >=1.2 && <1.3+ , time >=1.8 && <1.10+ , vector >=0.12.0 && <0.13+ , wreq >=0.5 && <0.6+ default-language: Haskell2010
+ test/Spec.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC++import Data.Ratio+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)++import Tesla+import Tesla.Car++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\"}}"++testIsUserPresent :: Assertion+testIsUserPresent = assertBool "expected user not present" $ isUserPresent sampleVehicleData++testIsCharging :: Assertion+testIsCharging = assertBool "expected charging" $ isCharging sampleVehicleData++testTimestamp :: Assertion+testTimestamp = assertEqual "timestamp" (posixSecondsToUTCTime . fromRational $ 1569718275489 % 1000) (teslaTS sampleVehicleData)++testDoors :: Assertion+testDoors = assertEqual "doors" (Just [Closed DriverFront,+ Closed DriverRear,+ Closed PassengerFront,+ Closed PassengerRear,+ Closed FrontTrunk,+ Open RearTrunk]) (doors sampleVehicleData)++testOpenDoors :: Assertion+testOpenDoors = assertEqual "open" [RearTrunk] (openDoors sampleVehicleData)++tests :: [TestTree]+tests = [+ testCase "is user present" testIsUserPresent,+ testCase "charging" testIsCharging,+ testCase "timestamp" testTimestamp,+ testCase "doors" testDoors,+ testCase "open doors" testOpenDoors+ ]++main :: IO ()+main = defaultMain $ testGroup "All Tests" tests