diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Tomas Carnecky + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/avers-api.cabal b/avers-api.cabal new file mode 100644 --- /dev/null +++ b/avers-api.cabal @@ -0,0 +1,40 @@ +name: avers-api +version: 0.0.1 +synopsis: Types describing the core and extended Avers APIs +description: See README +homepage: http://github.com/wereHamster/avers-api +license: MIT +license-file: LICENSE +author: Tomas Carnecky +maintainer: tomas.carnecky@gmail.com +copyright: 2016 Tomas Carnecky +category: Avers +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/wereHamster/avers-api + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + + exposed-modules: + Avers.API + + other-modules: + Avers.API.Types + , Avers.API.Instances + , Avers.API.Credentials + + build-depends: + base >= 4.7 && < 5 + , aeson + , avers + , bytestring + , cookie + , servant + , text + , time diff --git a/src/Avers/API.hs b/src/Avers/API.hs new file mode 100644 --- /dev/null +++ b/src/Avers/API.hs @@ -0,0 +1,166 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Avers.API + ( AversCoreAPI, AversSessionAPI, AversBlobAPI, AversAccountAPI + + , module Avers.API.Types + , module Avers.API.Credentials + ) where + + +import Data.Text (Text) +import Data.ByteString (ByteString) + +import Avers.Types (ObjId, RevId, BlobId, SessionId) + +import Avers.API.Types +import Avers.API.Instances () +import Avers.API.Credentials + +import Servant.API + +import Web.Cookie + + + +-------------------------------------------------------------------------------- +-- | The Core API to manipulate objects, patches, releases etc. + +type AversCoreAPI + + ------------------------------------------------------------------------------ + -- CreateObject + = "objects" + :> Credentials + :> ReqBody '[JSON] CreateObjectBody + :> Post '[JSON] CreateObjectResponse + + ------------------------------------------------------------------------------ + -- LookupObject + :<|> "objects" :> Capture "objId" ObjId + :> Credentials + :> Get '[JSON] LookupObjectResponse + + ------------------------------------------------------------------------------ + -- PatchObject + :<|> "objects" :> Capture "objId" ObjId + :> Credentials + :> ReqBody '[JSON] PatchObjectBody + :> Patch '[JSON] PatchObjectResponse + + ------------------------------------------------------------------------------ + -- DeleteObject + :<|> "objects" :> Capture "objId" ObjId + :> Credentials + :> Delete '[JSON] () + + ------------------------------------------------------------------------------ + -- LookupPatch + :<|> "objects" :> Capture "objId" ObjId :> Capture "revId" RevId + :> Credentials + :> Get '[JSON] LookupPatchResponse + + ------------------------------------------------------------------------------ + -- ObjectChanges + :<|> "objects" :> Capture "objId" ObjId :> "changes" + :> Credentials + :> Raw -- WebSocket, stream of ObjectChangeNotification + + ------------------------------------------------------------------------------ + -- CreateRelease + :<|> "objects" :> Capture "objId" ObjId :> "releases" + :> Credentials + :> ReqBody '[JSON] CreateReleaseBody + :> Post '[JSON] CreateReleaseResponse + + ------------------------------------------------------------------------------ + -- LookupRelease + :<|> "objects" :> Capture "objId" ObjId :> "releases" :> Capture "revId" RevId + :> Credentials + :> Get '[JSON] LookupReleaseResponse + + ------------------------------------------------------------------------------ + -- LookupLatestRelease + :<|> "objects" :> Capture "objId" ObjId :> "releases" :> "_latest" + :> Credentials + :> Get '[JSON] LookupLatestReleaseResponse + + ------------------------------------------------------------------------------ + -- ChangeSecret + :<|> "secret" + :> Credentials + :> ReqBody '[JSON] ChangeSecretBody + :> Post '[] () + + + +-------------------------------------------------------------------------------- +-- | API to create and maintain sessions. Also contains API to +-- change the secret, which is part of the session code. + +type AversSessionAPI + + ------------------------------------------------------------------------------ + -- CreateSession + = "session" + :> ReqBody '[JSON] CreateSessionBody + :> Post '[JSON] (Headers '[Header "Set-Cookie" SetCookie] CreateSessionResponse) + + ------------------------------------------------------------------------------ + -- LookupSession + :<|> "session" + :> SessionId + :> Get '[JSON] (Headers '[Header "Set-Cookie" SetCookie] LookupSessionResponse) + + ------------------------------------------------------------------------------ + -- DeleteSession + :<|> "session" + :> SessionId + :> Delete '[JSON] (Headers '[Header "Set-Cookie" SetCookie] ()) + + + +-------------------------------------------------------------------------------- +-- | API to manange blobs + +type AversBlobAPI + + ------------------------------------------------------------------------------ + -- UploadBlob + = "blobs" + :> Header "Content-Type" Text + :> ReqBody '[OctetStream] ByteString + :> Post '[JSON] UploadBlobResponse + + ------------------------------------------------------------------------------ + -- LookupBlob + :<|> "blobs" :> Capture "blobId" BlobId + :> Get '[JSON] LookupBlobResponse + + ------------------------------------------------------------------------------ + -- BlobContent + :<|> "blobs" :> Capture "blobId" BlobId :> "content" + :> Get '[OctetStream] (Headers '[Header "Content-Type" Text] ByteString) + + + +-------------------------------------- +-- | API to manage accounts. These are optional and not really part of +-- Avers, but many applications do have a concept of a user or account, +-- some person which is using the API. + +type AversAccountAPI + + ------------------------------------------------------------------------------ + -- Signup. + -- + -- Similar to CreateObject but no authorization is required. Instead, + -- a different mechanism is used to ensure that the client is allowed + -- to execute the action (eg. an captcha). + + = "signup" + :> ReqBody '[JSON] SignupBody + :> Post '[JSON] SignupResponse diff --git a/src/Avers/API/Credentials.hs b/src/Avers/API/Credentials.hs new file mode 100644 --- /dev/null +++ b/src/Avers/API/Credentials.hs @@ -0,0 +1,17 @@ +module Avers.API.Credentials where + + +import Avers + + + +-- | Credentials are used to authenticate the client. It can be a SessionId +-- (extracted from the 'session' cookie). +-- +-- Later we may add support for token based authentication. Then we extend +-- this into a sumtype covering all the possible ways how credentials can be +-- passed along with the request. + +data Credentials + = SessionIdCredential !SessionId + -- | AccessTokenCredential !AccessToken diff --git a/src/Avers/API/Instances.hs b/src/Avers/API/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Avers/API/Instances.hs @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Avers.API.Instances where + + +import Avers +import Servant.API (FromText(..)) + + + +instance FromText ObjId where + fromText = Just . ObjId + +instance FromText RevId where + fromText x = fromText x >>= Just . RevId diff --git a/src/Avers/API/Types.hs b/src/Avers/API/Types.hs new file mode 100644 --- /dev/null +++ b/src/Avers/API/Types.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Avers.API.Types where + +import Data.Text (Text) +import Data.Aeson as A +import Data.Time +import Avers + + + + +-------------------------------------------------------------------------------- +-- CreateObject + +data CreateObjectBody = CreateObjectBody + { cobType :: !Text + , cobContent :: !Value + } + +instance FromJSON CreateObjectBody where + parseJSON (A.Object o) = CreateObjectBody <$> o .: "type" <*> o .: "content" + parseJSON _ = fail "CreateObjectBody" + + +data CreateObjectResponse = CreateObjectResponse + { corId :: !ObjId + , corType :: !Text + , corContent :: !Value + } + +instance ToJSON CreateObjectResponse where + toJSON x = object + [ "id" .= corId x + , "type" .= corType x + , "content" .= corContent x + ] + + + +-------------------------------------------------------------------------------- +-- LookupObject + +data LookupObjectResponse = LookupObjectResponse + { lorId :: !ObjId + , lorType :: !Text + , lorCreatedAt :: !UTCTime + , lorCreatedBy :: !ObjId + , lorRevisionId :: !RevId + , lorContent :: !Value + } + +instance ToJSON LookupObjectResponse where + toJSON x = object + [ "id" .= lorId x + , "type" .= lorType x + , "createdAt" .= lorCreatedAt x + , "createdBy" .= lorCreatedBy x + , "revisionId" .= lorRevisionId x + , "content" .= lorContent x + ] + + + +-------------------------------------------------------------------------------- +-- PatchObject + +data PatchObjectBody = PatchObjectBody + { pobRevisionId :: !RevId + -- ^ The 'RevId' against which the client created the operations. This may + -- be a bit behind if some other client submitted patches in parallel. + + , pobOperations :: ![Operation] + -- ^ The operations which the client wants to store in the database. + } + +instance FromJSON PatchObjectBody where + parseJSON (A.Object o) = PatchObjectBody <$> o .: "revisionId" <*> o .: "operations" + parseJSON _ = fail "PatchObjectBody" + + +data PatchObjectResponse = PatchObjectResponse + { porPreviousPatches :: ![Patch] + -- ^ Patches which were already in the database. The submitted ops were + -- rebased on top of these. + + , porNumProcessedOperations :: !Int + -- ^ The number of operations which were processed. This may be smaller + -- than the number of submitted ops if the processing failed somewhere + -- in the middle. The client can then decide what to do with those which + -- were not accepted. + + , porResultingPatches :: ![Patch] + -- ^ Out of the submitted operations, these are the patches which were + -- actually applied and stored in the database. This list may be shorter + -- if some operations were dropped (because redundant or conflicting). + } + +instance ToJSON PatchObjectResponse where + toJSON x = object + [ "previousPatches" .= porPreviousPatches x + , "numProcessedOperations" .= porNumProcessedOperations x + , "resultingPatches" .= porResultingPatches x + ] + + + +-------------------------------------------------------------------------------- +-- ObjectChanges + +data ObjectChangeNotification + = PatchNotification !Patch + -- ^ A new patch was created. + + -- | LatestReleaseNotification !Release + -- ^ A new release was created. + +instance ToJSON ObjectChangeNotification where + toJSON (PatchNotification p) = object [ "type" .= ("patch" :: Text), "content" .= p ] + -- toJSON (ReleaseNotification r) = object [ "type" .= ("release" :: Text), "content" .= r ] + + + +-------------------------------------------------------------------------------- +-- LookupPatch + +type LookupPatchResponse = Patch + + + +-------------------------------------------------------------------------------- +-- CreateRelease + +data CreateReleaseBody = CreateReleaseBody + { + } + +instance FromJSON CreateReleaseBody where + parseJSON = undefined + + +data CreateReleaseResponse = CreateReleaseResponse + { + } + +instance ToJSON CreateReleaseResponse where + toJSON = undefined + + + +-------------------------------------------------------------------------------- +-- LookupRelease + +data LookupReleaseResponse = LookupReleaseResponse + { + } + +instance ToJSON LookupReleaseResponse where + toJSON = undefined + + + +-------------------------------------------------------------------------------- +-- LookupLatestRelease + +data LookupLatestReleaseResponse = LookupLatestReleaseResponse + { + } + +instance ToJSON LookupLatestReleaseResponse where + toJSON = undefined + + + +-------------------------------------------------------------------------------- +-- CreateSession + +data CreateSessionBody = CreateSessionBody + { csbLogin :: !SecretId + , csbSecret :: !Text + } + +instance FromJSON CreateSessionBody where + parseJSON (A.Object o) = CreateSessionBody <$> o .: "login" <*> o .: "secret" + parseJSON _ = fail "CreateSessionBody" + + +data CreateSessionResponse = CreateSessionResponse + { csrSessionId :: !SessionId + , csrSessionObjId :: !ObjId + } + +instance ToJSON CreateSessionResponse where + toJSON x = object + [ "id" .= csrSessionId x + , "objId" .= csrSessionObjId x + ] + + + +-------------------------------------------------------------------------------- +-- LookupSession + +data LookupSessionResponse = LookupSessionResponse + { lsrSessionId :: !SessionId + , lsrSessionObjId :: !ObjId + } + +instance ToJSON LookupSessionResponse where + toJSON x = object + [ "id" .= lsrSessionId x + , "objId" .= lsrSessionObjId x + ] + + +-------------------------------------------------------------------------------- +-- ChangeSecret + +data ChangeSecretBody = ChangeSecretBody + { csbNewSecret :: !Text + } + +instance FromJSON ChangeSecretBody where + parseJSON (A.Object o) = ChangeSecretBody <$> o .: "secret" + parseJSON _ = fail "ChangeSecretBody" + + + +-------------------------------------------------------------------------------- +-- UploadBlob + +data UploadBlobResponse = UploadBlobResponse + { + } + + + +-------------------------------------------------------------------------------- +-- LookupBlob + +data LookupBlobResponse = LookupBlobResponse + { + } + + + +-------------------------------------------------------------------------------- +-- Signup + +data SignupBody = SignupBody + { + } + +instance FromJSON SignupBody where + parseJSON = undefined + +data SignupResponse = SignupResponse + { + } + +instance ToJSON SignupResponse where + toJSON = undefined