gitlib-s3 (empty) → 0.2.1
raw patch · 5 files changed
+651/−0 lines, 5 filesdep +HUnitdep +attemptdep +awssetup-changed
Dependencies added: HUnit, attempt, aws, base, binary, bytestring, conduit, containers, gitlib, gitlib-s3, hlibgit2, http-conduit, lens, parallel-io, stringable, system-fileio, system-filepath, text, time, transformers, yaml
Files
- Data/Git/Backend/S3.hs +415/−0
- LICENSE +20/−0
- Setup.hs +2/−0
- gitlib-s3.cabal +65/−0
- test/Smoke.hs +149/−0
+ Data/Git/Backend/S3.hs view
@@ -0,0 +1,415 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Git.Backend.S3+ ( odbS3Backend+ , createS3backend+ , readRefs, writeRefs+ , mirrorRefsFromS3, mirrorRefsToS3 )+ where++import Aws+import Aws.Core+import Aws.S3 hiding (bucketName)+import Bindings.Libgit2.Odb+import Bindings.Libgit2.OdbBackend+import Bindings.Libgit2.Oid+import Bindings.Libgit2.Refs+import Bindings.Libgit2.Types+import Control.Applicative+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.Attempt+import Data.Binary+import Data.ByteString as B hiding (putStrLn)+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import Data.ByteString.Unsafe+import Data.Conduit+import Data.Conduit.Binary+import Data.Conduit.List hiding (mapM_, foldM, peek,+ catMaybes, sequence)+import Data.Git hiding (getObject)+import Data.Git.Backend+import Data.Git.Backend.Trace+import Data.Git.Error+import Data.Git.Oid+import Data.Int (Int64)+import qualified Data.List as L+import Data.Map+import Data.Maybe+import Data.Stringable+import Data.Text as T+import qualified Data.Text.Encoding as E+import qualified Data.Text.Lazy.Encoding as LE+import qualified Data.Yaml as Y+import Foreign.C.String+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.StablePtr+import Foreign.Storable+import Network.HTTP.Conduit hiding (Response)+import Prelude hiding (mapM_, catch)+import System.IO.Unsafe++default (Text)++data OdbS3Backend =+ OdbS3Backend { odbS3Parent :: C'git_odb_backend+ , httpManager :: StablePtr Manager+ , bucketName :: StablePtr Text+ , objectPrefix :: StablePtr Text+ , configuration :: StablePtr Configuration+ , s3configuration :: StablePtr (S3Configuration NormalQuery) }++instance Storable OdbS3Backend where+ sizeOf _ = sizeOf (undefined :: C'git_odb_backend) ++ sizeOf (undefined :: StablePtr Manager) ++ sizeOf (undefined :: StablePtr Text) ++ sizeOf (undefined :: StablePtr Text) ++ sizeOf (undefined :: StablePtr Configuration) ++ sizeOf (undefined :: StablePtr (S3Configuration NormalQuery))+ alignment _ = alignment (undefined :: Ptr C'git_odb_backend)+ peek p = do+ v0 <- peekByteOff p 0+ let sizev1 = sizeOf (undefined :: C'git_odb_backend)+ v1 <- peekByteOff p sizev1+ let sizev2 = sizev1 + sizeOf (undefined :: StablePtr Manager)+ v2 <- peekByteOff p sizev2+ let sizev3 = sizev2 + sizeOf (undefined :: StablePtr Text)+ v3 <- peekByteOff p sizev3+ let sizev4 = sizev3 + sizeOf (undefined :: StablePtr Text)+ v4 <- peekByteOff p sizev4+ let sizev5 = sizev4 + sizeOf (undefined :: StablePtr Configuration)+ v5 <- peekByteOff p sizev5+ return (OdbS3Backend v0 v1 v2 v3 v4 v5)+ poke p (OdbS3Backend v0 v1 v2 v3 v4 v5) = do+ pokeByteOff p 0 v0+ let sizev1 = sizeOf (undefined :: C'git_odb_backend)+ pokeByteOff p sizev1 v1+ let sizev2 = sizev1 + sizeOf (undefined :: StablePtr Manager)+ pokeByteOff p sizev2 v2+ let sizev3 = sizev2 + sizeOf (undefined :: StablePtr Text)+ pokeByteOff p sizev3 v3+ let sizev4 = sizev3 + sizeOf (undefined :: StablePtr Text)+ pokeByteOff p sizev4 v4+ let sizev5 = sizev4 + sizeOf (undefined :: StablePtr Configuration)+ pokeByteOff p sizev5 v5+ return ()++odbS3dispatch ::+ MonadIO m =>+ (Manager -> Text -> Text+ -> Configuration -> S3Configuration NormalQuery -> a -> m b)+ -> OdbS3Backend -> a -> m b+odbS3dispatch f odbS3 arg = do+ manager <- liftIO $ deRefStablePtr (httpManager odbS3)+ bucket <- liftIO $ deRefStablePtr (bucketName odbS3)+ prefix <- liftIO $ deRefStablePtr (objectPrefix odbS3)+ config <- liftIO $ deRefStablePtr (configuration odbS3)+ s3config <- liftIO $ deRefStablePtr (s3configuration odbS3)+ f manager bucket prefix config s3config arg++testFileS3' :: Manager -> Text -> Text+ -> Configuration -> S3Configuration NormalQuery+ -> Text+ -> ResourceT IO Bool+testFileS3' manager bucket prefix config s3config filepath =+ isJust . readResponse <$>+ aws config s3config manager+ (headObject bucket (T.append prefix filepath))++testFileS3 :: OdbS3Backend -> Text -> ResourceT IO Bool+testFileS3 = odbS3dispatch testFileS3'++getFileS3' :: Manager -> Text -> Text+ -> Configuration -> S3Configuration NormalQuery+ -> (Text, Maybe (Int,Int))+ -> ResourceT IO (ResumableSource (ResourceT IO) ByteString)+getFileS3' manager bucket prefix config s3config (filepath,range) = do+ res <- aws config s3config manager+ (getObject bucket (T.append prefix filepath))+ { goResponseContentRange = range }+ gor <- readResponseIO res+ return (responseBody (gorResponse gor))++getFileS3 :: OdbS3Backend -> Text -> Maybe (Int,Int)+ -> ResourceT IO (ResumableSource (ResourceT IO) ByteString)+getFileS3 = curry . odbS3dispatch getFileS3'++putFileS3' :: Manager -> Text -> Text+ -> Configuration -> S3Configuration NormalQuery+ -> (Text, Source (ResourceT IO) ByteString)+ -> ResourceT IO BL.ByteString+putFileS3' manager bucket prefix config s3config (filepath,src) = do+ lbs <- BL.fromChunks <$> (src $$ consume)+ res <- aws config s3config manager+ (putObject bucket (T.append prefix filepath)+ (RequestBodyLBS lbs))+ _ <- readResponseIO res+ return lbs++putFileS3 :: OdbS3Backend -> Text -> Source (ResourceT IO) ByteString+ -> ResourceT IO BL.ByteString+putFileS3 = curry . odbS3dispatch putFileS3'++type RefMap = Map Text (Either Text Oid)++instance Y.FromJSON Oid where+ parseJSON (Y.String v) =+ return . Oid . COid $ unsafePerformIO $ do+ ptr <- mallocForeignPtr+ withCStringable v $ \cstr ->+ withForeignPtr ptr $ \ptr' -> do+ r <- c'git_oid_fromstr ptr' cstr+ when (r < 0) $ throwIO OidCopyFailed+ return ptr++coidToJSON :: ForeignPtr C'git_oid -> Y.Value+coidToJSON coid = unsafePerformIO $ withForeignPtr coid $ \oid ->+ Y.toJSON <$> oidToStr oid++instance Y.ToJSON Oid where+ toJSON (PartialOid (COid coid) _) = throw RefCannotCreateFromPartialOid+ toJSON (Oid (COid coid)) = coidToJSON coid++readRefs :: Ptr C'git_odb_backend -> IO (Maybe RefMap)+readRefs be = do+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ exists <- catch (runResourceT $ testFileS3 odbS3 "refs.yml")+ (\e -> print (e :: IOException) >> throwIO e)+ if exists+ then do+ bytes <- catch (runResourceT $ do+ result <- getFileS3 odbS3 "refs.yml" Nothing+ result $$+- await)+ (\e -> print (e :: IOException) >> throwIO e)+ case bytes of+ Nothing -> return Nothing+ Just bytes' -> return (Y.decode bytes' :: Maybe RefMap)++ else return Nothing++writeRefs :: Ptr C'git_odb_backend -> RefMap -> IO ()+writeRefs be refs = do+ let payload = Y.encode refs+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ void $ runResourceT $+ putFileS3 odbS3 "refs.yml" (sourceLbs (BL.fromChunks [payload]))++mirrorRefsFromS3 :: Ptr C'git_odb_backend -> Repository -> IO ()+mirrorRefsFromS3 be repo = do+ refs <- readRefs be+ case refs of+ Nothing -> return ()+ Just refs' ->+ forM_ (toList refs') $ \(name, ref) ->+ withForeignPtr (repositoryPtr repo) $ \repoPtr ->+ withCStringable name $ \namePtr -> alloca $ \ptr -> do+ r <- case ref of+ Left target ->+ withCStringable target $ \targetPtr ->+ c'git_reference_create_symbolic ptr repoPtr namePtr+ targetPtr 1+ Right (PartialOid {}) ->+ throwIO RefCannotCreateFromPartialOid+ Right (Oid (COid coid)) ->+ withForeignPtr coid $ \coidPtr ->+ c'git_reference_create_oid ptr repoPtr namePtr coidPtr 1+ when (r < 0) $ throwIO RepositoryInvalid++mirrorRefsToS3 :: Ptr C'git_odb_backend -> Repository -> IO ()+mirrorRefsToS3 be repo = do+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ refs <- catMaybes <$>+ mapAllRefs repo (\name -> do ref <- lookupRef repo name+ return (go name <$> ref))+ writeRefs be (fromList refs)+ where go name ref =+ case refTarget ref of+ RefTargetSymbolic target -> (name, Left target)+ RefTargetId oid -> (name, Right oid)++mapPair :: (a -> b) -> (a,a) -> (b,b)+mapPair f (x,y) = (f x, f y)++odbS3BackendReadCallback :: F'git_odb_backend_read_callback+odbS3BackendReadCallback data_p len_p type_p be oid =+ catch go (\e -> print (e :: IOException) >> return (-1))+ where+ go = do+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ oidStr <- oidToStr oid+ blocks <- runResourceT $ do+ result <- getFileS3 odbS3 (T.pack oidStr) Nothing+ result $$+- consume+ case blocks of+ [] -> return (-1)+ bs -> do+ let hdrLen = sizeOf (undefined :: Int64) * 2+ (len,typ) =+ mapPair fromIntegral $+ (decode (BL.fromChunks [L.head bs]) :: (Int64,Int64))+ content <- mallocBytes len+ foldM (\offset x -> do+ let xOffset = if offset == 0 then hdrLen else 0+ innerLen = B.length x - xOffset+ unsafeUseAsCString x $ \cstr ->+ copyBytes (content `plusPtr` offset)+ (cstr `plusPtr` xOffset) innerLen+ return (offset + innerLen)) 0 bs+ poke len_p (fromIntegral len)+ poke type_p (fromIntegral typ)+ poke data_p (castPtr content)+ return 0++odbS3BackendReadPrefixCallback :: F'git_odb_backend_read_prefix_callback+odbS3BackendReadPrefixCallback out_oid oid_p len_p type_p be oid len =+ return 0++odbS3BackendReadHeaderCallback :: F'git_odb_backend_read_header_callback+odbS3BackendReadHeaderCallback len_p type_p be oid =+ catch go (\e -> print (e :: IOException) >> return (-1))+ where+ go = do+ let hdrLen = sizeOf (undefined :: Int64) * 2+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ oidStr <- oidToStr oid+ bytes <- runResourceT $ do+ result <- getFileS3 odbS3 (T.pack oidStr) (Just (0,hdrLen - 1))+ result $$+- await+ case bytes of+ Nothing -> return (-1)+ Just bs -> do+ let (len,typ) = decode (BL.fromChunks [bs]) :: (Int64,Int64)+ poke len_p (fromIntegral len)+ poke type_p (fromIntegral typ)+ return 0++odbS3BackendWriteCallback :: F'git_odb_backend_write_callback+odbS3BackendWriteCallback oid be obj_data len obj_type = do+ r <- c'git_odb_hash oid obj_data len obj_type+ case r of+ 0 -> do+ oidStr <- oidToStr oid+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ let hdr = encode ((fromIntegral len,+ fromIntegral obj_type) :: (Int64,Int64))+ bytes <- curry unsafePackCStringLen+ (castPtr obj_data) (fromIntegral len)+ let payload = BL.append hdr (BL.fromChunks [bytes])+ catch (go odbS3 oidStr payload >> return 0)+ (\e -> print (e :: IOException) >> return (-1))+ n -> return n+ where+ go odbS3 oidStr payload =+ runResourceT $ putFileS3 odbS3 (T.pack oidStr) (sourceLbs payload)++odbS3BackendExistsCallback :: F'git_odb_backend_exists_callback+odbS3BackendExistsCallback be oid = do+ oidStr <- oidToStr oid+ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ exists <- catch (runResourceT $ testFileS3 odbS3 (T.pack oidStr))+ (\e -> print (e :: IOException) >> return False)+ return $ if exists then 1 else 0++odbS3BackendFreeCallback :: F'git_odb_backend_free_callback+odbS3BackendFreeCallback be = do+ backend <- peek be+ freeHaskellFunPtr (c'git_odb_backend'read backend)+ freeHaskellFunPtr (c'git_odb_backend'read_prefix backend)+ freeHaskellFunPtr (c'git_odb_backend'read_header backend)+ freeHaskellFunPtr (c'git_odb_backend'write backend)+ freeHaskellFunPtr (c'git_odb_backend'exists backend)++ odbS3 <- peek (castPtr be :: Ptr OdbS3Backend)+ freeStablePtr (httpManager odbS3)+ freeStablePtr (bucketName odbS3)+ freeStablePtr (objectPrefix odbS3)+ freeStablePtr (configuration odbS3)+ freeStablePtr (s3configuration odbS3)++foreign export ccall "odbS3BackendFreeCallback"+ odbS3BackendFreeCallback :: F'git_odb_backend_free_callback+foreign import ccall "&odbS3BackendFreeCallback"+ odbS3BackendFreeCallbackPtr :: FunPtr F'git_odb_backend_free_callback++odbS3Backend :: S3Configuration NormalQuery+ -> Configuration+ -> Manager -> Text -> Text+ -> IO (Ptr C'git_odb_backend)+odbS3Backend s3config config manager bucket prefix = do+ readFun <- mk'git_odb_backend_read_callback odbS3BackendReadCallback+ readPrefixFun <-+ mk'git_odb_backend_read_prefix_callback odbS3BackendReadPrefixCallback+ readHeaderFun <-+ mk'git_odb_backend_read_header_callback odbS3BackendReadHeaderCallback+ writeFun <- mk'git_odb_backend_write_callback odbS3BackendWriteCallback+ existsFun <- mk'git_odb_backend_exists_callback odbS3BackendExistsCallback++ manager' <- newStablePtr manager+ bucket' <- newStablePtr bucket+ prefix' <- newStablePtr prefix+ s3config' <- newStablePtr s3config+ config' <- newStablePtr config++ castPtr <$> new OdbS3Backend {+ odbS3Parent = C'git_odb_backend {+ c'git_odb_backend'odb = nullPtr+ , c'git_odb_backend'read = readFun+ , c'git_odb_backend'read_prefix = readPrefixFun+ , c'git_odb_backend'readstream = nullFunPtr+ , c'git_odb_backend'read_header = readHeaderFun+ , c'git_odb_backend'write = writeFun+ , c'git_odb_backend'writestream = nullFunPtr+ , c'git_odb_backend'exists = existsFun+ , c'git_odb_backend'free = odbS3BackendFreeCallbackPtr }+ , httpManager = manager'+ , bucketName = bucket'+ , objectPrefix = prefix'+ , configuration = config'+ , s3configuration = s3config' }++createS3backend :: Text -- ^ bucket+ -> Text -- ^ prefix+ -> Text -- ^ access key+ -> Text -- ^ secret key+ -> Maybe Manager+ -> Maybe Text -- ^ mock address+ -> LogLevel+ -> Bool -- ^ tracing?+ -> Repository+ -> IO Repository+createS3backend bucket prefix access secret mmanager mockAddr level tracing repo = do+ manager <- maybe (newManager def) return mmanager+ odbS3 <-+ odbS3Backend+ (case mockAddr of+ Nothing -> defServiceConfig+ Just addr -> (s3 HTTP (E.encodeUtf8 addr) False) {+ s3Port = 10001+ , s3RequestStyle = PathStyle })+ (Configuration Timestamp Credentials {+ accessKeyID = E.encodeUtf8 access+ , secretAccessKey = E.encodeUtf8 secret }+ (defaultLog level))+ manager bucket prefix++ if tracing+ then do backend <- traceBackend odbS3+ odbBackendAdd repo backend 100+ else odbBackendAdd repo odbS3 100++ -- Start by reading in the known refs from S3+ mirrorRefsFromS3 odbS3 repo++ -- Whenever a ref is written, update the refs in S3+ let onWrite = const $ mirrorRefsToS3 odbS3 repo+ return repo { repoOnWriteRef = onWrite : repoOnWriteRef repo }++-- S3.hs
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2012 John Wiegley+Copyright (c) 2011 Sakari Jokinen, Jacob Stanley++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gitlib-s3.cabal view
@@ -0,0 +1,65 @@+Name: gitlib-s3+Version: 0.2.1+Synopsis: A repository backend for storing Git objects in Amazon S3+Description: A repository backend for storing Git objects in Amazon S3.+License-file: LICENSE+License: MIT+Author: John Wiegley+Maintainer: johnw@fpcomplete.com+Build-Type: Simple+Cabal-Version: >=1.10+Category: Git++Source-repository head+ type: git+ location: git://github.com/fpco/gitlib.git++Library+ hs-source-dirs: .+ default-language: Haskell98+ build-depends:+ base >= 3 && < 5+ , gitlib+ , hlibgit2 >= 0.17+ , HUnit >= 1.2.5+ , bytestring >= 0.9.2.1+ , containers >= 0.4.2+ , transformers >= 0.2.2+ , lens >= 2.8+ , attempt >= 0.4.0+ , parallel-io >= 0.3.2.1+ , stringable >= 0.1.1+ , system-fileio >= 0.3.9+ , system-filepath >= 0.4.7+ , text >= 0.11.2+ , time >= 1.4+ , aws >= 0.7.5+ , conduit >= 0.5.5+ , http-conduit >= 1.8.5.1+ , binary >= 0.5.1.0+ , yaml >= 0.8.1.1+ exposed-modules:+ Data.Git.Backend.S3++Test-suite smoke+ default-language: Haskell98+ type: exitcode-stdio-1.0+ main-is: Smoke.hs+ hs-source-dirs: test+ build-depends:+ base >=3+ , gitlib-s3+ , gitlib+ , hlibgit2 >= 0.17+ , aws >= 0.7.5+ , HUnit >= 1.2.5+ , bytestring >= 0.9.2.1+ , containers >= 0.4.2+ , lens >= 2.8+ , http-conduit >= 1.8.5.1+ , parallel-io >= 0.3.2.1+ , stringable >= 0.1.1+ , system-fileio >= 0.3.9+ , system-filepath >= 0.4.7+ , text >= 0.11.2+ , time >= 1.4
+ test/Smoke.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# OPTIONS_GHC -fno-warn-wrong-do-bind #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Main where++import Aws+import Aws.Core+import Aws.S3 hiding (bucketName)+import Control.Applicative+import Control.Concurrent.ParallelIO+import Control.Monad+import Data.Git+import Data.Git.Backend+import Data.Git.Backend.S3+import Data.Git.Backend.Trace+import Data.Map+import Data.Maybe+import Data.Text as T hiding (map)+import qualified Data.Text.Encoding as E+import Data.Time.Clock.POSIX+import Data.Traversable+import Filesystem (removeTree, isDirectory)+import Filesystem.Path.CurrentOS+import Network.HTTP.Conduit+import qualified Prelude+import Prelude (putStrLn)+import Prelude hiding (FilePath, putStr, putStrLn)+import System.Environment+import System.Exit+import Test.HUnit++default (Text)++main :: IO ()+main = do+ counts' <- runTestTT tests+ case counts' of+ Counts _ _ errors' failures' ->+ if errors' > 0 || failures' > 0+ then exitFailure+ else exitSuccess+ stopGlobalPool++catBlob :: Repository -> Text -> IO (Maybe Text)+catBlob repo sha = do+ hash <- parseOid sha+ for hash $ \hash' -> do+ obj <- lookupObject repo hash'+ case obj of+ Just (BlobObj b) -> do+ (_, contents) <- getBlobContents b+ str <- blobSourceToString contents+ case str of+ Nothing -> return T.empty+ Just str' -> return (E.decodeUtf8 str')++ Just _ -> error "Found something else..."+ Nothing -> error "Didn't find anything :("++withRepository :: Text -> (Repository -> Assertion) -> Assertion+withRepository n f = do+ let p = fromText n+ exists <- isDirectory p+ when exists $ removeTree p++ -- we want exceptions to leave the repo behind+ f =<< createRepository p True++ removeTree p++oid :: Updatable a => a -> IO Text+oid = objectId >=> return . oidToText++oidToText :: Oid -> Text+oidToText = T.pack . show++sampleCommit :: Repository -> Tree -> Signature -> Commit+sampleCommit repo tr sig =+ (createCommit repo sig) { commitTree = ObjRef tr+ , commitLog = "Sample log message." }++tests :: Test+tests = test [++ "createTwoCommits" ~:++ withRepository "createTwoCommits.git" $ \repo' -> do+ -- Store Git objects in S3+ s3Bucket <- T.pack <$> getEnv "S3_BUCKET"+ awsAccessKey <- T.pack <$> getEnv "AWS_ACCESS_KEY"+ awsSecretKey <- T.pack <$> getEnv "AWS_SECRET_KEY"+ repo <- createS3backend s3Bucket "" awsAccessKey awsSecretKey+ Nothing Nothing Error True repo'++ let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")+ tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)++ let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")+ tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)+ x <- oid tr+ x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"++ -- The Oid has been cleared in tr, so this tests that it gets written as+ -- needed.+ let sig = Signature {+ signatureName = "John Wiegley"+ , signatureEmail = "johnw@newartisans.com"+ , signatureWhen = posixSecondsToUTCTime 1348980883 }+ c = sampleCommit repo tr sig+ x <- oid c+ x @?= "44381a5e564d19893d783a5d5c59f9c745155b56"++ let goodbye2 = createBlob repo (E.encodeUtf8 "Goodbye, world again!\n")+ tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye2)+ x <- oid tr+ x @?= "f2b42168651a45a4b7ce98464f09c7ec7c06d706"++ let sig = Signature {+ signatureName = "John Wiegley"+ , signatureEmail = "johnw@newartisans.com"+ , signatureWhen = posixSecondsToUTCTime 1348981883 }+ c2 = (sampleCommit repo tr sig) {+ commitLog = "Second sample log message."+ , commitParents = [ObjRef c] }+ x <- oid c2+ x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603"++ putStrLn "Refs before creation..."+ mapAllRefs repo (\name -> Prelude.putStrLn $ "Ref: " ++ unpack name)+ putStrLn "Refs before creation...done"++ cid <- objectId c2+ writeRef $ createRef repo "refs/heads/master" (RefTargetId cid)+ writeRef $ createRef repo "HEAD" (RefTargetSymbolic "refs/heads/master")++ x <- fmap oidToText <$> resolveRef repo "refs/heads/master"+ x @?= Just "2506e7fcc2dbfe4c083e2bd741871e2e14126603"++ putStrLn "Refs after creation..."+ mapAllRefs repo (\name -> Prelude.putStrLn $ "Ref: " ++ unpack name)+ putStrLn "Refs after creation...done"++ return()++ ]++-- Main.hs ends here