-- | Client library for the Home Assistant API.
module HomeAssistant.Client (
    API,
    HA,
    JSONOptions,
    StateChange,
    status,
    config,
    services,
    callService,
    mkHomeAssistantEnv,
    module Servant.Client
) where

--------------------------------------------------------------------------------

import Data.Aeson
import Data.Data
import Data.Text
import Data.ByteString.Char8 qualified as C8

import Deriving.Aeson

import Network.HTTP.Client (Manager, requestHeaders)
import Network.HTTP.Types

import Servant.API
import Servant.Client

import HomeAssistant.Types

--------------------------------------------------------------------------------

-- | The Home Assistant API as a type.
type API = "api" :> Endpoints
type Endpoints
    = Get '[JSON] Value
 :<|> "config" :>
      Get '[JSON] Config
 :<|> "services" :>
      Get '[JSON] [ServiceDomain]
 :<|> "services" :>
      Capture "domain" Text :>
      Capture "service" Text :>
      ReqBody '[JSON] (Maybe Value) :>
      Post '[JSON] Value

api :: Proxy API
api :: Proxy API
api = Proxy API
forall {k} (t :: k). Proxy t
Proxy

type HA = ClientM

--------------------------------------------------------------------------------

status :: HA Value
config :: HA Config
services :: HA [ServiceDomain]

--------------------------------------------------------------------------------

-- | Represents information about the state of an entity.
data StateChange = MkStateChange {
  StateChange -> Value
stateChangeAttributes :: Value,
  StateChange -> Text
stateChangeEntityID :: Text,
  StateChange -> Text
stateChangeLastChanged :: Text,
  StateChange -> Text
stateChangeState :: Text
} deriving ((forall x. StateChange -> Rep StateChange x)
-> (forall x. Rep StateChange x -> StateChange)
-> Generic StateChange
forall x. Rep StateChange x -> StateChange
forall x. StateChange -> Rep StateChange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StateChange -> Rep StateChange x
from :: forall x. StateChange -> Rep StateChange x
$cto :: forall x. Rep StateChange x -> StateChange
to :: forall x. Rep StateChange x -> StateChange
Generic, StateChange -> StateChange -> Bool
(StateChange -> StateChange -> Bool)
-> (StateChange -> StateChange -> Bool) -> Eq StateChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateChange -> StateChange -> Bool
== :: StateChange -> StateChange -> Bool
$c/= :: StateChange -> StateChange -> Bool
/= :: StateChange -> StateChange -> Bool
Eq, Int -> StateChange -> ShowS
[StateChange] -> ShowS
StateChange -> String
(Int -> StateChange -> ShowS)
-> (StateChange -> String)
-> ([StateChange] -> ShowS)
-> Show StateChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateChange -> ShowS
showsPrec :: Int -> StateChange -> ShowS
$cshow :: StateChange -> String
show :: StateChange -> String
$cshowList :: [StateChange] -> ShowS
showList :: [StateChange] -> ShowS
Show)
  deriving (Maybe StateChange
Value -> Parser [StateChange]
Value -> Parser StateChange
(Value -> Parser StateChange)
-> (Value -> Parser [StateChange])
-> Maybe StateChange
-> FromJSON StateChange
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser StateChange
parseJSON :: Value -> Parser StateChange
$cparseJSONList :: Value -> Parser [StateChange]
parseJSONList :: Value -> Parser [StateChange]
$comittedField :: Maybe StateChange
omittedField :: Maybe StateChange
FromJSON, [StateChange] -> Value
[StateChange] -> Encoding
StateChange -> Bool
StateChange -> Value
StateChange -> Encoding
(StateChange -> Value)
-> (StateChange -> Encoding)
-> ([StateChange] -> Value)
-> ([StateChange] -> Encoding)
-> (StateChange -> Bool)
-> ToJSON StateChange
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: StateChange -> Value
toJSON :: StateChange -> Value
$ctoEncoding :: StateChange -> Encoding
toEncoding :: StateChange -> Encoding
$ctoJSONList :: [StateChange] -> Value
toJSONList :: [StateChange] -> Value
$ctoEncodingList :: [StateChange] -> Encoding
toEncodingList :: [StateChange] -> Encoding
$comitField :: StateChange -> Bool
omitField :: StateChange -> Bool
ToJSON) via CustomJSON (JSONOptions "stateChange") StateChange

-- | 'callService' @domain service body@ calls @service@ in @domain@ with an
-- optional @body@. The result depends on the service.
callService :: Text -> Text -> Maybe Value -> HA Value

--------------------------------------------------------------------------------

HA Value
status
  :<|> HA Config
config
  :<|> HA [ServiceDomain]
services
  :<|> Text -> Text -> Maybe Value -> HA Value
callService = Proxy API -> Client ClientM API
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy API
api

--------------------------------------------------------------------------------

authorize :: C8.ByteString -> ClientEnv -> ClientEnv
authorize :: ByteString -> ClientEnv -> ClientEnv
authorize ByteString
token ClientEnv
env = ClientEnv
env{ makeClientRequest = mkRequest } where
    mkRequest :: BaseUrl -> Request -> IO Request
mkRequest BaseUrl
url Request
req = do
        -- Construct the request using the default function.
        Request
baseReq <- BaseUrl -> Request -> IO Request
forall (f :: * -> *).
Applicative f =>
BaseUrl -> Request -> f Request
defaultMakeClientRequest BaseUrl
url Request
req
        -- Then inject the Authorization header with the HA token.
        Request -> IO Request
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
baseReq{
            requestHeaders =
                (hAuthorization, "Bearer " <> token) : requestHeaders baseReq
        }

mkHomeAssistantEnv :: C8.ByteString -> Manager -> BaseUrl -> ClientEnv
mkHomeAssistantEnv :: ByteString -> Manager -> BaseUrl -> ClientEnv
mkHomeAssistantEnv ByteString
token Manager
httpManager BaseUrl
address =
    ByteString -> ClientEnv -> ClientEnv
authorize ByteString
token (ClientEnv -> ClientEnv) -> ClientEnv -> ClientEnv
forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
httpManager BaseUrl
address

--------------------------------------------------------------------------------