@@ -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
4+@@ -467,7 +467,10 @@
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
10++ where
11++ isLeft Left{} = True
12++ isLeft Right{} = False
13+
14+ listBucketS3 :: MonadS3 m => OdbS3Details -> ResourceT m [Text]
15+ listBucketS3 dets = do
16+@@ -623,7 +626,7 @@
17+ ++ show (Prelude.length shas) ++ " objects"
18+ return shas
19+
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
25+@@ -687,7 +690,7 @@
26+ lgDebug $ "cacheUpdateEntry " ++ show (shaToText sha) ++ " " ++ show ce
27+ liftIO $ atomically $ modifyTVar (knownObjects dets) $ M.insert sha ce
28+
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
34+@@ -931,7 +934,7 @@
35+ remoteStoreObject _ _ _ =
36+ throw (Git.BackendError "remoteStoreObject was not given any data")
37+
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"
43+@@ -955,7 +958,7 @@
44+
45+ | otherwise -> return ()
46+
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
54+ -- in the future.
55+
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
62+
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
69+
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
74+
75+@@ -1022,7 +1025,7 @@
76+ callbackRegisterObject dets sha info
77+ cacheStoreObject dets sha info
78+
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
84+@@ -1041,7 +1044,7 @@
85+ shas <- catalogPackFile dets packSha idxPath
86+ callbackRegisterPackFile dets packSha shas
87+
88+-readCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
89++readCallback :: (MonadS3 m, MonadThrow m)
90+ => Ptr (Ptr ())
91+ -> Ptr CSize
92+ -> Ptr C'git_otype
93+@@ -1072,7 +1075,7 @@
94+ BU.unsafeUseAsCString chunk $ copyBytes p ?? len
95+ return $ p `plusPtr` len
96+
97+-readPrefixCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
98++readPrefixCallback :: (MonadS3 m, MonadThrow m)
99+ => Ptr C'git_oid
100+ -> Ptr (Ptr ())
101+ -> Ptr CSize
102+@@ -1108,7 +1111,7 @@
103+ go dets sha False
104+ | otherwise = return Nothing
105+
106+-readHeaderCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
107++readHeaderCallback :: (MonadS3 m, MonadThrow m)
108+ => Ptr CSize
109+ -> Ptr C'git_otype
110+ -> Ptr C'git_odb_backend
111+@@ -1126,7 +1129,7 @@
112+ poke len_p (toLength len)
113+ poke type_p (toType typ)
114+
115+-writeCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
116++writeCallback :: (MonadS3 m, MonadThrow m)
117+ => Ptr C'git_oid
118+ -> Ptr C'git_odb_backend
119+ -> Ptr ()
120+@@ -1152,7 +1155,7 @@
121+ (ObjectInfo (fromLength len) (fromType obj_type)
122+ Nothing (Just (BL.fromChunks [bytes])))
123+
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)
132+
133+-refreshCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
134++refreshCallback :: (MonadS3 m, MonadThrow m)
135+ => Ptr C'git_odb_backend -> m CInt
136+ refreshCallback _ =
137+ return c'GIT_OK -- do nothing
138+
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 ()
142+ -> m CInt
143+ foreachCallback _be _callback _payload =
144+ return c'GIT_ERROR -- fallback to standard method
145+
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
154+
155+-packAddCallback :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
156++packAddCallback :: (MonadS3 m, MonadThrow m)
157+ => Ptr C'git_odb_writepack
158+ -> Ptr ()
159+ -> CSize
160+@@ -1233,7 +1236,7 @@
161+ (castPtr dataPtr) (fromIntegral len)
162+ writePackFile dets (BL.fromChunks [bytes])
163+
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
167+ -> m CInt
168+ packCommitCallback _wp _progress =
169+@@ -1346,7 +1349,7 @@
170+ liftIO $ writeIORef result res
171+ readIORef result
172+
173+-odbS3Backend :: (MonadS3 m, MonadUnsafeIO m, MonadThrow m)
174++odbS3Backend :: (MonadS3 m, MonadThrow m)
175+ => Aws.S3Configuration NormalQuery
176+ -> Configuration
177+ -> Manager
178+@@ -1439,7 +1442,7 @@
179+
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)
184+ => LgRepo
185+ -> Text -- ^ bucket
186+ -> Text -- ^ prefix
187+@@ -1469,7 +1472,7 @@
188+ void $ liftIO $ odbBackendAdd repo odbS3 100
189+ return repo
190+
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 @@
197+ dir
198+ callbacks
199+
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
208+@@ -58,6 +58,7 @@
209+ , binary >= 0.5.1.0
210+ , bytestring >= 0.9.2.1
211+ , conduit >= 0.5.5
212++ , conduit-extra
213+ , data-default >= 0.5.1
214+ , directory >= 1.1.0.2
215+ , filepath >= 1.3.0