{-# 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.Sharing 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
notificationsPost
:: VikunjaRequest NotificationsPost MimeNoContent ModelsMessage MimeJSON
notificationsPost :: VikunjaRequest
NotificationsPost MimeNoContent ModelsMessage MimeJSON
notificationsPost =
Method
-> [ByteString]
-> VikunjaRequest
NotificationsPost MimeNoContent ModelsMessage MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/notifications"]
data NotificationsPost
instance Produces NotificationsPost MimeJSON
projectsIdTeamsGet
:: Id
-> VikunjaRequest ProjectsIdTeamsGet MimeNoContent [ModelsTeamWithRight] MimeJSON
projectsIdTeamsGet :: Id
-> VikunjaRequest
ProjectsIdTeamsGet MimeNoContent [ModelsTeamWithRight] MimeJSON
projectsIdTeamsGet (Id Int
id) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsIdTeamsGet MimeNoContent [ModelsTeamWithRight] MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
id,ByteString
"/teams"]
VikunjaRequest
ProjectsIdTeamsGet MimeNoContent [ModelsTeamWithRight] MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsIdTeamsGet MimeNoContent [ModelsTeamWithRight] 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 ProjectsIdTeamsGet
instance HasOptionalParam ProjectsIdTeamsGet Page where
applyOptionalParam :: VikunjaRequest ProjectsIdTeamsGet contentType res accept
-> Page -> VikunjaRequest ProjectsIdTeamsGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsIdTeamsGet contentType res accept
req (Page Int
xs) =
VikunjaRequest ProjectsIdTeamsGet contentType res accept
req VikunjaRequest ProjectsIdTeamsGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsIdTeamsGet 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 ProjectsIdTeamsGet PerPage where
applyOptionalParam :: VikunjaRequest ProjectsIdTeamsGet contentType res accept
-> PerPage
-> VikunjaRequest ProjectsIdTeamsGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsIdTeamsGet contentType res accept
req (PerPage Int
xs) =
VikunjaRequest ProjectsIdTeamsGet contentType res accept
req VikunjaRequest ProjectsIdTeamsGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsIdTeamsGet 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 HasOptionalParam ProjectsIdTeamsGet S where
applyOptionalParam :: VikunjaRequest ProjectsIdTeamsGet contentType res accept
-> S -> VikunjaRequest ProjectsIdTeamsGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsIdTeamsGet contentType res accept
req (S Text
xs) =
VikunjaRequest ProjectsIdTeamsGet contentType res accept
req VikunjaRequest ProjectsIdTeamsGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsIdTeamsGet contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [QueryItem] -> VikunjaRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"s", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance Produces ProjectsIdTeamsGet MimeJSON
projectsIdTeamsPut
:: (Consumes ProjectsIdTeamsPut MimeJSON, MimeRender MimeJSON ModelsTeamProject)
=> ModelsTeamProject
-> Id
-> VikunjaRequest ProjectsIdTeamsPut MimeJSON ModelsTeamProject MimeJSON
projectsIdTeamsPut :: ModelsTeamProject
-> Id
-> VikunjaRequest
ProjectsIdTeamsPut MimeJSON ModelsTeamProject MimeJSON
projectsIdTeamsPut ModelsTeamProject
project (Id Int
id) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsIdTeamsPut MimeJSON ModelsTeamProject MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"PUT" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
id,ByteString
"/teams"]
VikunjaRequest
ProjectsIdTeamsPut MimeJSON ModelsTeamProject MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsIdTeamsPut MimeJSON ModelsTeamProject 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)
VikunjaRequest
ProjectsIdTeamsPut MimeJSON ModelsTeamProject MimeJSON
-> ModelsTeamProject
-> VikunjaRequest
ProjectsIdTeamsPut MimeJSON ModelsTeamProject MimeJSON
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
VikunjaRequest req contentType res accept
-> param -> VikunjaRequest req contentType res accept
`setBodyParam` ModelsTeamProject
project
data ProjectsIdTeamsPut
instance HasBodyParam ProjectsIdTeamsPut ModelsTeamProject
instance Consumes ProjectsIdTeamsPut MimeJSON
instance Produces ProjectsIdTeamsPut MimeJSON
projectsIdUsersGet
:: Id
-> VikunjaRequest ProjectsIdUsersGet MimeNoContent [ModelsUserWithRight] MimeJSON
projectsIdUsersGet :: Id
-> VikunjaRequest
ProjectsIdUsersGet MimeNoContent [ModelsUserWithRight] MimeJSON
projectsIdUsersGet (Id Int
id) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsIdUsersGet MimeNoContent [ModelsUserWithRight] MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
id,ByteString
"/users"]
VikunjaRequest
ProjectsIdUsersGet MimeNoContent [ModelsUserWithRight] MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsIdUsersGet MimeNoContent [ModelsUserWithRight] 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 ProjectsIdUsersGet
instance HasOptionalParam ProjectsIdUsersGet Page where
applyOptionalParam :: VikunjaRequest ProjectsIdUsersGet contentType res accept
-> Page -> VikunjaRequest ProjectsIdUsersGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsIdUsersGet contentType res accept
req (Page Int
xs) =
VikunjaRequest ProjectsIdUsersGet contentType res accept
req VikunjaRequest ProjectsIdUsersGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsIdUsersGet 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 ProjectsIdUsersGet PerPage where
applyOptionalParam :: VikunjaRequest ProjectsIdUsersGet contentType res accept
-> PerPage
-> VikunjaRequest ProjectsIdUsersGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsIdUsersGet contentType res accept
req (PerPage Int
xs) =
VikunjaRequest ProjectsIdUsersGet contentType res accept
req VikunjaRequest ProjectsIdUsersGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsIdUsersGet 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 HasOptionalParam ProjectsIdUsersGet S where
applyOptionalParam :: VikunjaRequest ProjectsIdUsersGet contentType res accept
-> S -> VikunjaRequest ProjectsIdUsersGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsIdUsersGet contentType res accept
req (S Text
xs) =
VikunjaRequest ProjectsIdUsersGet contentType res accept
req VikunjaRequest ProjectsIdUsersGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsIdUsersGet contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [QueryItem] -> VikunjaRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"s", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance Produces ProjectsIdUsersGet MimeJSON
projectsIdUsersPut
:: (Consumes ProjectsIdUsersPut MimeJSON, MimeRender MimeJSON ModelsProjectUser)
=> ModelsProjectUser
-> Id
-> VikunjaRequest ProjectsIdUsersPut MimeJSON ModelsProjectUser MimeJSON
projectsIdUsersPut :: ModelsProjectUser
-> Id
-> VikunjaRequest
ProjectsIdUsersPut MimeJSON ModelsProjectUser MimeJSON
projectsIdUsersPut ModelsProjectUser
project (Id Int
id) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsIdUsersPut MimeJSON ModelsProjectUser MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"PUT" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
id,ByteString
"/users"]
VikunjaRequest
ProjectsIdUsersPut MimeJSON ModelsProjectUser MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsIdUsersPut MimeJSON ModelsProjectUser 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)
VikunjaRequest
ProjectsIdUsersPut MimeJSON ModelsProjectUser MimeJSON
-> ModelsProjectUser
-> VikunjaRequest
ProjectsIdUsersPut MimeJSON ModelsProjectUser MimeJSON
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
VikunjaRequest req contentType res accept
-> param -> VikunjaRequest req contentType res accept
`setBodyParam` ModelsProjectUser
project
data ProjectsIdUsersPut
instance HasBodyParam ProjectsIdUsersPut ModelsProjectUser
instance Consumes ProjectsIdUsersPut MimeJSON
instance Produces ProjectsIdUsersPut MimeJSON
projectsProjectIDTeamsTeamIDDelete
:: ProjectId
-> TeamId
-> VikunjaRequest ProjectsProjectIDTeamsTeamIDDelete MimeNoContent ModelsMessage MimeJSON
projectsProjectIDTeamsTeamIDDelete :: ProjectId
-> TeamId
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDDelete
MimeNoContent
ModelsMessage
MimeJSON
projectsProjectIDTeamsTeamIDDelete (ProjectId Int
projectId) (TeamId Int
teamId) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDDelete
MimeNoContent
ModelsMessage
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"DELETE" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
projectId,ByteString
"/teams/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
teamId]
VikunjaRequest
ProjectsProjectIDTeamsTeamIDDelete
MimeNoContent
ModelsMessage
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDDelete
MimeNoContent
ModelsMessage
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 ProjectsProjectIDTeamsTeamIDDelete
instance Produces ProjectsProjectIDTeamsTeamIDDelete MimeJSON
projectsProjectIDTeamsTeamIDPost
:: (Consumes ProjectsProjectIDTeamsTeamIDPost MimeJSON, MimeRender MimeJSON ModelsTeamProject)
=> ModelsTeamProject
-> ProjectId
-> TeamId
-> VikunjaRequest ProjectsProjectIDTeamsTeamIDPost MimeJSON ModelsTeamProject MimeJSON
projectsProjectIDTeamsTeamIDPost :: ModelsTeamProject
-> ProjectId
-> TeamId
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDPost
MimeJSON
ModelsTeamProject
MimeJSON
projectsProjectIDTeamsTeamIDPost ModelsTeamProject
project (ProjectId Int
projectId) (TeamId Int
teamId) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDPost
MimeJSON
ModelsTeamProject
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
projectId,ByteString
"/teams/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
teamId]
VikunjaRequest
ProjectsProjectIDTeamsTeamIDPost
MimeJSON
ModelsTeamProject
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDPost
MimeJSON
ModelsTeamProject
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)
VikunjaRequest
ProjectsProjectIDTeamsTeamIDPost
MimeJSON
ModelsTeamProject
MimeJSON
-> ModelsTeamProject
-> VikunjaRequest
ProjectsProjectIDTeamsTeamIDPost
MimeJSON
ModelsTeamProject
MimeJSON
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
VikunjaRequest req contentType res accept
-> param -> VikunjaRequest req contentType res accept
`setBodyParam` ModelsTeamProject
project
data ProjectsProjectIDTeamsTeamIDPost
instance HasBodyParam ProjectsProjectIDTeamsTeamIDPost ModelsTeamProject
instance Consumes ProjectsProjectIDTeamsTeamIDPost MimeJSON
instance Produces ProjectsProjectIDTeamsTeamIDPost MimeJSON
projectsProjectIDUsersUserIDDelete
:: ProjectId
-> UserId
-> VikunjaRequest ProjectsProjectIDUsersUserIDDelete MimeNoContent ModelsMessage MimeJSON
projectsProjectIDUsersUserIDDelete :: ProjectId
-> UserId
-> VikunjaRequest
ProjectsProjectIDUsersUserIDDelete
MimeNoContent
ModelsMessage
MimeJSON
projectsProjectIDUsersUserIDDelete (ProjectId Int
projectId) (UserId Int
userId) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectIDUsersUserIDDelete
MimeNoContent
ModelsMessage
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"DELETE" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
projectId,ByteString
"/users/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
userId]
VikunjaRequest
ProjectsProjectIDUsersUserIDDelete
MimeNoContent
ModelsMessage
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectIDUsersUserIDDelete
MimeNoContent
ModelsMessage
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 ProjectsProjectIDUsersUserIDDelete
instance Produces ProjectsProjectIDUsersUserIDDelete MimeJSON
projectsProjectIDUsersUserIDPost
:: (Consumes ProjectsProjectIDUsersUserIDPost MimeJSON, MimeRender MimeJSON ModelsProjectUser)
=> ModelsProjectUser
-> ProjectId
-> UserId
-> VikunjaRequest ProjectsProjectIDUsersUserIDPost MimeJSON ModelsProjectUser MimeJSON
projectsProjectIDUsersUserIDPost :: ModelsProjectUser
-> ProjectId
-> UserId
-> VikunjaRequest
ProjectsProjectIDUsersUserIDPost
MimeJSON
ModelsProjectUser
MimeJSON
projectsProjectIDUsersUserIDPost ModelsProjectUser
project (ProjectId Int
projectId) (UserId Int
userId) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectIDUsersUserIDPost
MimeJSON
ModelsProjectUser
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
projectId,ByteString
"/users/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
userId]
VikunjaRequest
ProjectsProjectIDUsersUserIDPost
MimeJSON
ModelsProjectUser
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectIDUsersUserIDPost
MimeJSON
ModelsProjectUser
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)
VikunjaRequest
ProjectsProjectIDUsersUserIDPost
MimeJSON
ModelsProjectUser
MimeJSON
-> ModelsProjectUser
-> VikunjaRequest
ProjectsProjectIDUsersUserIDPost
MimeJSON
ModelsProjectUser
MimeJSON
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
VikunjaRequest req contentType res accept
-> param -> VikunjaRequest req contentType res accept
`setBodyParam` ModelsProjectUser
project
data ProjectsProjectIDUsersUserIDPost
instance HasBodyParam ProjectsProjectIDUsersUserIDPost ModelsProjectUser
instance Consumes ProjectsProjectIDUsersUserIDPost MimeJSON
instance Produces ProjectsProjectIDUsersUserIDPost MimeJSON
projectsProjectSharesGet
:: Project
-> VikunjaRequest ProjectsProjectSharesGet MimeNoContent [ModelsLinkSharing] MimeJSON
projectsProjectSharesGet :: Project
-> VikunjaRequest
ProjectsProjectSharesGet MimeNoContent [ModelsLinkSharing] MimeJSON
projectsProjectSharesGet (Project Int
project) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectSharesGet MimeNoContent [ModelsLinkSharing] MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
project,ByteString
"/shares"]
VikunjaRequest
ProjectsProjectSharesGet MimeNoContent [ModelsLinkSharing] MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectSharesGet MimeNoContent [ModelsLinkSharing] 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 ProjectsProjectSharesGet
instance HasOptionalParam ProjectsProjectSharesGet Page where
applyOptionalParam :: VikunjaRequest ProjectsProjectSharesGet contentType res accept
-> Page
-> VikunjaRequest ProjectsProjectSharesGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsProjectSharesGet contentType res accept
req (Page Int
xs) =
VikunjaRequest ProjectsProjectSharesGet contentType res accept
req VikunjaRequest ProjectsProjectSharesGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsProjectSharesGet 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 ProjectsProjectSharesGet PerPage where
applyOptionalParam :: VikunjaRequest ProjectsProjectSharesGet contentType res accept
-> PerPage
-> VikunjaRequest ProjectsProjectSharesGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsProjectSharesGet contentType res accept
req (PerPage Int
xs) =
VikunjaRequest ProjectsProjectSharesGet contentType res accept
req VikunjaRequest ProjectsProjectSharesGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsProjectSharesGet 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 HasOptionalParam ProjectsProjectSharesGet S where
applyOptionalParam :: VikunjaRequest ProjectsProjectSharesGet contentType res accept
-> S
-> VikunjaRequest ProjectsProjectSharesGet contentType res accept
applyOptionalParam VikunjaRequest ProjectsProjectSharesGet contentType res accept
req (S Text
xs) =
VikunjaRequest ProjectsProjectSharesGet contentType res accept
req VikunjaRequest ProjectsProjectSharesGet contentType res accept
-> [QueryItem]
-> VikunjaRequest ProjectsProjectSharesGet contentType res accept
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> [QueryItem] -> VikunjaRequest req contentType res accept
`addQuery` (Method, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (Method, Maybe a) -> [QueryItem]
toQuery (Method
"s", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
xs)
instance Produces ProjectsProjectSharesGet MimeJSON
projectsProjectSharesPut
:: (Consumes ProjectsProjectSharesPut MimeJSON, MimeRender MimeJSON ModelsLinkSharing)
=> ModelsLinkSharing
-> Project
-> VikunjaRequest ProjectsProjectSharesPut MimeJSON ModelsLinkSharing MimeJSON
projectsProjectSharesPut :: ModelsLinkSharing
-> Project
-> VikunjaRequest
ProjectsProjectSharesPut MimeJSON ModelsLinkSharing MimeJSON
projectsProjectSharesPut ModelsLinkSharing
label (Project Int
project) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectSharesPut MimeJSON ModelsLinkSharing MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"PUT" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
project,ByteString
"/shares"]
VikunjaRequest
ProjectsProjectSharesPut MimeJSON ModelsLinkSharing MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectSharesPut MimeJSON ModelsLinkSharing 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)
VikunjaRequest
ProjectsProjectSharesPut MimeJSON ModelsLinkSharing MimeJSON
-> ModelsLinkSharing
-> VikunjaRequest
ProjectsProjectSharesPut MimeJSON ModelsLinkSharing MimeJSON
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
VikunjaRequest req contentType res accept
-> param -> VikunjaRequest req contentType res accept
`setBodyParam` ModelsLinkSharing
label
data ProjectsProjectSharesPut
instance HasBodyParam ProjectsProjectSharesPut ModelsLinkSharing
instance Consumes ProjectsProjectSharesPut MimeJSON
instance Produces ProjectsProjectSharesPut MimeJSON
projectsProjectSharesShareDelete
:: Project
-> Share
-> VikunjaRequest ProjectsProjectSharesShareDelete MimeNoContent ModelsMessage MimeJSON
projectsProjectSharesShareDelete :: Project
-> Share
-> VikunjaRequest
ProjectsProjectSharesShareDelete
MimeNoContent
ModelsMessage
MimeJSON
projectsProjectSharesShareDelete (Project Int
project) (Share Int
share) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectSharesShareDelete
MimeNoContent
ModelsMessage
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"DELETE" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
project,ByteString
"/shares/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
share]
VikunjaRequest
ProjectsProjectSharesShareDelete
MimeNoContent
ModelsMessage
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectSharesShareDelete
MimeNoContent
ModelsMessage
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 ProjectsProjectSharesShareDelete
instance Produces ProjectsProjectSharesShareDelete MimeJSON
projectsProjectSharesShareGet
:: Project
-> Share
-> VikunjaRequest ProjectsProjectSharesShareGet MimeNoContent ModelsLinkSharing MimeJSON
projectsProjectSharesShareGet :: Project
-> Share
-> VikunjaRequest
ProjectsProjectSharesShareGet
MimeNoContent
ModelsLinkSharing
MimeJSON
projectsProjectSharesShareGet (Project Int
project) (Share Int
share) =
Method
-> [ByteString]
-> VikunjaRequest
ProjectsProjectSharesShareGet
MimeNoContent
ModelsLinkSharing
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/projects/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
project,ByteString
"/shares/",Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Int
share]
VikunjaRequest
ProjectsProjectSharesShareGet
MimeNoContent
ModelsLinkSharing
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
ProjectsProjectSharesShareGet
MimeNoContent
ModelsLinkSharing
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 ProjectsProjectSharesShareGet
instance Produces ProjectsProjectSharesShareGet MimeJSON
sharesShareAuthPost
:: (Consumes SharesShareAuthPost MimeJSON, MimeRender MimeJSON V1LinkShareAuth)
=> V1LinkShareAuth
-> ShareText
-> VikunjaRequest SharesShareAuthPost MimeJSON AuthToken MimeJSON
sharesShareAuthPost :: V1LinkShareAuth
-> ShareText
-> VikunjaRequest SharesShareAuthPost MimeJSON AuthToken MimeJSON
sharesShareAuthPost V1LinkShareAuth
password (ShareText Text
share) =
Method
-> [ByteString]
-> VikunjaRequest SharesShareAuthPost MimeJSON AuthToken MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/shares/",Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
toPath Text
share,ByteString
"/auth"]
VikunjaRequest SharesShareAuthPost MimeJSON AuthToken MimeJSON
-> V1LinkShareAuth
-> VikunjaRequest SharesShareAuthPost MimeJSON AuthToken MimeJSON
forall req param contentType res accept.
(HasBodyParam req param, Consumes req contentType,
MimeRender contentType param) =>
VikunjaRequest req contentType res accept
-> param -> VikunjaRequest req contentType res accept
`setBodyParam` V1LinkShareAuth
password
data SharesShareAuthPost
instance HasBodyParam SharesShareAuthPost V1LinkShareAuth
instance Consumes SharesShareAuthPost MimeJSON
instance Produces SharesShareAuthPost MimeJSON