{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Tesla.Car.Command.Valet (
  setValetMode, clearValetPIN
  ) where

import           Control.Monad.IO.Class (MonadIO (..))
import           Network.Wreq           (FormParam (..))

import           Tesla.Car.Command

setValetMode :: MonadIO m => Bool -> Int -> Car m CommandResponse
setValetMode :: Bool -> Int -> Car m CommandResponse
setValetMode Bool
on Int
pin = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"set_valet_mode" [ ByteString
"on" ByteString -> Bool -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Bool
on, ByteString
"password" ByteString -> Int -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Int
pin]

mkCommand "clearValetPIN" "reset_valet_pin"