diff --git a/Data/Git/Backend/S3.hs b/Data/Git/Backend/S3.hs new file mode 100644 --- /dev/null +++ b/Data/Git/Backend/S3.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/gitlib-s3.cabal b/gitlib-s3.cabal new file mode 100644 --- /dev/null +++ b/gitlib-s3.cabal @@ -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 diff --git a/test/Smoke.hs b/test/Smoke.hs new file mode 100644 --- /dev/null +++ b/test/Smoke.hs @@ -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