avers-server 0.0.1 → 0.0.2
raw patch · 2 files changed
+27/−8 lines, 2 filesdep +base64-bytestringdep +cryptohash
Dependencies added: base64-bytestring, cryptohash
Files
- avers-server.cabal +3/−1
- src/Avers/Server.hs +24/−7
avers-server.cabal view
@@ -1,5 +1,5 @@ name: avers-server-version: 0.0.1+version: 0.0.2 synopsis: Server implementation of the Avers API description: See README.md homepage: http://github.com/wereHamster/avers-server@@ -33,9 +33,11 @@ , aeson , avers , avers-api+ , base64-bytestring , bytestring , bytestring-conversion , cookie+ , cryptohash , either , http-types , mtl
src/Avers/Server.hs view
@@ -25,7 +25,8 @@ -- import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Base64 as BS64 import Data.Monoid@@ -33,9 +34,11 @@ -- import Data.Proxy -- import Data.Maybe import Data.Time-import Data.Aeson (encode, decode)+import Data.Aeson (ToJSON, encode, decode) -- import Data.Aeson.TH (defaultOptions) +import Crypto.Hash.SHA256 (hashlazy)+ import Servant.API import Servant.Server @@ -60,8 +63,14 @@ import Web.Cookie +import Prelude ++etagVersion :: Text+etagVersion = "v0"++ -- | Convert the 'Credentials' into an 'ObjId' to which the ceredentials refer. -- That's the object the client is authenticated as. credentialsObjId :: Handle -> Credentials -> EitherT ServantErr IO ObjId@@ -99,7 +108,15 @@ reqAvers aversH m = liftIO (evalAvers aversH m) >>= aversResult +cacheableResponse :: (ToJSON a) => Maybe Text -> a -> EitherT ServantErr IO (Cacheable a)+cacheableResponse mbValidationToken a = do+ let etag = T.decodeUtf8 $ BS64.encode $ hashlazy $ encode a+ if mbValidationToken == Just (etagVersion <> ":" <> etag)+ then left $ err304+ else pure $ addHeader "no-cache, public, max-age=63072000"+ $ addHeader (etagVersion <> ":" <> etag) a + serveAversCoreAPI :: Handle -> Authorizations -> Server AversCoreAPI serveAversCoreAPI aversH auth = serveCreateObject@@ -138,7 +155,7 @@ ---------------------------------------------------------------------------- -- LookupObject- serveLookupObject objId cred = do+ serveLookupObject objId cred validationToken = do runAuthorization aversH $ lookupObjectAuthz auth cred objId @@ -149,7 +166,7 @@ pure (object, snapshot) - pure $ LookupObjectResponse+ cacheableResponse validationToken $ LookupObjectResponse { lorId = objId , lorType = objectType , lorCreatedAt = objectCreatedAt@@ -181,7 +198,7 @@ } serveDeleteObject _ _ = left err500- serveLookupPatch _ _ _ = left err500+ serveLookupPatch _ _ _ _ = left err500 ----------------------------------------------------------------------------@@ -224,8 +241,8 @@ serveCreateRelease _ _ _ = left err500- serveLookupRelease _ _ _ = left err500- serveLookupLatestRelease _ _ = left err500+ serveLookupRelease _ _ _ _ = left err500+ serveLookupLatestRelease _ _ _ = left err500 serveChangeSecret _ _ = left err500