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
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
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
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
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
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
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
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"