@@ -0,0 +1,215 @@
1+diff -ru orig/Git/S3.hs new/Git/S3.hs
2+--- orig/Git/S3.hs 2014-04-04 06:49:18.680668125 +0300
3++++ new/Git/S3.hs 2014-04-04 06:49:18.000000000 +0300
5+ -> ResourceT m (Response (ResponseMetadata a) a)
6+ awsRetry cfg svcfg mgr r =
7+ transResourceT liftIO $
8+- retrying def (isFailure . responseResult) $ aws cfg svcfg mgr r
9++ retrying def (isLeft . responseResult) $ aws cfg svcfg mgr r
11++ isLeft Left{} = True
12++ isLeft Right{} = False
14+ listBucketS3 :: MonadS3 m => OdbS3Details -> ResourceT m [Text]
15+ listBucketS3 dets = do
17+ ++ show (Prelude.length shas) ++ " objects"
20+-catalogPackFile :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
21++catalogPackFile :: (MonadS3 m, MonadThrow m)
22+ => OdbS3Details -> Text -> FilePath -> m [SHA]
23+ catalogPackFile dets packSha idxPath = do
24+ -- Load the pack file, and iterate over the objects within it to determine
26+ lgDebug $ "cacheUpdateEntry " ++ show (shaToText sha) ++ " " ++ show ce
27+ liftIO $ atomically $ modifyTVar (knownObjects dets) $ M.insert sha ce
29+-cacheLoadObject :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
30++cacheLoadObject :: (MonadS3 m, MonadThrow m)
31+ => OdbS3Details -> SHA -> CacheEntry -> Bool
32+ -> m (Maybe ObjectInfo)
33+ cacheLoadObject dets sha ce metadataOnly = do
35+ remoteStoreObject _ _ _ =
36+ throw (Git.BackendError "remoteStoreObject was not given any data")
38+-remoteCatalogContents :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
39++remoteCatalogContents :: (MonadS3 m, MonadThrow m)
40+ => OdbS3Details -> ResourceT m ()
41+ remoteCatalogContents dets = do
42+ lgDebug "remoteCatalogContents"
45+ | otherwise -> return ()
47+-accessObject :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
48++accessObject :: (MonadS3 m, MonadThrow m)
49+ => OdbS3Details -> SHA -> Bool -> m (Maybe CacheEntry)
50+ accessObject dets sha checkRemote = do
51+ mentry <- cacheLookupEntry dets sha
52+@@ -1000,19 +1003,19 @@
53+ -- cache and with the callback interface. This is to avoid recataloging
56+-objectExists :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
57++objectExists :: (MonadS3 m, MonadThrow m)
58+ => OdbS3Details -> SHA -> Bool -> m CacheEntry
59+ objectExists dets sha checkRemote = do
60+ mce <- accessObject dets sha checkRemote
61+ return $ fromMaybe DoesNotExist mce
63+-readObject :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
64++readObject :: (MonadS3 m, MonadThrow m)
65+ => OdbS3Details -> SHA -> Bool -> m (Maybe ObjectInfo)
66+ readObject dets sha metadataOnly = do
67+ ce <- objectExists dets sha True
68+ cacheLoadObject dets sha ce metadataOnly `orElse` return Nothing
70+-readObjectMetadata :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
71++readObjectMetadata :: (MonadS3 m, MonadThrow m)
72+ => OdbS3Details -> SHA -> m (Maybe ObjectInfo)
73+ readObjectMetadata dets sha = readObject dets sha True
76+ callbackRegisterObject dets sha info
77+ cacheStoreObject dets sha info
79+-writePackFile :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
80++writePackFile :: (MonadS3 m, MonadThrow m)
81+ => OdbS3Details -> BL.ByteString -> m ()
82+ writePackFile dets bytes = do
83+ let dir = tempDirectory dets
85+ shas <- catalogPackFile dets packSha idxPath
86+ callbackRegisterPackFile dets packSha shas
88+-readCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
89++readCallback :: (MonadS3 m, MonadThrow m)
94+ BU.unsafeUseAsCString chunk $ copyBytes p ?? len
95+ return $ p `plusPtr` len
97+-readPrefixCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
98++readPrefixCallback :: (MonadS3 m, MonadThrow m)
102+@@ -1108,7 +1111,7 @@
104+ | otherwise = return Nothing
106+-readHeaderCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
107++readHeaderCallback :: (MonadS3 m, MonadThrow m)
110+ -> Ptr C'git_odb_backend
111+@@ -1126,7 +1129,7 @@
112+ poke len_p (toLength len)
113+ poke type_p (toType typ)
115+-writeCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
116++writeCallback :: (MonadS3 m, MonadThrow m)
118+ -> Ptr C'git_odb_backend
120+@@ -1152,7 +1155,7 @@
121+ (ObjectInfo (fromLength len) (fromType obj_type)
122+ Nothing (Just (BL.fromChunks [bytes])))
124+-existsCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
125++existsCallback :: (MonadS3 m, MonadThrow m)
126+ => Ptr C'git_odb_backend -> Ptr C'git_oid -> CInt -> m CInt
127+ existsCallback be oid confirmNotExists = do
128+ (dets, sha) <- liftIO $ unpackDetails be oid
129+@@ -1162,18 +1165,18 @@
130+ return $ if ce == DoesNotExist then 0 else 1)
131+ (return c'GIT_ERROR)
133+-refreshCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
134++refreshCallback :: (MonadS3 m, MonadThrow m)
135+ => Ptr C'git_odb_backend -> m CInt
137+ return c'GIT_OK -- do nothing
139+-foreachCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
140++foreachCallback :: (MonadS3 m, MonadThrow m)
141+ => Ptr C'git_odb_backend -> C'git_odb_foreach_cb -> Ptr ()
143+ foreachCallback _be _callback _payload =
144+ return c'GIT_ERROR -- fallback to standard method
146+-writePackCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
147++writePackCallback :: (MonadS3 m, MonadThrow m)
148+ => Ptr (Ptr C'git_odb_writepack)
149+ -> Ptr C'git_odb_backend
150+ -> C'git_transfer_progress_callback
151+@@ -1214,7 +1217,7 @@
152+ foreign import ccall "&freeCallback"
153+ freeCallbackPtr :: FunPtr F'git_odb_backend_free_callback
155+-packAddCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
156++packAddCallback :: (MonadS3 m, MonadThrow m)
157+ => Ptr C'git_odb_writepack
160+@@ -1233,7 +1236,7 @@
161+ (castPtr dataPtr) (fromIntegral len)
162+ writePackFile dets (BL.fromChunks [bytes])
164+-packCommitCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
165++packCommitCallback :: (MonadS3 m, MonadThrow m)
166+ => Ptr C'git_odb_writepack -> Ptr C'git_transfer_progress
168+ packCommitCallback _wp _progress =
169+@@ -1346,7 +1349,7 @@
170+ liftIO $ writeIORef result res
173+-odbS3Backend :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
174++odbS3Backend :: (MonadS3 m, MonadThrow m)
175+ => Aws.S3Configuration NormalQuery
178+@@ -1439,7 +1442,7 @@
180+ -- | Given a repository object obtained from Libgit2, add an S3 backend to it,
181+ -- making it the primary store for objects associated with that repository.
182+-addS3Backend :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
183++addS3Backend :: (MonadS3 m, MonadThrow m)
187+@@ -1469,7 +1472,7 @@
188+ void $ liftIO $ odbBackendAdd repo odbS3 100
191+-s3Factory :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
192++s3Factory :: (MonadS3 m, MonadThrow m)
193+ => Maybe Text -> Text -> Text -> FilePath -> BackendCallbacks
194+ -> Git.RepositoryFactory (ReaderT LgRepo (NoLoggingT m)) m LgRepo
195+ s3Factory bucket accessKey secretKey dir callbacks = lgFactory
196+@@ -1492,7 +1495,7 @@
200+-s3FactoryLogger :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
201++s3FactoryLogger :: (MonadS3 m, MonadThrow m)
202+ => Maybe Text -> Text -> Text -> FilePath -> BackendCallbacks
203+ -> Git.RepositoryFactory (ReaderT LgRepo m) m LgRepo
204+ s3FactoryLogger bucket accessKey secretKey dir callbacks = lgFactoryLogger
205+diff -ru orig/gitlib-s3.cabal new/gitlib-s3.cabal
206+--- orig/gitlib-s3.cabal 2014-04-04 06:49:18.680668125 +0300
207++++ new/gitlib-s3.cabal 2014-04-04 06:49:18.000000000 +0300
210+ , bytestring >= 0.9.2.1
213+ , data-default >= 0.5.1
214+ , directory >= 1.1.0.2