tesla 0.3.0.1 → 0.3.1.0
raw patch · 5 files changed
+139/−29 lines, 5 filesdep +base64-bytestringdep +cryptonitedep +memory
Dependencies added: base64-bytestring, cryptonite, memory, random, retry, tagsoup
Files
- ChangeLog.md +6/−0
- src/Tesla.hs +118/−25
- src/Tesla/Car.hs +1/−1
- src/Tesla/Energy.hs +0/−1
- tesla.cabal +14/−2
ChangeLog.md view
@@ -1,5 +1,11 @@ # Changelog for tesla +# Release 0.3.1.0++Authentication is supported again (though not yet MFA path).++More access to more APIs where available.+ # Release 0.1.0.1 A more informative exception is thrown from `runNamedCar` when an
src/Tesla.hs view
@@ -22,47 +22,140 @@ import Control.Lens-import Control.Monad.IO.Class (MonadIO (..))-import Data.Aeson (Value (..))-import Data.Aeson.Lens (key, _Array, _Integer, _String)-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 Network.Wreq (FormParam (..))+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 (Value (..), encode)+import Data.Aeson.Lens (_Array, _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, mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.Wreq (FormParam (..), Options, asJSON, checkResponse, defaults, header,+ hrRedirects, 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 = "https://owner-api.teslamotors.com/"+baseURL = "https://owner-api.teslamotors.com/" authURL :: String-authURL = baseURL <> "oauth/token"+authURL = "https://auth.tesla.com/oauth2/v3/authorize"+authTokenURL :: String+authTokenURL = "https://owner-api.teslamotors.com/oauth/token" authRefreshURL :: String-authRefreshURL = baseURL <> "oauth/token"+authRefreshURL = "https://auth.tesla.com/oauth2/v3/token" productsURL :: String productsURL = baseURL <> "api/1/products" - -- | Authenticate to the Tesla service. authenticate :: AuthInfo -> IO AuthResponse-authenticate AuthInfo{..} =- jpostWith defOpts authURL ["grant_type" := ("password" :: String),- "client_id" := _clientID,- "client_secret" := _clientSecret,- "email" := _email,- "password" := _password]+authenticate ai@AuthInfo{..} = recovering policy [retryOnAnyStatus] $ \_ -> do+ sess <- Sess.newSession+ verifier <- BS.pack . take 86 . randoms <$> getStdGen+ state <- clean64 . BS.pack . take 16 . randoms <$> getStdGen+ authenticate' sess verifier state ai + where+ policy = exponentialBackoff 2000000 <> limitRetries 9+ retryOnAnyStatus = logRetries retryOnAnyError reportError+ retryOnAnyError :: SomeException -> IO Bool+ retryOnAnyError _ = pure True+ reportError retriedOrCrashed err retryStatus = putStrLn $ defaultLogMsg retriedOrCrashed err retryStatus++clean64 :: BC.ByteString -> Text+clean64 = TE.decodeUtf8 . BS.reverse . BS.dropWhile (== 61) . BS.reverse . B64.encode++authenticate' :: Sess.Session -> BC.ByteString -> Text -> AuthInfo -> IO AuthResponse+authenticate' sess verifier state ai@AuthInfo{..} = do+ -- 1. First, grab the form.+ form <- formFields . BL.toStrict . view responseBody <$> Sess.getWith (aOpts & params .~ gparams) sess authURL+ -- There are required hidden fields -- if we didn't get them, we got the wrong http response+ when (null form) $ fail "tesla didn't return login form"++ -- 2. Now we post the form with all of our credentials.+ let form' = form <> ["identity" := _email, "credential" := _password]+ r2 <- Sess.customHistoriedPayloadMethodWith "POST" (fopts+ & params .~ gparams+ & redirects .~ 3+ & checkResponse ?~ (\_ _ -> pure ())+ ) sess authURL form'+ -- Extract the "code" from the URL we were redirected to... we can't actually follow the redirect :/+ let (Just code) = r2 ^? hrRedirects . folded . _2 . responseHeader "Location" . to (xcode . BC.unpack)+ let jreq = encode $ Object (mempty+ & at "grant_type" ?~ "authorization_code"+ & at "client_id" ?~ "ownerapi"+ & at "code" ?~ String code+ & at "code_verifier" ?~ String verifierHash+ & at "redirect_uri" ?~ "https://auth.tesla.com/void/callback")++ -- 3. Posting that code and other junk back to the token URL gets us temporary credentials.+ ar <- view responseBody <$> (Sess.postWith jOpts sess authRefreshURL jreq >>= asJSON)+ translateCreds ai ar++ where+ verifierHash = clean64 . BS.pack . BA.unpack $ hashWith SHA256 verifier+ gparams = [("client_id", "ownerapi"),+ ("code_challenge", verifierHash),+ ("code_challenge_method", "S256"),+ ("redirect_uri", "https://auth.tesla.com/void/callback"),+ ("response_type", "code"),+ ("scope", "openid email offline_access"),+ ("state", state)]+ -- extract all the non-empty form fields from an HTML response+ formFields = map (\t -> fromAttrib "name" t := fromAttrib "value" t)+ . 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)++translateCreds :: AuthInfo -> AuthResponse -> IO AuthResponse+translateCreds ai@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"+ & at "client_id" ?~ String (T.pack _clientID)+ )++ ar <- jpostWith (jOpts & header "Authorization" .~ ["bearer " <> BC.pack _access_token]) authTokenURL jreq2+ pure (ar & refresh_token .~ _refresh_token) -- replace the refresh token with the one from step 3++ -- | Refresh authentication credentials using a refresh token. refreshAuth :: AuthInfo -> AuthResponse -> IO AuthResponse-refreshAuth AuthInfo{..} AuthResponse{..} =- jpostWith defOpts authRefreshURL ["grant_type" := ("refresh_token" :: String),- "client_id" := _clientID,- "client_secret" := _clientSecret,- "refresh_token" := _refresh_token]+refreshAuth ai@AuthInfo{..} AuthResponse{..} = do+ ar <- jpostWith jOpts authRefreshURL (encode $ Object (mempty+ & at "grant_type" ?~ "refresh_token"+ & at "client_id" ?~ "ownerapi"+ & at "refresh_token" ?~ String (T.pack _refresh_token)+ & at "scope" ?~ "openid email offline_access"+ ))+ translateCreds ai ar +jOpts :: Options+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"+ -- | A VehicleID. type VehicleID = Text @@ -90,7 +183,7 @@ products ai = decodeProducts <$> jgetWith (authOpts ai) productsURL -- | Get a mapping of vehicle name to vehicle ID.-vehicles :: [Product] -> (Map Text Text)+vehicles :: [Product] -> Map Text Text vehicles = Map.fromList . toListOf (folded . _ProductVehicle) -- | Get a list of Solar ID installations.
src/Tesla/Car.hs view
@@ -140,7 +140,7 @@ -- | True if a user is present in the vehicle. isUserPresent :: VehicleData -> Bool-isUserPresent = fromMaybe False . preview (_Just . key "vehicle_state" . key "is_user_present" . _Bool) . maybeVal+isUserPresent = (Just True ==) . preview (_Just . key "vehicle_state" . key "is_user_present" . _Bool) . maybeVal -- | True of the vehicle is currently charging. isCharging :: VehicleData -> Bool
src/Tesla/Energy.hs view
@@ -20,7 +20,6 @@ import Control.Exception (Exception) import Control.Monad.Catch (MonadCatch (..), MonadMask (..), MonadThrow (..))-import Control.Monad.Fail (MonadFail (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Control.Monad.Logger (MonadLogger)
tesla.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e88c4dc4c9bcb802b86bb2418fc6188ea7f37139b888b3cc1d9eded702299a5a+-- hash: 236741807bd9077d0f64ee24d77b18f02891eb559659adf6c66a91c5b5216fe5 name: tesla-version: 0.3.0.1+version: 0.3.1.0 synopsis: Tesla API client. description: Please see the README on GitHub at <https://github.com/dustin/tesla#readme> category: Web@@ -58,15 +58,21 @@ build-depends: aeson >=1.4.5 && <1.5 , base >=4.7 && <5+ , base64-bytestring , bytestring >=0.10 && <0.11 , casing >=0.1.4 && <0.2 , containers >=0.6 && <0.7+ , cryptonite , exceptions , generic-deriving >=1.12 && <1.14 , lens >=4.17 && <4.19 , lens-aeson >=1.0 && <1.2+ , memory , monad-logger , mtl >=2.2 && <2.3+ , random+ , retry+ , tagsoup , template-haskell >=2.14 && <2.16 , text >=1.2 && <1.3 , time >=1.8 && <1.10@@ -88,15 +94,21 @@ HUnit , aeson >=1.4.5 && <1.5 , base >=4.7 && <5+ , base64-bytestring , bytestring >=0.10 && <0.11 , casing >=0.1.4 && <0.2 , containers >=0.6 && <0.7+ , cryptonite , exceptions , generic-deriving >=1.12 && <1.14 , lens >=4.17 && <4.19 , lens-aeson >=1.0 && <1.2+ , memory , monad-logger , mtl >=2.2 && <2.3+ , random+ , retry+ , tagsoup , tasty , tasty-hunit , tasty-quickcheck