{-# 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.Migration 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
migrationMicrosoftTodoAuthGet
:: VikunjaRequest MigrationMicrosoftTodoAuthGet MimeNoContent HandlerAuthURL MimeJSON
migrationMicrosoftTodoAuthGet :: VikunjaRequest
MigrationMicrosoftTodoAuthGet MimeNoContent HandlerAuthURL MimeJSON
migrationMicrosoftTodoAuthGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationMicrosoftTodoAuthGet MimeNoContent HandlerAuthURL MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/microsoft-todo/auth"]
VikunjaRequest
MigrationMicrosoftTodoAuthGet MimeNoContent HandlerAuthURL MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationMicrosoftTodoAuthGet MimeNoContent HandlerAuthURL 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 MigrationMicrosoftTodoAuthGet
instance Produces MigrationMicrosoftTodoAuthGet MimeJSON
migrationMicrosoftTodoMigratePost
:: (Consumes MigrationMicrosoftTodoMigratePost MimeJSON, MimeRender MimeJSON MicrosofttodoMigration)
=> MicrosofttodoMigration
-> VikunjaRequest MigrationMicrosoftTodoMigratePost MimeJSON ModelsMessage MimeJSON
migrationMicrosoftTodoMigratePost :: MicrosofttodoMigration
-> VikunjaRequest
MigrationMicrosoftTodoMigratePost MimeJSON ModelsMessage MimeJSON
migrationMicrosoftTodoMigratePost MicrosofttodoMigration
migrationCode =
Method
-> [ByteString]
-> VikunjaRequest
MigrationMicrosoftTodoMigratePost MimeJSON ModelsMessage MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/migration/microsoft-todo/migrate"]
VikunjaRequest
MigrationMicrosoftTodoMigratePost MimeJSON ModelsMessage MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationMicrosoftTodoMigratePost MimeJSON 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)
VikunjaRequest
MigrationMicrosoftTodoMigratePost MimeJSON ModelsMessage MimeJSON
-> MicrosofttodoMigration
-> VikunjaRequest
MigrationMicrosoftTodoMigratePost MimeJSON ModelsMessage 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` MicrosofttodoMigration
migrationCode
data MigrationMicrosoftTodoMigratePost
instance HasBodyParam MigrationMicrosoftTodoMigratePost MicrosofttodoMigration
instance Consumes MigrationMicrosoftTodoMigratePost MimeJSON
instance Produces MigrationMicrosoftTodoMigratePost MimeJSON
migrationMicrosoftTodoStatusGet
:: VikunjaRequest MigrationMicrosoftTodoStatusGet MimeNoContent MigrationStatus MimeJSON
migrationMicrosoftTodoStatusGet :: VikunjaRequest
MigrationMicrosoftTodoStatusGet
MimeNoContent
MigrationStatus
MimeJSON
migrationMicrosoftTodoStatusGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationMicrosoftTodoStatusGet
MimeNoContent
MigrationStatus
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/microsoft-todo/status"]
VikunjaRequest
MigrationMicrosoftTodoStatusGet
MimeNoContent
MigrationStatus
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationMicrosoftTodoStatusGet
MimeNoContent
MigrationStatus
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 MigrationMicrosoftTodoStatusGet
instance Produces MigrationMicrosoftTodoStatusGet MimeJSON
migrationTicktickMigratePost
:: (Consumes MigrationTicktickMigratePost MimeFormUrlEncoded)
=> ParamImport
-> VikunjaRequest MigrationTicktickMigratePost MimeFormUrlEncoded ModelsMessage MimeJSON
migrationTicktickMigratePost :: ParamImport
-> VikunjaRequest
MigrationTicktickMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
migrationTicktickMigratePost (ParamImport Text
_import) =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTicktickMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/migration/ticktick/migrate"]
VikunjaRequest
MigrationTicktickMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTicktickMigratePost
MimeFormUrlEncoded
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)
VikunjaRequest
MigrationTicktickMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
-> Form
-> VikunjaRequest
MigrationTicktickMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> Form -> VikunjaRequest req contentType res accept
`addForm` (Method, Text) -> Form
forall v. ToHttpApiData v => (Method, v) -> Form
toForm (Method
"import", Text
_import)
data MigrationTicktickMigratePost
instance Consumes MigrationTicktickMigratePost MimeFormUrlEncoded
instance Produces MigrationTicktickMigratePost MimeJSON
migrationTicktickStatusGet
:: VikunjaRequest MigrationTicktickStatusGet MimeNoContent MigrationStatus MimeJSON
migrationTicktickStatusGet :: VikunjaRequest
MigrationTicktickStatusGet MimeNoContent MigrationStatus MimeJSON
migrationTicktickStatusGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTicktickStatusGet MimeNoContent MigrationStatus MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/ticktick/status"]
VikunjaRequest
MigrationTicktickStatusGet MimeNoContent MigrationStatus MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTicktickStatusGet MimeNoContent MigrationStatus 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 MigrationTicktickStatusGet
instance Produces MigrationTicktickStatusGet MimeJSON
migrationTodoistAuthGet
:: VikunjaRequest MigrationTodoistAuthGet MimeNoContent HandlerAuthURL MimeJSON
migrationTodoistAuthGet :: VikunjaRequest
MigrationTodoistAuthGet MimeNoContent HandlerAuthURL MimeJSON
migrationTodoistAuthGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTodoistAuthGet MimeNoContent HandlerAuthURL MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/todoist/auth"]
VikunjaRequest
MigrationTodoistAuthGet MimeNoContent HandlerAuthURL MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTodoistAuthGet MimeNoContent HandlerAuthURL 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 MigrationTodoistAuthGet
instance Produces MigrationTodoistAuthGet MimeJSON
migrationTodoistMigratePost
:: (Consumes MigrationTodoistMigratePost MimeJSON, MimeRender MimeJSON TodoistMigration)
=> TodoistMigration
-> VikunjaRequest MigrationTodoistMigratePost MimeJSON ModelsMessage MimeJSON
migrationTodoistMigratePost :: TodoistMigration
-> VikunjaRequest
MigrationTodoistMigratePost MimeJSON ModelsMessage MimeJSON
migrationTodoistMigratePost TodoistMigration
migrationCode =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTodoistMigratePost MimeJSON ModelsMessage MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/migration/todoist/migrate"]
VikunjaRequest
MigrationTodoistMigratePost MimeJSON ModelsMessage MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTodoistMigratePost MimeJSON 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)
VikunjaRequest
MigrationTodoistMigratePost MimeJSON ModelsMessage MimeJSON
-> TodoistMigration
-> VikunjaRequest
MigrationTodoistMigratePost MimeJSON ModelsMessage 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` TodoistMigration
migrationCode
data MigrationTodoistMigratePost
instance HasBodyParam MigrationTodoistMigratePost TodoistMigration
instance Consumes MigrationTodoistMigratePost MimeJSON
instance Produces MigrationTodoistMigratePost MimeJSON
migrationTodoistStatusGet
:: VikunjaRequest MigrationTodoistStatusGet MimeNoContent MigrationStatus MimeJSON
migrationTodoistStatusGet :: VikunjaRequest
MigrationTodoistStatusGet MimeNoContent MigrationStatus MimeJSON
migrationTodoistStatusGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTodoistStatusGet MimeNoContent MigrationStatus MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/todoist/status"]
VikunjaRequest
MigrationTodoistStatusGet MimeNoContent MigrationStatus MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTodoistStatusGet MimeNoContent MigrationStatus 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 MigrationTodoistStatusGet
instance Produces MigrationTodoistStatusGet MimeJSON
migrationTrelloAuthGet
:: VikunjaRequest MigrationTrelloAuthGet MimeNoContent HandlerAuthURL MimeJSON
migrationTrelloAuthGet :: VikunjaRequest
MigrationTrelloAuthGet MimeNoContent HandlerAuthURL MimeJSON
migrationTrelloAuthGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTrelloAuthGet MimeNoContent HandlerAuthURL MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/trello/auth"]
VikunjaRequest
MigrationTrelloAuthGet MimeNoContent HandlerAuthURL MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTrelloAuthGet MimeNoContent HandlerAuthURL 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 MigrationTrelloAuthGet
instance Produces MigrationTrelloAuthGet MimeJSON
migrationTrelloMigratePost
:: (Consumes MigrationTrelloMigratePost MimeJSON, MimeRender MimeJSON TrelloMigration)
=> TrelloMigration
-> VikunjaRequest MigrationTrelloMigratePost MimeJSON ModelsMessage MimeJSON
migrationTrelloMigratePost :: TrelloMigration
-> VikunjaRequest
MigrationTrelloMigratePost MimeJSON ModelsMessage MimeJSON
migrationTrelloMigratePost TrelloMigration
migrationCode =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTrelloMigratePost MimeJSON ModelsMessage MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/migration/trello/migrate"]
VikunjaRequest
MigrationTrelloMigratePost MimeJSON ModelsMessage MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTrelloMigratePost MimeJSON 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)
VikunjaRequest
MigrationTrelloMigratePost MimeJSON ModelsMessage MimeJSON
-> TrelloMigration
-> VikunjaRequest
MigrationTrelloMigratePost MimeJSON ModelsMessage 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` TrelloMigration
migrationCode
data MigrationTrelloMigratePost
instance HasBodyParam MigrationTrelloMigratePost TrelloMigration
instance Consumes MigrationTrelloMigratePost MimeJSON
instance Produces MigrationTrelloMigratePost MimeJSON
migrationTrelloStatusGet
:: VikunjaRequest MigrationTrelloStatusGet MimeNoContent MigrationStatus MimeJSON
migrationTrelloStatusGet :: VikunjaRequest
MigrationTrelloStatusGet MimeNoContent MigrationStatus MimeJSON
migrationTrelloStatusGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationTrelloStatusGet MimeNoContent MigrationStatus MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/trello/status"]
VikunjaRequest
MigrationTrelloStatusGet MimeNoContent MigrationStatus MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationTrelloStatusGet MimeNoContent MigrationStatus 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 MigrationTrelloStatusGet
instance Produces MigrationTrelloStatusGet MimeJSON
migrationVikunjaFileMigratePost
:: (Consumes MigrationVikunjaFileMigratePost MimeFormUrlEncoded)
=> ParamImport
-> VikunjaRequest MigrationVikunjaFileMigratePost MimeFormUrlEncoded ModelsMessage MimeJSON
migrationVikunjaFileMigratePost :: ParamImport
-> VikunjaRequest
MigrationVikunjaFileMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
migrationVikunjaFileMigratePost (ParamImport Text
_import) =
Method
-> [ByteString]
-> VikunjaRequest
MigrationVikunjaFileMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"POST" [ByteString
"/migration/vikunja-file/migrate"]
VikunjaRequest
MigrationVikunjaFileMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationVikunjaFileMigratePost
MimeFormUrlEncoded
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)
VikunjaRequest
MigrationVikunjaFileMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
-> Form
-> VikunjaRequest
MigrationVikunjaFileMigratePost
MimeFormUrlEncoded
ModelsMessage
MimeJSON
forall req contentType res accept.
VikunjaRequest req contentType res accept
-> Form -> VikunjaRequest req contentType res accept
`addForm` (Method, Text) -> Form
forall v. ToHttpApiData v => (Method, v) -> Form
toForm (Method
"import", Text
_import)
data MigrationVikunjaFileMigratePost
instance Consumes MigrationVikunjaFileMigratePost MimeFormUrlEncoded
instance Produces MigrationVikunjaFileMigratePost MimeJSON
migrationVikunjaFileStatusGet
:: VikunjaRequest MigrationVikunjaFileStatusGet MimeNoContent MigrationStatus MimeJSON
migrationVikunjaFileStatusGet :: VikunjaRequest
MigrationVikunjaFileStatusGet
MimeNoContent
MigrationStatus
MimeJSON
migrationVikunjaFileStatusGet =
Method
-> [ByteString]
-> VikunjaRequest
MigrationVikunjaFileStatusGet
MimeNoContent
MigrationStatus
MimeJSON
forall req contentType res accept.
Method -> [ByteString] -> VikunjaRequest req contentType res accept
_mkRequest Method
"GET" [ByteString
"/migration/vikunja-file/status"]
VikunjaRequest
MigrationVikunjaFileStatusGet
MimeNoContent
MigrationStatus
MimeJSON
-> Proxy AuthApiKeyJWTKeyAuth
-> VikunjaRequest
MigrationVikunjaFileStatusGet
MimeNoContent
MigrationStatus
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 MigrationVikunjaFileStatusGet
instance Produces MigrationVikunjaFileStatusGet MimeJSON