module Honeycomb.API.Auth (module Honeycomb.API.Auth.Types, getAuth) where

import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader.Class (asks)
import Data.Aeson (eitherDecode)
import qualified Data.Text as T
import Honeycomb
  ( HasHoneycombClient (honeycombClientL),
    MonadHoneycomb,
  )
import Honeycomb.API.Auth.Types
import Honeycomb.Client.Internal (MonadHoneycombConfig, get)
import Lens.Micro.Extras (view)
import Network.HTTP.Client (Response (responseBody))
import Network.HTTP.Simple (getResponseBody, getResponseStatusCode, httpLBS)

getAuth :: (MonadIO m, MonadHoneycombConfig client m) => m Auth
getAuth :: forall (m :: * -> *) client.
(MonadIO m, MonadHoneycombConfig client m) =>
m Auth
getAuth = do
  Response ByteString
r <- forall (m :: * -> *) env b.
(MonadIO m, MonadHoneycombConfig env m, HasConfig env) =>
(Request -> m (Response b))
-> [Text] -> RequestHeaders -> m (Response b)
get forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS [Text
"1", Text
"auth"] []
  case forall a. Response a -> Int
getResponseStatusCode Response ByteString
r of
    Int
200 -> case forall a. FromJSON a => ByteString -> Either String a
eitherDecode (forall body. Response body -> body
responseBody Response ByteString
r) of
      Right Auth
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Auth
r
      Left String
r -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FailureResponse
JsonDecodeFailed forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
r
    Int
other -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> FailureResponse
FailureCode Int
other (forall body. Response body -> body
getResponseBody Response ByteString
r)