diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/src/Tesla.hs b/src/Tesla.hs --- a/src/Tesla.hs +++ b/src/Tesla.hs @@ -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. diff --git a/src/Tesla/Car.hs b/src/Tesla/Car.hs --- a/src/Tesla/Car.hs +++ b/src/Tesla/Car.hs @@ -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 diff --git a/src/Tesla/Energy.hs b/src/Tesla/Energy.hs --- a/src/Tesla/Energy.hs +++ b/src/Tesla/Energy.hs @@ -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) diff --git a/tesla.cabal b/tesla.cabal --- a/tesla.cabal +++ b/tesla.cabal @@ -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 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