{-
   Vikunja API

   # Pagination Every endpoint capable of pagination will return two headers: * `x-pagination-total-pages`: The total number of available pages for this request * `x-pagination-result-count`: The number of items returned for this request. # Rights All endpoints which return a single item (project, task, etc.) - no array - will also return a `x-max-right` header with the max right the user has on this item as an int where `0` is `Read Only`, `1` is `Read & Write` and `2` is `Admin`. This can be used to show or hide ui elements based on the rights the user has. # Errors All errors have an error code and a human-readable error message in addition to the http status code. You should always check for the status code in the response, not only the http status code. Due to limitations in the swagger library we're using for this document, only one error per http status code is documented here. Make sure to check the [error docs](https://vikunja.io/docs/errors/) in Vikunja's documentation for a full list of available error codes. # Authorization **JWT-Auth:** Main authorization method, used for most of the requests. Needs `Authorization: Bearer <jwt-token>`-header to authenticate successfully.  **API Token:** You can create scoped API tokens for your user and use the token to make authenticated requests in the context of that user. The token must be provided via an `Authorization: Bearer <token>` header, similar to jwt auth. See the documentation for the `api` group to manage token creation and revocation.  **BasicAuth:** Only used when requesting tasks via CalDAV. <!-- ReDoc-Inject: <security-definitions> -->

   OpenAPI Version: 3.0.1
   Vikunja API API version: 0.24.6
   Contact: hello@vikunja.io
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Vikunja.Client
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

module Vikunja.Client where

import Vikunja.Core
import Vikunja.Logging
import Vikunja.MimeTypes

import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Control.Monad as P
import qualified Data.Aeson.Types as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Client as NH
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Types as NH
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import GHC.Exts (IsString(..))

-- * Dispatch

-- ** Lbs

-- | send a request returning the raw http response
dispatchLbs
  :: (Produces req accept, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> VikunjaConfig -- ^ config
  -> VikunjaRequest req contentType res accept -- ^ request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchLbs :: Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager VikunjaConfig
config VikunjaRequest req contentType res accept
request  = do
  InitRequest req contentType res accept
initReq <- VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest VikunjaConfig
config VikunjaRequest req contentType res accept
request
  Manager
-> VikunjaConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
forall req contentType res accept.
Manager
-> VikunjaConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager VikunjaConfig
config InitRequest req contentType res accept
initReq

-- ** Mime

-- | pair of decoded http body and http response
data MimeResult res =
  MimeResult { MimeResult res -> Either MimeError res
mimeResult :: Either MimeError res -- ^ decoded http body
             , MimeResult res -> Response ByteString
mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response
             }
  deriving (Int -> MimeResult res -> ShowS
[MimeResult res] -> ShowS
MimeResult res -> String
(Int -> MimeResult res -> ShowS)
-> (MimeResult res -> String)
-> ([MimeResult res] -> ShowS)
-> Show (MimeResult res)
forall res. Show res => Int -> MimeResult res -> ShowS
forall res. Show res => [MimeResult res] -> ShowS
forall res. Show res => MimeResult res -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MimeResult res] -> ShowS
$cshowList :: forall res. Show res => [MimeResult res] -> ShowS
show :: MimeResult res -> String
$cshow :: forall res. Show res => MimeResult res -> String
showsPrec :: Int -> MimeResult res -> ShowS
$cshowsPrec :: forall res. Show res => Int -> MimeResult res -> ShowS
Show, a -> MimeResult b -> MimeResult a
(a -> b) -> MimeResult a -> MimeResult b
(forall a b. (a -> b) -> MimeResult a -> MimeResult b)
-> (forall a b. a -> MimeResult b -> MimeResult a)
-> Functor MimeResult
forall a b. a -> MimeResult b -> MimeResult a
forall a b. (a -> b) -> MimeResult a -> MimeResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MimeResult b -> MimeResult a
$c<$ :: forall a b. a -> MimeResult b -> MimeResult a
fmap :: (a -> b) -> MimeResult a -> MimeResult b
$cfmap :: forall a b. (a -> b) -> MimeResult a -> MimeResult b
Functor, MimeResult a -> Bool
(a -> m) -> MimeResult a -> m
(a -> b -> b) -> b -> MimeResult a -> b
(forall m. Monoid m => MimeResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> MimeResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> MimeResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> MimeResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> MimeResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> MimeResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> MimeResult a -> b)
-> (forall a. (a -> a -> a) -> MimeResult a -> a)
-> (forall a. (a -> a -> a) -> MimeResult a -> a)
-> (forall a. MimeResult a -> [a])
-> (forall a. MimeResult a -> Bool)
-> (forall a. MimeResult a -> Int)
-> (forall a. Eq a => a -> MimeResult a -> Bool)
-> (forall a. Ord a => MimeResult a -> a)
-> (forall a. Ord a => MimeResult a -> a)
-> (forall a. Num a => MimeResult a -> a)
-> (forall a. Num a => MimeResult a -> a)
-> Foldable MimeResult
forall a. Eq a => a -> MimeResult a -> Bool
forall a. Num a => MimeResult a -> a
forall a. Ord a => MimeResult a -> a
forall m. Monoid m => MimeResult m -> m
forall a. MimeResult a -> Bool
forall a. MimeResult a -> Int
forall a. MimeResult a -> [a]
forall a. (a -> a -> a) -> MimeResult a -> a
forall m a. Monoid m => (a -> m) -> MimeResult a -> m
forall b a. (b -> a -> b) -> b -> MimeResult a -> b
forall a b. (a -> b -> b) -> b -> MimeResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: MimeResult a -> a
$cproduct :: forall a. Num a => MimeResult a -> a
sum :: MimeResult a -> a
$csum :: forall a. Num a => MimeResult a -> a
minimum :: MimeResult a -> a
$cminimum :: forall a. Ord a => MimeResult a -> a
maximum :: MimeResult a -> a
$cmaximum :: forall a. Ord a => MimeResult a -> a
elem :: a -> MimeResult a -> Bool
$celem :: forall a. Eq a => a -> MimeResult a -> Bool
length :: MimeResult a -> Int
$clength :: forall a. MimeResult a -> Int
null :: MimeResult a -> Bool
$cnull :: forall a. MimeResult a -> Bool
toList :: MimeResult a -> [a]
$ctoList :: forall a. MimeResult a -> [a]
foldl1 :: (a -> a -> a) -> MimeResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldr1 :: (a -> a -> a) -> MimeResult a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MimeResult a -> a
foldl' :: (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldl :: (b -> a -> b) -> b -> MimeResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MimeResult a -> b
foldr' :: (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldr :: (a -> b -> b) -> b -> MimeResult a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MimeResult a -> b
foldMap' :: (a -> m) -> MimeResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
foldMap :: (a -> m) -> MimeResult a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MimeResult a -> m
fold :: MimeResult m -> m
$cfold :: forall m. Monoid m => MimeResult m -> m
Foldable, Functor MimeResult
Foldable MimeResult
Functor MimeResult
-> Foldable MimeResult
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MimeResult a -> f (MimeResult b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MimeResult (f a) -> f (MimeResult a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MimeResult a -> m (MimeResult b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MimeResult (m a) -> m (MimeResult a))
-> Traversable MimeResult
(a -> f b) -> MimeResult a -> f (MimeResult b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
sequence :: MimeResult (m a) -> m (MimeResult a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MimeResult (m a) -> m (MimeResult a)
mapM :: (a -> m b) -> MimeResult a -> m (MimeResult b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MimeResult a -> m (MimeResult b)
sequenceA :: MimeResult (f a) -> f (MimeResult a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MimeResult (f a) -> f (MimeResult a)
traverse :: (a -> f b) -> MimeResult a -> f (MimeResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MimeResult a -> f (MimeResult b)
$cp2Traversable :: Foldable MimeResult
$cp1Traversable :: Functor MimeResult
Traversable)

-- | pair of unrender/parser error and http response
data MimeError =
  MimeError {
    MimeError -> String
mimeError :: String -- ^ unrender/parser error
  , MimeError -> Response ByteString
mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response
  } deriving (Int -> MimeError -> ShowS
[MimeError] -> ShowS
MimeError -> String
(Int -> MimeError -> ShowS)
-> (MimeError -> String)
-> ([MimeError] -> ShowS)
-> Show MimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MimeError] -> ShowS
$cshowList :: [MimeError] -> ShowS
show :: MimeError -> String
$cshow :: MimeError -> String
showsPrec :: Int -> MimeError -> ShowS
$cshowsPrec :: Int -> MimeError -> ShowS
Show)

-- | send a request returning the 'MimeResult'
dispatchMime
  :: forall req contentType res accept. (Produces req accept, MimeUnrender accept res, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> VikunjaConfig -- ^ config
  -> VikunjaRequest req contentType res accept -- ^ request
  -> IO (MimeResult res) -- ^ response
dispatchMime :: Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager VikunjaConfig
config VikunjaRequest req contentType res accept
request = do
  Response ByteString
httpResponse <- Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (Response ByteString)
forall req accept contentType res.
(Produces req accept, MimeType contentType) =>
Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbs Manager
manager VikunjaConfig
config VikunjaRequest req contentType res accept
request
  let statusCode :: Int
statusCode = Status -> Int
NH.statusCode (Status -> Int)
-> (Response ByteString -> Status) -> Response ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Status
forall body. Response body -> Status
NH.responseStatus (Response ByteString -> Int) -> Response ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString
httpResponse
  Either MimeError res
parsedResult <-
    Text -> VikunjaConfig -> LogExec IO (Either MimeError res)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> VikunjaConfig -> LogExec m a
runConfigLogWithExceptions Text
"Client" VikunjaConfig
config LogExec IO (Either MimeError res)
-> LogExec IO (Either MimeError res)
forall a b. (a -> b) -> a -> b
$
    do if (Int
statusCode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 Bool -> Bool -> Bool
&& Int
statusCode Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
600)
         then do
           let s :: String
s = String
"error statusCode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
statusCode
           Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
           Either MimeError res -> KatipT IO (Either MimeError res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MimeError -> Either MimeError res
forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
         else case Proxy accept -> ByteString -> Either String res
forall mtype o.
MimeUnrender mtype o =>
Proxy mtype -> ByteString -> Either String o
mimeUnrender (Proxy accept
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy accept) (Response ByteString -> ByteString
forall body. Response body -> body
NH.responseBody Response ByteString
httpResponse) of
           Left String
s -> do
             Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
"Client" LogLevel
levelError (String -> Text
T.pack String
s)
             Either MimeError res -> KatipT IO (Either MimeError res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MimeError -> Either MimeError res
forall a b. a -> Either a b
Left (String -> Response ByteString -> MimeError
MimeError String
s Response ByteString
httpResponse))
           Right res
r -> Either MimeError res -> KatipT IO (Either MimeError res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (res -> Either MimeError res
forall a b. b -> Either a b
Right res
r)
  MimeResult res -> IO (MimeResult res)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MimeError res -> Response ByteString -> MimeResult res
forall res.
Either MimeError res -> Response ByteString -> MimeResult res
MimeResult Either MimeError res
parsedResult Response ByteString
httpResponse)

-- | like 'dispatchMime', but only returns the decoded http body
dispatchMime'
  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> VikunjaConfig -- ^ config
  -> VikunjaRequest req contentType res accept -- ^ request
  -> IO (Either MimeError res) -- ^ response
dispatchMime' :: Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (Either MimeError res)
dispatchMime' Manager
manager VikunjaConfig
config VikunjaRequest req contentType res accept
request  = do
    MimeResult Either MimeError res
parsedResult Response ByteString
_ <- Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (MimeResult res)
forall req contentType res accept.
(Produces req accept, MimeUnrender accept res,
 MimeType contentType) =>
Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (MimeResult res)
dispatchMime Manager
manager VikunjaConfig
config VikunjaRequest req contentType res accept
request
    Either MimeError res -> IO (Either MimeError res)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MimeError res
parsedResult

-- ** Unsafe

-- | like 'dispatchReqLbs', but does not validate the operation is a 'Producer' of the "accept" 'MimeType'.  (Useful if the server's response is undocumented)
dispatchLbsUnsafe
  :: (MimeType accept, MimeType contentType)
  => NH.Manager -- ^ http-client Connection manager
  -> VikunjaConfig -- ^ config
  -> VikunjaRequest req contentType res accept -- ^ request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchLbsUnsafe :: Manager
-> VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (Response ByteString)
dispatchLbsUnsafe Manager
manager VikunjaConfig
config VikunjaRequest req contentType res accept
request  = do
  InitRequest req contentType res accept
initReq <- VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
forall accept contentType req res.
(MimeType accept, MimeType contentType) =>
VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest VikunjaConfig
config VikunjaRequest req contentType res accept
request
  Manager
-> VikunjaConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
forall req contentType res accept.
Manager
-> VikunjaConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager VikunjaConfig
config InitRequest req contentType res accept
initReq

-- | dispatch an InitRequest
dispatchInitUnsafe
  :: NH.Manager -- ^ http-client Connection manager
  -> VikunjaConfig -- ^ config
  -> InitRequest req contentType res accept -- ^ init request
  -> IO (NH.Response BCL.ByteString) -- ^ response
dispatchInitUnsafe :: Manager
-> VikunjaConfig
-> InitRequest req contentType res accept
-> IO (Response ByteString)
dispatchInitUnsafe Manager
manager VikunjaConfig
config (InitRequest Request
req) = do
  Text -> VikunjaConfig -> LogExec IO (Response ByteString)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> VikunjaConfig -> LogExec m a
runConfigLogWithExceptions Text
src VikunjaConfig
config LogExec IO (Response ByteString)
-> LogExec IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$
    do Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo Text
requestLogMsg
       Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug Text
requestDbgLogMsg
       Response ByteString
res <- IO (Response ByteString) -> KatipT IO (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (Response ByteString) -> KatipT IO (Response ByteString))
-> IO (Response ByteString) -> KatipT IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
NH.httpLbs Request
req Manager
manager
       Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelInfo (Response ByteString -> Text
forall body. Response body -> Text
responseLogMsg Response ByteString
res)
       Text -> LogLevel -> Text -> KatipT IO ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> LogLevel -> Text -> m ()
_log Text
src LogLevel
levelDebug ((String -> Text
T.pack (String -> Text)
-> (Response ByteString -> String) -> Response ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> String
forall a. Show a => a -> String
show) Response ByteString
res)
       Response ByteString -> KatipT IO (Response ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Response ByteString
res
  where
    src :: Text
src = Text
"Client"
    endpoint :: Text
endpoint =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
      ByteString -> String
BC.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
      Request -> ByteString
NH.method Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.host Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.path Request
req ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
NH.queryString Request
req
    requestLogMsg :: Text
requestLogMsg = Text
"REQ:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint
    requestDbgLogMsg :: Text
requestDbgLogMsg =
      Text
"Headers=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text)
-> (RequestHeaders -> String) -> RequestHeaders -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> String
forall a. Show a => a -> String
show) (Request -> RequestHeaders
NH.requestHeaders Request
req) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Body=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
      (case Request -> RequestBody
NH.requestBody Request
req of
         NH.RequestBodyLBS ByteString
xs -> ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BL.toStrict ByteString
xs)
         RequestBody
_ -> Text
"<RequestBody>")
    responseStatusCode :: Response body -> Text
responseStatusCode = (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) (Int -> Text) -> (Response body -> Int) -> Response body -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
NH.statusCode (Status -> Int)
-> (Response body -> Status) -> Response body -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response body -> Status
forall body. Response body -> Status
NH.responseStatus
    responseLogMsg :: Response body -> Text
responseLogMsg Response body
res =
      Text
"RES:statusCode=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response body -> Text
forall body. Response body -> Text
responseStatusCode Response body
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- * InitRequest

-- | wraps an http-client 'Request' with request/response type parameters
newtype InitRequest req contentType res accept = InitRequest
  { InitRequest req contentType res accept -> Request
unInitRequest :: NH.Request
  } deriving (Int -> InitRequest req contentType res accept -> ShowS
[InitRequest req contentType res accept] -> ShowS
InitRequest req contentType res accept -> String
(Int -> InitRequest req contentType res accept -> ShowS)
-> (InitRequest req contentType res accept -> String)
-> ([InitRequest req contentType res accept] -> ShowS)
-> Show (InitRequest req contentType res accept)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall req contentType res accept.
Int -> InitRequest req contentType res accept -> ShowS
forall req contentType res accept.
[InitRequest req contentType res accept] -> ShowS
forall req contentType res accept.
InitRequest req contentType res accept -> String
showList :: [InitRequest req contentType res accept] -> ShowS
$cshowList :: forall req contentType res accept.
[InitRequest req contentType res accept] -> ShowS
show :: InitRequest req contentType res accept -> String
$cshow :: forall req contentType res accept.
InitRequest req contentType res accept -> String
showsPrec :: Int -> InitRequest req contentType res accept -> ShowS
$cshowsPrec :: forall req contentType res accept.
Int -> InitRequest req contentType res accept -> ShowS
Show)

-- |  Build an http-client 'Request' record from the supplied config and request
_toInitRequest
  :: (MimeType accept, MimeType contentType)
  => VikunjaConfig -- ^ config
  -> VikunjaRequest req contentType res accept -- ^ request
  -> IO (InitRequest req contentType res accept) -- ^ initialized request
_toInitRequest :: VikunjaConfig
-> VikunjaRequest req contentType res accept
-> IO (InitRequest req contentType res accept)
_toInitRequest VikunjaConfig
config VikunjaRequest req contentType res accept
req0  =
  Text
-> VikunjaConfig
-> LogExec IO (InitRequest req contentType res accept)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m) =>
Text -> VikunjaConfig -> LogExec m a
runConfigLogWithExceptions Text
"Client" VikunjaConfig
config LogExec IO (InitRequest req contentType res accept)
-> LogExec IO (InitRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$ do
    Request
parsedReq <- IO Request -> KatipT IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO Request -> KatipT IO Request)
-> IO Request -> KatipT IO Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
NH.parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BCL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
BCL.append (VikunjaConfig -> ByteString
configHost VikunjaConfig
config) ([ByteString] -> ByteString
BCL.concat (VikunjaRequest req contentType res accept -> [ByteString]
forall req contentType res accept.
VikunjaRequest req contentType res accept -> [ByteString]
rUrlPath VikunjaRequest req contentType res accept
req0))
    VikunjaRequest req contentType res accept
req1 <- IO (VikunjaRequest req contentType res accept)
-> KatipT IO (VikunjaRequest req contentType res accept)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
P.liftIO (IO (VikunjaRequest req contentType res accept)
 -> KatipT IO (VikunjaRequest req contentType res accept))
-> IO (VikunjaRequest req contentType res accept)
-> KatipT IO (VikunjaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$ VikunjaRequest req contentType res accept
-> VikunjaConfig -> IO (VikunjaRequest req contentType res accept)
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> VikunjaConfig -> IO (VikunjaRequest req contentType res accept)
_applyAuthMethods VikunjaRequest req contentType res accept
req0 VikunjaConfig
config
    Bool -> KatipT IO () -> KatipT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
P.when
        (VikunjaConfig -> Bool
configValidateAuthMethods VikunjaConfig
config Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool)
-> (VikunjaRequest req contentType res accept -> Bool)
-> VikunjaRequest req contentType res accept
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TypeRep] -> Bool)
-> (VikunjaRequest req contentType res accept -> [TypeRep])
-> VikunjaRequest req contentType res accept
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VikunjaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
VikunjaRequest req contentType res accept -> [TypeRep]
rAuthTypes) VikunjaRequest req contentType res accept
req1)
        (AuthMethodException -> KatipT IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throw (AuthMethodException -> KatipT IO ())
-> AuthMethodException -> KatipT IO ()
forall a b. (a -> b) -> a -> b
$ String -> AuthMethodException
AuthMethodException (String -> AuthMethodException) -> String -> AuthMethodException
forall a b. (a -> b) -> a -> b
$ String
"AuthMethod not configured: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String)
-> (VikunjaRequest req contentType res accept -> TypeRep)
-> VikunjaRequest req contentType res accept
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeRep] -> TypeRep
forall a. [a] -> a
head ([TypeRep] -> TypeRep)
-> (VikunjaRequest req contentType res accept -> [TypeRep])
-> VikunjaRequest req contentType res accept
-> TypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VikunjaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
VikunjaRequest req contentType res accept -> [TypeRep]
rAuthTypes) VikunjaRequest req contentType res accept
req1)
    let req2 :: VikunjaRequest req contentType res accept
req2 = VikunjaRequest req contentType res accept
req1 VikunjaRequest req contentType res accept
-> (VikunjaRequest req contentType res accept
    -> VikunjaRequest req contentType res accept)
-> VikunjaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& VikunjaRequest req contentType res accept
-> VikunjaRequest req contentType res accept
forall req contentType res accept.
MimeType contentType =>
VikunjaRequest req contentType res accept
-> VikunjaRequest req contentType res accept
_setContentTypeHeader VikunjaRequest req contentType res accept
-> (VikunjaRequest req contentType res accept
    -> VikunjaRequest req contentType res accept)
-> VikunjaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& VikunjaRequest req contentType res accept
-> VikunjaRequest req contentType res accept
forall req contentType res accept.
MimeType accept =>
VikunjaRequest req contentType res accept
-> VikunjaRequest req contentType res accept
_setAcceptHeader
        params :: Params
params = VikunjaRequest req contentType res accept -> Params
forall req contentType res accept.
VikunjaRequest req contentType res accept -> Params
rParams VikunjaRequest req contentType res accept
req2
        reqHeaders :: RequestHeaders
reqHeaders = (HeaderName
"User-Agent", Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
WH.toHeader (VikunjaConfig -> Text
configUserAgent VikunjaConfig
config)) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Params -> RequestHeaders
paramsHeaders Params
params
        reqQuery :: ByteString
reqQuery = let query :: Query
query = Params -> Query
paramsQuery Params
params
                       queryExtraUnreserved :: ByteString
queryExtraUnreserved = VikunjaConfig -> ByteString
configQueryExtraUnreserved VikunjaConfig
config
                   in if ByteString -> Bool
B.null ByteString
queryExtraUnreserved
                        then Bool -> Query -> ByteString
NH.renderQuery Bool
True Query
query
                        else Bool -> PartialEscapeQuery -> ByteString
NH.renderQueryPartialEscape Bool
True (ByteString -> Query -> PartialEscapeQuery
toPartialEscapeQuery ByteString
queryExtraUnreserved Query
query)
        pReq :: Request
pReq = Request
parsedReq { method :: ByteString
NH.method = VikunjaRequest req contentType res accept -> ByteString
forall req contentType res accept.
VikunjaRequest req contentType res accept -> ByteString
rMethod VikunjaRequest req contentType res accept
req2
                        , requestHeaders :: RequestHeaders
NH.requestHeaders = RequestHeaders
reqHeaders
                        , queryString :: ByteString
NH.queryString = ByteString
reqQuery
                        }
    Request
outReq <- case Params -> ParamBody
paramsBody Params
params of
        ParamBody
ParamBodyNone -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = RequestBody
forall a. Monoid a => a
mempty })
        ParamBodyB ByteString
bs -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyBS ByteString
bs })
        ParamBodyBL ByteString
bl -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyLBS ByteString
bl })
        ParamBodyFormUrlEncoded Form
form -> Request -> KatipT IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request
pReq { requestBody :: RequestBody
NH.requestBody = ByteString -> RequestBody
NH.RequestBodyLBS (Form -> ByteString
WH.urlEncodeForm Form
form) })
        ParamBodyMultipartFormData [Part]
parts -> [Part] -> Request -> KatipT IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
NH.formDataBody [Part]
parts Request
pReq

    InitRequest req contentType res accept
-> KatipT IO (InitRequest req contentType res accept)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> InitRequest req contentType res accept
forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest Request
outReq)

-- | modify the underlying Request
modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept
modifyInitRequest :: InitRequest req contentType res accept
-> (Request -> Request) -> InitRequest req contentType res accept
modifyInitRequest (InitRequest Request
req) Request -> Request
f = Request -> InitRequest req contentType res accept
forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest (Request -> Request
f Request
req)

-- | modify the underlying Request (monadic)
modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)
modifyInitRequestM :: InitRequest req contentType res accept
-> (Request -> m Request)
-> m (InitRequest req contentType res accept)
modifyInitRequestM (InitRequest Request
req) Request -> m Request
f = (Request -> InitRequest req contentType res accept)
-> m Request -> m (InitRequest req contentType res accept)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Request -> InitRequest req contentType res accept
forall req contentType res accept.
Request -> InitRequest req contentType res accept
InitRequest (Request -> m Request
f Request
req)

-- ** Logging

-- | Run a block using the configured logger instance
runConfigLog
  :: P.MonadIO m
  => VikunjaConfig -> LogExec m a
runConfigLog :: VikunjaConfig -> LogExec m a
runConfigLog VikunjaConfig
config = VikunjaConfig -> LogContext -> LogExec m a
VikunjaConfig
-> forall (m :: * -> *) a. MonadIO m => LogContext -> LogExec m a
configLogExecWithContext VikunjaConfig
config (VikunjaConfig -> LogContext
configLogContext VikunjaConfig
config)

-- | Run a block using the configured logger instance (logs exceptions)
runConfigLogWithExceptions
  :: (E.MonadCatch m, P.MonadIO m)
  => T.Text -> VikunjaConfig -> LogExec m a
runConfigLogWithExceptions :: Text -> VikunjaConfig -> LogExec m a
runConfigLogWithExceptions Text
src VikunjaConfig
config = VikunjaConfig -> LogExec m a
forall (m :: * -> *) a. MonadIO m => VikunjaConfig -> LogExec m a
runConfigLog VikunjaConfig
config LogExec m a -> (KatipT m a -> KatipT m a) -> LogExec m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KatipT m a -> KatipT m a
forall (m :: * -> *) a.
(Katip m, MonadCatch m, Applicative m) =>
Text -> m a -> m a
logExceptions Text
src