cas-hashable-s3 (empty) → 1.0.0

raw patch · 4 files changed

+168/−0 lines, 4 filesdep +aesondep +awsdep +base

Dependencies added: aeson, aws, base, cas-hashable, constraints, http-conduit, reflection, resourcet

Files

• LICENSE +21/−0
• cas-hashable-s3.cabal +34/−0
• changelog.md +0/−0
• src/Data/CAS/ContentHashable/S3.hs +113/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Tweag I/O++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.

@@ -0,0 +1,34 @@+Name:                cas-hashable-s3+Version:             1.0.0+Synopsis:            ContentHashable instances for S3 objects+Description:+            Provides ContentHashable instances for S3 objects+License:             MIT+License-file:        LICENSE+Author:              Tom Nielsen, Nicholas Clarke, Andreas Herrmann+Maintainer:          yves.pares@tweag.io+build-type:          Simple+Cabal-Version:       >= 1.10+homepage:            https://github.com/tweag/funflow+bug-reports:         https://github.com/tweag/funflow+category:            Control+Tested-With:         GHC == 7.8.4, GHC == 7.10.2, GHC == 7.10.3, GHC == 8.0.1++extra-source-files:+                   changelog.md++Library+   ghc-options:       -Wall -fno-warn-type-defaults+   hs-source-dirs:    src+   default-language:  Haskell2010++   Exposed-modules:  Data.CAS.ContentHashable.S3+   Build-depends:+                 base                    >= 4.6 && <5+               , aeson+               , aws+               , cas-hashable            >= 1.0.0 && < 2+               , constraints+               , http-conduit+               , reflection+               , resourcet

@@ -0,0 +1,113 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeOperators         #-}++-- | Hashing of S3 objects+--+--   This module allows us to fetch objects from S3, taking advantage of S3's+--   support for CAS to avoid the need to calculate our own content hashes.+module Data.CAS.ContentHashable.S3 where++import qualified Aws+import qualified Aws.S3                          as S3+import           Control.Monad                   ((>=>))+import           Control.Monad.Trans.Resource    (runResourceT)+import           Data.Aeson+import           Data.CAS.ContentHashable+import           Data.Constraint+import           Data.Reflection+import           GHC.Generics                    (Generic)+import           Network.HTTP.Conduit            (newManager,+                                                  tlsManagerSettings)++-- | Reference to an object in an S3 bucket+--+--   Objects can be referenced in a few ways, so this+--   type is parametrised over the object reference.+--   Currently, this is expected to be:+--   - S3.Object (alias for Text)+--   - S3.ObjectInfo+data ObjectInBucket obj = ObjectInBucket+  { _oibBucket :: S3.Bucket+  , _oibObject :: obj+  } deriving (Show, Generic)++-- | A lens to _oibBucket+oibBucket :: Functor f => (S3.Bucket -> f S3.Bucket) -> ObjectInBucket obj -> f (ObjectInBucket obj)+oibBucket f oib = rebuild <$> f (_oibBucket oib)+  where rebuild b = oib{_oibBucket=b}++-- | A lens to _oibObject+oibObject :: Functor f => (a -> f b) -> ObjectInBucket a -> f (ObjectInBucket b)+oibObject f oib = rebuild <$> f (_oibObject oib)+  where rebuild o = oib{_oibObject=o}++instance FromJSON (ObjectInBucket S3.Object)+instance ToJSON (ObjectInBucket S3.Object)++class ObjectReference a where+  objectReference :: a -> S3.Object++instance ObjectReference S3.Object where+  objectReference = id++instance ObjectReference S3.ObjectInfo where+  objectReference = S3.objectKey++-- | An S3 object is hashable whenever we have sufficient configuration to+--   access said object. To deal with this, we use reflection to reify a value+--   (the AWS configuration) into a class constraint.+--   To use this instance, you must reify the value using 'give':+--   @+--     cfg <- Aws.baseConfiguration+--     give cfg $ contentHash s3object+--   @+--+--   Since S3 is already content hashed, we do not need to actually hash the+--   object ourselves. In fact, we avoid fetching the object, and only+--   request the metadata including the content hash.+--   We incorporate the bucket and name into this to give extra guarantees on+--   uniqueness, but we may be better abolishing this to deduplicate files+--   stored in multiple places.+instance (Given Aws.Configuration)+  => ContentHashable IO (ObjectInBucket S3.Object) where+  contentHashUpdate ctx a = let+      s3cfg = Aws.defServiceConfig :: S3.S3Configuration Aws.NormalQuery+    in do+      {- Set up a ResourceT region with an available HTTP manager. -}+      mgr <- newManager tlsManagerSettings++      {- Create a request object with S3.getObject and run the request with pureAws. -}+      S3.GetObjectResponse { S3.gorMetadata = md } <- runResourceT $+        Aws.pureAws given s3cfg mgr $+          S3.getObject (_oibBucket a) (_oibObject a)++      flip contentHashUpdate (_oibBucket a)+        >=> flip contentHashUpdate (_oibObject a)+        >=> flip contentHashUpdate (S3.omETag md)+          $ ctx++-- | Reified instance of the implication to allow us to use this as a+--   constraint.+instance (Given Aws.Configuration)+         :=> ContentHashable IO (ObjectInBucket S3.Object) where+  ins = Sub Dict++-- | When we already have `ObjectInfo` (because we have, for example, queried+--   the bucket), we can calculate the 'ContentHash' directly without recourse+--   do S3, because we already know the S3 hash.+instance Monad m => ContentHashable m (ObjectInBucket S3.ObjectInfo) where+  contentHashUpdate ctx a =+    flip contentHashUpdate (_oibBucket a)+      >=> flip contentHashUpdate (S3.objectKey $ _oibObject a)+      >=> flip contentHashUpdate (S3.objectETag $ _oibObject a)+        $ ctx++-- | Reified instance of the implication to allow us to use this as a+--   constraint.+instance (Given Aws.Configuration)+         :=> ContentHashable IO (ObjectInBucket S3.ObjectInfo) where+  ins = Sub Dict