{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}
module Vikunja.API.Subscriptions where
import Vikunja.Core
import Vikunja.MimeTypes
import Vikunja.Model as M
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Set as Set
import qualified Data.String as P
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Time as TI
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Media as ME
import qualified Network.HTTP.Types as NH
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Data.Text (Text)
import GHC.Base ((<|>))
import Prelude ((==),(/=),($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)
import qualified Prelude as P
notificationsGet
:: VikunjaRequest NotificationsGet MimeNoContent [NotificationsDatabaseNotification] MimeJSON
notificationsGet :: VikunjaRequest
NotificationsGet
MimeNoContent
[NotificationsDatabaseNotification]
MimeJSON
notificationsGet =
Method
-> [ByteString]
-> VikunjaRequest
NotificationsGet
MimeNoContent
[NotificationsDatabaseNotification]
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/notifications"]
VikunjaRequest
NotificationsGet
MimeNoContent
[NotificationsDatabaseNotification]
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
NotificationsGet
MimeNoContent
[NotificationsDatabaseNotification]
MimeJSON
forall authMethod req contentType res accept.
AuthMethod authMethod =>
VikunjaRequest req contentType res accept
-> Proxy authMethod -> VikunjaRequest req contentType res accept
`_hasAuthType` (Proxy AuthApiKeyJWTKeyAuth
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy AuthApiKeyJWTKeyAuth)
data NotificationsGet
instance HasOptionalParam NotificationsGet Page where
applyOptionalParam :: VikunjaRequest NotificationsGet contentType res accept
-> Page -> VikunjaRequest NotificationsGet contentType res accept
applyOptionalParam VikunjaRequest NotificationsGet contentType res accept
req (Page Int
xs) =
VikunjaRequest NotificationsGet contentType res accept
req VikunjaRequest NotificationsGet contentType res accept
-> [QueryItem]
-> VikunjaRequest NotificationsGet contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [QueryItem] -> VikunjaRequest req contentType res accept
`addQuery` (Method, Maybe Int) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"page", Int -> Maybe Int
forall a. a -> Maybe a
Just Int
xs)
instance HasOptionalParam NotificationsGet PerPage where
applyOptionalParam :: VikunjaRequest NotificationsGet contentType res accept
-> PerPage
-> VikunjaRequest NotificationsGet contentType res accept
applyOptionalParam VikunjaRequest NotificationsGet contentType res accept
req (PerPage Int
xs) =
VikunjaRequest NotificationsGet contentType res accept
req VikunjaRequest NotificationsGet contentType res accept
-> [QueryItem]
-> VikunjaRequest NotificationsGet contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [QueryItem] -> VikunjaRequest req contentType res accept
`addQuery` (Method, Maybe Int) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"per_page", Int -> Maybe Int
forall a. a -> Maybe a
Just Int
xs)
instance Produces NotificationsGet MimeJSON
notificationsIdPost
:: Id
-> VikunjaRequest NotificationsIdPost MimeNoContent ModelsDatabaseNotifications MimeJSON
notificationsIdPost :: Id
-> VikunjaRequest
NotificationsIdPost
MimeNoContent
ModelsDatabaseNotifications
MimeJSON
notificationsIdPost (Id Int
id) =
Method
-> [ByteString]
-> VikunjaRequest
NotificationsIdPost
MimeNoContent
ModelsDatabaseNotifications
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/notifications/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
id]
VikunjaRequest
NotificationsIdPost
MimeNoContent
ModelsDatabaseNotifications
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
NotificationsIdPost
MimeNoContent
ModelsDatabaseNotifications
MimeJSON
forall authMethod req contentType res accept.
AuthMethod authMethod =>
VikunjaRequest req contentType res accept
-> Proxy authMethod -> VikunjaRequest req contentType res accept
`_hasAuthType` (Proxy AuthApiKeyJWTKeyAuth
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy AuthApiKeyJWTKeyAuth)
data NotificationsIdPost
instance Produces NotificationsIdPost MimeJSON
subscriptionsEntityEntityIDDelete
:: Entity
-> EntityId
-> VikunjaRequest SubscriptionsEntityEntityIDDelete MimeNoContent ModelsSubscription MimeJSON
subscriptionsEntityEntityIDDelete :: Entity
-> EntityId
-> VikunjaRequest
SubscriptionsEntityEntityIDDelete
MimeNoContent
ModelsSubscription
MimeJSON
subscriptionsEntityEntityIDDelete (Entity Text
entity) (EntityId Text
entityId) =
Method
-> [ByteString]
-> VikunjaRequest
SubscriptionsEntityEntityIDDelete
MimeNoContent
ModelsSubscription
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"DELETE" [ByteString
"/subscriptions/",Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Text
entity,ByteString
"/",Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Text
entityId]
VikunjaRequest
SubscriptionsEntityEntityIDDelete
MimeNoContent
ModelsSubscription
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
SubscriptionsEntityEntityIDDelete
MimeNoContent
ModelsSubscription
MimeJSON
forall authMethod req contentType res accept.
AuthMethod authMethod =>
VikunjaRequest req contentType res accept
-> Proxy authMethod -> VikunjaRequest req contentType res accept
`_hasAuthType` (Proxy AuthApiKeyJWTKeyAuth
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy AuthApiKeyJWTKeyAuth)
data SubscriptionsEntityEntityIDDelete
instance Produces SubscriptionsEntityEntityIDDelete MimeJSON
subscriptionsEntityEntityIDPut
:: Entity
-> EntityId
-> VikunjaRequest SubscriptionsEntityEntityIDPut MimeNoContent ModelsSubscription MimeJSON
subscriptionsEntityEntityIDPut :: Entity
-> EntityId
-> VikunjaRequest
SubscriptionsEntityEntityIDPut
MimeNoContent
ModelsSubscription
MimeJSON
subscriptionsEntityEntityIDPut (Entity Text
entity) (EntityId Text
entityId) =
Method
-> [ByteString]
-> VikunjaRequest
SubscriptionsEntityEntityIDPut
MimeNoContent
ModelsSubscription
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"PUT" [ByteString
"/subscriptions/",Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Text
entity,ByteString
"/",Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Text
entityId]
VikunjaRequest
SubscriptionsEntityEntityIDPut
MimeNoContent
ModelsSubscription
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
SubscriptionsEntityEntityIDPut
MimeNoContent
ModelsSubscription
MimeJSON
forall authMethod req contentType res accept.
AuthMethod authMethod =>
VikunjaRequest req contentType res accept
-> Proxy authMethod -> VikunjaRequest req contentType res accept
`_hasAuthType` (Proxy AuthApiKeyJWTKeyAuth
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy AuthApiKeyJWTKeyAuth)
data SubscriptionsEntityEntityIDPut
instance Produces SubscriptionsEntityEntityIDPut MimeJSON