module Asana.Api.Request
  ( AsanaAccessKey (..),
    HasAsanaAccessKey (..),
    Single (..),
    Page (..),
    NextPage (..),
    ApiData (..),
    getAll,
    getAllParams,
    getSingle,
    put,
    post,
    maxRequests,
  )
where

import Asana.Api.Prelude
import Data.Aeson
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import Network.HTTP.Simple
  ( JSONException (JSONConversionException, JSONParseException),
    Request,
    Response,
    addRequestHeader,
    getResponseBody,
    getResponseHeader,
    getResponseStatusCode,
    httpJSON,
    parseRequest_,
    setRequestBodyJSON,
    setRequestMethod,
  )
import UnliftIO.Concurrent (threadDelay)

newtype AsanaAccessKey = AsanaAccessKey
  { AsanaAccessKey -> Text
unAsanaAccessKey :: Text
  }

class HasAsanaAccessKey env where
  asanaAccessKeyL :: Lens' env AsanaAccessKey

instance HasAsanaAccessKey AsanaAccessKey where
  asanaAccessKeyL :: Lens' AsanaAccessKey AsanaAccessKey
asanaAccessKeyL = (AsanaAccessKey -> f AsanaAccessKey)
-> AsanaAccessKey -> f AsanaAccessKey
forall a. a -> a
id

maxRequests :: Int
maxRequests :: Int
maxRequests = Int
50

-- | Type for a single-resource response, containing @{ data: { ... } }@
type role Single representational
newtype Single a = Single
  { forall a. Single a -> a
sData :: a
  }
  deriving newtype (Single a -> Single a -> Bool
(Single a -> Single a -> Bool)
-> (Single a -> Single a -> Bool) -> Eq (Single a)
forall a. Eq a => Single a -> Single a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Single a -> Single a -> Bool
== :: Single a -> Single a -> Bool
$c/= :: forall a. Eq a => Single a -> Single a -> Bool
/= :: Single a -> Single a -> Bool
Eq, Int -> Single a -> ShowS
[Single a] -> ShowS
Single a -> String
(Int -> Single a -> ShowS)
-> (Single a -> String) -> ([Single a] -> ShowS) -> Show (Single a)
forall a. Show a => Int -> Single a -> ShowS
forall a. Show a => [Single a] -> ShowS
forall a. Show a => Single a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Single a -> ShowS
showsPrec :: Int -> Single a -> ShowS
$cshow :: forall a. Show a => Single a -> String
show :: Single a -> String
$cshowList :: forall a. Show a => [Single a] -> ShowS
showList :: [Single a] -> ShowS
Show)
  deriving stock ((forall x. Single a -> Rep (Single a) x)
-> (forall x. Rep (Single a) x -> Single a) -> Generic (Single a)
forall x. Rep (Single a) x -> Single a
forall x. Single a -> Rep (Single a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Single a) x -> Single a
forall a x. Single a -> Rep (Single a) x
$cfrom :: forall a x. Single a -> Rep (Single a) x
from :: forall x. Single a -> Rep (Single a) x
$cto :: forall a x. Rep (Single a) x -> Single a
to :: forall x. Rep (Single a) x -> Single a
Generic)

instance (FromJSON a) => FromJSON (Single a) where
  parseJSON :: Value -> Parser (Single a)
parseJSON = Options -> Value -> Parser (Single a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser (Single a))
-> Options -> Value -> Parser (Single a)
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

-- | Type for a list-resource response, containing @{ data: [{ ... }] }@
type role Page representational
data Page a = Page
  { forall a. Page a -> [a]
pData :: [a],
    forall a. Page a -> Maybe NextPage
pNextPage :: Maybe NextPage
  }
  deriving stock (Page a -> Page a -> Bool
(Page a -> Page a -> Bool)
-> (Page a -> Page a -> Bool) -> Eq (Page a)
forall a. Eq a => Page a -> Page a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Page a -> Page a -> Bool
== :: Page a -> Page a -> Bool
$c/= :: forall a. Eq a => Page a -> Page a -> Bool
/= :: Page a -> Page a -> Bool
Eq, (forall x. Page a -> Rep (Page a) x)
-> (forall x. Rep (Page a) x -> Page a) -> Generic (Page a)
forall x. Rep (Page a) x -> Page a
forall x. Page a -> Rep (Page a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Page a) x -> Page a
forall a x. Page a -> Rep (Page a) x
$cfrom :: forall a x. Page a -> Rep (Page a) x
from :: forall x. Page a -> Rep (Page a) x
$cto :: forall a x. Rep (Page a) x -> Page a
to :: forall x. Rep (Page a) x -> Page a
Generic, Int -> Page a -> ShowS
[Page a] -> ShowS
Page a -> String
(Int -> Page a -> ShowS)
-> (Page a -> String) -> ([Page a] -> ShowS) -> Show (Page a)
forall a. Show a => Int -> Page a -> ShowS
forall a. Show a => [Page a] -> ShowS
forall a. Show a => Page a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Page a -> ShowS
showsPrec :: Int -> Page a -> ShowS
$cshow :: forall a. Show a => Page a -> String
show :: Page a -> String
$cshowList :: forall a. Show a => [Page a] -> ShowS
showList :: [Page a] -> ShowS
Show)

instance (FromJSON a) => FromJSON (Page a) where
  parseJSON :: Value -> Parser (Page a)
parseJSON = Options -> Value -> Parser (Page a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser (Page a))
-> Options -> Value -> Parser (Page a)
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

-- | The @next_page@ element of a paginated response
data NextPage = NextPage
  { NextPage -> Text
npOffset :: Text,
    NextPage -> Text
npPath :: Text,
    NextPage -> Text
npUri :: Text
  }
  deriving stock (NextPage -> NextPage -> Bool
(NextPage -> NextPage -> Bool)
-> (NextPage -> NextPage -> Bool) -> Eq NextPage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NextPage -> NextPage -> Bool
== :: NextPage -> NextPage -> Bool
$c/= :: NextPage -> NextPage -> Bool
/= :: NextPage -> NextPage -> Bool
Eq, (forall x. NextPage -> Rep NextPage x)
-> (forall x. Rep NextPage x -> NextPage) -> Generic NextPage
forall x. Rep NextPage x -> NextPage
forall x. NextPage -> Rep NextPage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NextPage -> Rep NextPage x
from :: forall x. NextPage -> Rep NextPage x
$cto :: forall x. Rep NextPage x -> NextPage
to :: forall x. Rep NextPage x -> NextPage
Generic, Int -> NextPage -> ShowS
[NextPage] -> ShowS
NextPage -> String
(Int -> NextPage -> ShowS)
-> (NextPage -> String) -> ([NextPage] -> ShowS) -> Show NextPage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NextPage -> ShowS
showsPrec :: Int -> NextPage -> ShowS
$cshow :: NextPage -> String
show :: NextPage -> String
$cshowList :: [NextPage] -> ShowS
showList :: [NextPage] -> ShowS
Show)

instance FromJSON NextPage where
  parseJSON :: Value -> Parser NextPage
parseJSON = Options -> Value -> Parser NextPage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser NextPage)
-> Options -> Value -> Parser NextPage
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

-- | Generic type for un/wrapping an item as @{ data: <item> }@
type role ApiData representational
newtype ApiData a = ApiData
  { forall a. ApiData a -> a
adData :: a
  }
  deriving newtype (Int -> ApiData a -> ShowS
[ApiData a] -> ShowS
ApiData a -> String
(Int -> ApiData a -> ShowS)
-> (ApiData a -> String)
-> ([ApiData a] -> ShowS)
-> Show (ApiData a)
forall a. Show a => Int -> ApiData a -> ShowS
forall a. Show a => [ApiData a] -> ShowS
forall a. Show a => ApiData a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ApiData a -> ShowS
showsPrec :: Int -> ApiData a -> ShowS
$cshow :: forall a. Show a => ApiData a -> String
show :: ApiData a -> String
$cshowList :: forall a. Show a => [ApiData a] -> ShowS
showList :: [ApiData a] -> ShowS
Show, ApiData a -> ApiData a -> Bool
(ApiData a -> ApiData a -> Bool)
-> (ApiData a -> ApiData a -> Bool) -> Eq (ApiData a)
forall a. Eq a => ApiData a -> ApiData a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ApiData a -> ApiData a -> Bool
== :: ApiData a -> ApiData a -> Bool
$c/= :: forall a. Eq a => ApiData a -> ApiData a -> Bool
/= :: ApiData a -> ApiData a -> Bool
Eq)
  deriving stock ((forall x. ApiData a -> Rep (ApiData a) x)
-> (forall x. Rep (ApiData a) x -> ApiData a)
-> Generic (ApiData a)
forall x. Rep (ApiData a) x -> ApiData a
forall x. ApiData a -> Rep (ApiData a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ApiData a) x -> ApiData a
forall a x. ApiData a -> Rep (ApiData a) x
$cfrom :: forall a x. ApiData a -> Rep (ApiData a) x
from :: forall x. ApiData a -> Rep (ApiData a) x
$cto :: forall a x. Rep (ApiData a) x -> ApiData a
to :: forall x. Rep (ApiData a) x -> ApiData a
Generic)

instance (FromJSON a) => FromJSON (ApiData a) where
  parseJSON :: Value -> Parser (ApiData a)
parseJSON = Options -> Value -> Parser (ApiData a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser (ApiData a))
-> Options -> Value -> Parser (ApiData a)
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

instance (ToJSON a) => ToJSON (ApiData a) where
  toJSON :: ApiData a -> Value
toJSON = Options -> ApiData a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ApiData a -> Value) -> Options -> ApiData a -> Value
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase
  toEncoding :: ApiData a -> Encoding
toEncoding = Options -> ApiData a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> ApiData a -> Encoding)
-> Options -> ApiData a -> Encoding
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

-- | Naively GET all pages of a paginated resource
getAll ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    FromJSON a
  ) =>
  String ->
  m [a]
getAll :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> m [a]
getAll String
path = String -> [(String, String)] -> m [a]
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> [(String, String)] -> m [a]
getAllParams String
path []

getAllParams ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    FromJSON a
  ) =>
  String ->
  [(String, String)] ->
  m [a]
getAllParams :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> [(String, String)] -> m [a]
getAllParams String
path [(String, String)]
params = Maybe String -> m [a]
go Maybe String
forall a. Maybe a
Nothing
  where
    go :: Maybe String -> m [a]
go Maybe String
mOffset = do
      Page [a]
d Maybe NextPage
mNextPage <- String -> [(String, String)] -> Int -> Maybe String -> m (Page a)
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> [(String, String)] -> Int -> Maybe String -> m a
get String
path [(String, String)]
params Int
50 Maybe String
mOffset

      m [a] -> (NextPage -> m [a]) -> Maybe NextPage -> m [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
d) (([a] -> [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
d [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) (m [a] -> m [a]) -> (NextPage -> m [a]) -> NextPage -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> m [a]
go (Maybe String -> m [a])
-> (NextPage -> Maybe String) -> NextPage -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (NextPage -> String) -> NextPage -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (NextPage -> Text) -> NextPage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NextPage -> Text
npOffset) Maybe NextPage
mNextPage

-- | Get a single resource
getSingle ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    FromJSON a
  ) =>
  String ->
  m a
getSingle :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> m a
getSingle String
path = Single a -> a
forall a. Single a -> a
sData (Single a -> a) -> m (Single a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, String)] -> Int -> Maybe String -> m (Single a)
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> [(String, String)] -> Int -> Maybe String -> m a
get String
path [] Int
1 Maybe String
forall a. Maybe a
Nothing

get ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    FromJSON a
  ) =>
  String ->
  [(String, String)] ->
  Int ->
  Maybe String ->
  m a
get :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, FromJSON a) =>
String -> [(String, String)] -> Int -> Maybe String -> m a
get String
path [(String, String)]
params Int
limit Maybe String
mOffset = do
  AsanaAccessKey Text
key <- Getting AsanaAccessKey env AsanaAccessKey -> m AsanaAccessKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AsanaAccessKey env AsanaAccessKey
forall env. HasAsanaAccessKey env => Lens' env AsanaAccessKey
Lens' env AsanaAccessKey
asanaAccessKeyL
  let request :: Request
request =
        String -> Request
parseRequest_ (String -> Request) -> String -> Request
forall a b. (a -> b) -> a -> b
$
          String
"https://app.asana.com/api/1.0"
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"?limit="
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
limit -- Ignored on not paging responses
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"&offset=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) Maybe String
mOffset
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(String
k, String
v) -> String
"&" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
v) [(String, String)]
params
  Response a
response <- Int -> m (Response a) -> m (Response a)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Int -> m (Response a) -> m (Response a)
retry Int
50 (m (Response a) -> m (Response a))
-> m (Response a) -> m (Response a)
forall a b. (a -> b) -> a -> b
$ Request -> m (Response a)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON (Text -> Request -> Request
addAuthorization Text
key Request
request)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
300 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Response a -> Int
forall a. Response a -> Int
getResponseStatusCode Response a
response) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logWarnNS Text
"Asana" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"GET failed, status: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Response a -> Int
forall a. Response a -> Int
getResponseStatusCode Response a
response)
  a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Response a -> a
forall a. Response a -> a
getResponseBody Response a
response

put ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    ToJSON a
  ) =>
  String ->
  a ->
  m Value
put :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, ToJSON a) =>
String -> a -> m Value
put = ByteString -> String -> a -> m Value
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, ToJSON a) =>
ByteString -> String -> a -> m Value
httpAction ByteString
"PUT"

post ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    ToJSON a
  ) =>
  String ->
  a ->
  m Value
post :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, ToJSON a) =>
String -> a -> m Value
post = ByteString -> String -> a -> m Value
forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, ToJSON a) =>
ByteString -> String -> a -> m Value
httpAction ByteString
"POST"

httpAction ::
  ( MonadUnliftIO m,
    MonadLogger m,
    MonadReader env m,
    HasAsanaAccessKey env,
    ToJSON a
  ) =>
  ByteString ->
  String ->
  a ->
  m Value
httpAction :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
 HasAsanaAccessKey env, ToJSON a) =>
ByteString -> String -> a -> m Value
httpAction ByteString
verb String
path a
payload = do
  AsanaAccessKey Text
key <- Getting AsanaAccessKey env AsanaAccessKey -> m AsanaAccessKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AsanaAccessKey env AsanaAccessKey
forall env. HasAsanaAccessKey env => Lens' env AsanaAccessKey
Lens' env AsanaAccessKey
asanaAccessKeyL
  let request :: Request
request = String -> Request
parseRequest_ (String -> Request) -> String -> Request
forall a b. (a -> b) -> a -> b
$ String
"https://app.asana.com/api/1.0" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path

  Response Value
response <-
    Int -> m (Response Value) -> m (Response Value)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Int -> m (Response a) -> m (Response a)
retry Int
10 (m (Response Value) -> m (Response Value))
-> m (Response Value) -> m (Response Value)
forall a b. (a -> b) -> a -> b
$
      Request -> m (Response Value)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON
        ( ByteString -> Request -> Request
setRequestMethod ByteString
verb (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON a
payload (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
            Text -> Request -> Request
addAuthorization
              Text
key
              Request
request
        )
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
300 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Response Value -> Int
forall a. Response a -> Int
getResponseStatusCode Response Value
response) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logWarnNS Text
"Asana" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Request failed",
          Text
"\n  method: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 ByteString
verb,
          Text
"\n  status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Response Value -> Int
forall a. Response a -> Int
getResponseStatusCode Response Value
response),
          Text
"\n  body  : "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8
              (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ forall a. Response a -> a
getResponseBody @Value Response Value
response)
        ]

  Value -> m Value
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Response Value -> Value
forall a. Response a -> a
getResponseBody Response Value
response

addAuthorization :: Text -> Request -> Request
addAuthorization :: Text -> Request -> Request
addAuthorization Text
key =
  HeaderName -> ByteString -> Request -> Request
addRequestHeader HeaderName
"Authorization" (ByteString -> Request -> Request)
-> ByteString -> Request -> Request
forall a b. (a -> b) -> a -> b
$ ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 Text
key

retry ::
  forall a m.
  (MonadUnliftIO m, MonadLogger m) =>
  Int ->
  m (Response a) ->
  m (Response a)
retry :: forall a (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Int -> m (Response a) -> m (Response a)
retry Int
attempt m (Response a)
go
  | Int
attempt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = m (Response a)
go
  | Bool
otherwise = Response a -> m (Response a)
handler (Response a -> m (Response a)) -> m (Response a) -> m (Response a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Response a)
go m (Response a)
-> (JSONException -> m (Response a)) -> m (Response a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` JSONException -> m (Response a)
handleParseError
  where
    handleParseError :: JSONException -> m (Response a)
    handleParseError :: JSONException -> m (Response a)
handleParseError JSONException
e = case JSONException
e of
      JSONParseException Request
_ Response ()
rsp ParseError
_ -> JSONException -> Response () -> m (Response a)
forall e b. Exception e => e -> Response b -> m (Response a)
orThrow JSONException
e Response ()
rsp
      JSONConversionException Request
_ Response Value
rsp String
_ -> JSONException -> Response Value -> m (Response a)
forall e b. Exception e => e -> Response b -> m (Response a)
orThrow JSONException
e Response Value
rsp

    orThrow :: (Exception e) => e -> Response b -> m (Response a)
    orThrow :: forall e b. Exception e => e -> Response b -> m (Response a)
orThrow e
e Response b
response
      | Response b -> Int
forall a. Response a -> Int
getResponseStatusCode Response b
response Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
429 = do
          let seconds :: Int
seconds = Response b -> Int
forall a. Response a -> Int
getResponseDelay Response b
response
          Text -> Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logWarnNS Text
"Asana" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Retrying after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
seconds) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" seconds"
          Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
          Int -> m (Response a) -> m (Response a)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Int -> m (Response a) -> m (Response a)
retry (Int -> Int
forall a. Enum a => a -> a
pred Int
attempt) m (Response a)
go
      | Bool
otherwise = IO (Response a) -> m (Response a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response a) -> m (Response a))
-> IO (Response a) -> m (Response a)
forall a b. (a -> b) -> a -> b
$ e -> IO (Response a)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO e
e

    handler :: Response a -> m (Response a)
    handler :: Response a -> m (Response a)
handler Response a
response
      | Response a -> Int
forall a. Response a -> Int
getResponseStatusCode Response a
response Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
429 = do
          let seconds :: Int
seconds = Response a -> Int
forall a. Response a -> Int
getResponseDelay Response a
response
          Text -> Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logWarnNS Text
"Asana" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Retrying after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
seconds) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" seconds"
          Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100000
          Int -> m (Response a) -> m (Response a)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Int -> m (Response a) -> m (Response a)
retry (Int -> Int
forall a. Enum a => a -> a
pred Int
attempt) m (Response a)
go
      | Bool
otherwise = Response a -> m (Response a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response a
response

getResponseDelay :: Response a -> Int
getResponseDelay :: forall a. Response a -> Int
getResponseDelay =
  Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0
    (Maybe Int -> Int)
-> (Response a -> Maybe Int) -> Response a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe
    (String -> Maybe Int)
-> (Response a -> String) -> Response a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    (Text -> String) -> (Response a -> Text) -> Response a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode
    (ByteString -> Text)
-> (Response a -> ByteString) -> Response a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
    ([ByteString] -> ByteString)
-> (Response a -> [ByteString]) -> Response a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> Response a -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Retry-After"