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 :: (AsanaAccessKey -> f AsanaAccessKey)
-> AsanaAccessKey -> f 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: { ... } }@
newtype Single a = Single
  { 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
/= :: Single a -> Single a -> Bool
$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
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
showList :: [Single a] -> ShowS
$cshowList :: forall a. Show a => [Single a] -> ShowS
show :: Single a -> String
$cshow :: forall a. Show a => Single a -> String
showsPrec :: Int -> Single a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
$cto :: forall a x. Rep (Single a) x -> Single a
$cfrom :: forall a x. Single a -> Rep (Single a) x
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: [{ ... }] }@
data Page a = Page
  { Page a -> [a]
pData :: [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
/= :: Page a -> Page a -> Bool
$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
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
$cto :: forall a x. Rep (Page a) x -> Page a
$cfrom :: forall a x. Page a -> Rep (Page a) x
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
showList :: [Page a] -> ShowS
$cshowList :: forall a. Show a => [Page a] -> ShowS
show :: Page a -> String
$cshow :: forall a. Show a => Page a -> String
showsPrec :: Int -> Page a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
/= :: NextPage -> NextPage -> Bool
$c/= :: NextPage -> NextPage -> Bool
== :: NextPage -> NextPage -> Bool
$c== :: 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
$cto :: forall x. Rep NextPage x -> NextPage
$cfrom :: forall x. NextPage -> Rep NextPage x
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
showList :: [NextPage] -> ShowS
$cshowList :: [NextPage] -> ShowS
show :: NextPage -> String
$cshow :: NextPage -> String
showsPrec :: Int -> NextPage -> ShowS
$cshowsPrec :: Int -> 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> }@
newtype ApiData a = ApiData
  { 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
showList :: [ApiData a] -> ShowS
$cshowList :: forall a. Show a => [ApiData a] -> ShowS
show :: ApiData a -> String
$cshow :: forall a. Show a => ApiData a -> String
showsPrec :: Int -> ApiData a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
/= :: ApiData a -> ApiData a -> Bool
$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
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
$cto :: forall a x. Rep (ApiData a) x -> ApiData a
$cfrom :: forall a x. ApiData a -> Rep (ApiData a) x
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 :: 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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure [a]
d) (([a] -> [a]) -> m [a] -> m [a]
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 :: 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 :: 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
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 (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 :: 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 :: 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 :: 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
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
$ Response Value -> Value
forall a. Response a -> a
getResponseBody @Value Response Value
response)
    ]

  Value -> m Value
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 :: 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 :: 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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Response a
response

getResponseDelay :: Response a -> Int
getResponseDelay :: 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"