Initial commit

Git/Blob.fs

@@ -0,0 +1,9 @@
+namespace Git
+
+[<RequireQualifiedAccess>]
+module Blob =
+    let create (content : byte array) =
+        {
+            Header = Header.Blob content.Length
+            Content = content
+        }

Git/Domain.fs

@@ -0,0 +1,3 @@
+namespace Git
+
+

Git/Git.fsproj

@@ -0,0 +1,20 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>netcoreapp3.1</TargetFramework>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="Domain.fs" />
+        <Compile Include="Header.fs" />
+        <Compile Include="Repository.fs" />
+        <Compile Include="Hash.fs" />
+        <Compile Include="Object.fs" />
+        <Compile Include="Blob.fs" />
+    </ItemGroup>
+
+    <ItemGroup>
+      <PackageReference Include="System.IO.Abstractions" Version="11.0.4" />
+    </ItemGroup>
+
+</Project>

Git/Hash.fs

@@ -0,0 +1,17 @@
+namespace Git
+
+open System.Text
+
+[<Struct>]
+type Hash = Hash of byte list
+
+[<RequireQualifiedAccess>]
+module Hash =
+
+    let ofBytes s = s |> Seq.toList |> Hash
+
+    let toString (Hash h) : string =
+        let t = StringBuilder (List.length h * 2)
+        h
+        |> List.iter (fun b -> t.AppendFormat ("{0:x2}" , b) |> ignore)
+        t.ToString ()

Git/Header.fs

@@ -0,0 +1,31 @@
+namespace Git
+
+open System
+
+type Header =
+    | Blob of int // length of content
+    // | Commit
+    // | Tree
+    // | Tag
+
+[<RequireQualifiedAccess>]
+module internal Header =
+
+    let toBytes (h : Header) : byte array =
+        match h with
+        | Header.Blob length ->
+            // TODO - internationalisation issue here
+            let s = sprintf "blob %i" length
+            [|
+                s.ToCharArray () |> Array.map byte
+                [| 0uy |]
+            |]
+            |> Array.concat
+
+    let ofBytes (s : byte array) : Header option =
+        if s.[0..3] = ("blob".ToCharArray () |> Array.map byte) then
+            let number = s.[5..] |> Array.map char |> String |> Int32.Parse
+            Header.Blob number
+            |> Some
+        else
+            None

Git/Object.fs

@@ -0,0 +1,86 @@
+namespace Git
+
+open System.IO
+open System.Security.Cryptography
+open System.IO.Compression
+
+type Object =
+    {
+        Header : Header
+        Content : byte array
+    }
+
+[<RequireQualifiedAccess>]
+module Object =
+    let hash (o : Object) : Hash =
+        use hasher = SHA1.Create ()
+        let content = Array.concat [| Header.toBytes o.Header ; o.Content |]
+
+        hasher.ComputeHash content
+        |> Hash.ofBytes
+
+    let private compress (o : Object) (dest : Stream) : unit =
+        let toWrite =
+            [| Header.toBytes o.Header ; o.Content |]
+            |> Array.concat
+
+        use ms = new MemoryStream(toWrite)
+        use ds = new DeflateStream(dest, CompressionMode.Compress)
+        ms.CopyTo ds
+
+    /// Read the header of the stream seeked to the beginning of the content.
+    let private consumeHeader (s : BinaryReader) : Header =
+        let rec bytes () : byte seq =
+            seq {
+                let newByte = s.Read ()
+                if newByte < 0 then failwith "ran out of bytes"
+                elif newByte > 0 then
+                    yield (byte newByte)
+                    yield! bytes ()
+                // stop reading the header at the 0 byte
+            }
+
+        match bytes () |> Seq.toArray |> Header.ofBytes with
+        | None ->
+            failwith "malformed header"
+        | Some b -> b
+
+    let private uncompress (s : Stream) : Object =
+        use ms = new MemoryStream ()
+        use ds = new DeflateStream(s, CompressionMode.Decompress)
+        ds.CopyTo ms
+        ms.Seek(0L, SeekOrigin.Begin) |> ignore
+
+        use r = new BinaryReader(ms)
+        let header = consumeHeader r
+        let expectedLength =
+            match header with
+            | Header.Blob i -> i
+        let result =
+            {
+                Header = header
+                Content = r.ReadBytes expectedLength
+            }
+        if r.PeekChar () <> -1 then failwith "unexpectedly not at end"
+        result
+
+    let write (r : Repository) (o : Object) : unit =
+        let hash = hash o |> Hash.toString
+        let objectName = hash.[2..]
+        let subdir = hash.[0..1]
+
+        let d = Repository.createSubdir (Repository.objectDir r) subdir
+        use filestream = r.Fs.File.Create (r.Fs.Path.Combine (d.FullName, objectName))
+
+        compress o filestream
+
+    let catFile (r : Repository) (hash : Hash) : Object =
+        let hash = hash |> Hash.toString
+        let objectName = hash.[2..]
+        let subdir = hash.[0..1]
+
+        use filestream =
+            r.Fs.Path.Combine ((Repository.objectDir r).FullName, subdir, objectName)
+            |> r.Fs.File.OpenRead
+
+        uncompress filestream

Git/Repository.fs

@@ -0,0 +1,49 @@
+namespace Git
+
+open System.IO.Abstractions
+
+/// If you have a Repository in scope, you know it existed at the time it was created.
+type Repository =
+    private
+        {
+            Directory : IDirectoryInfo
+        }
+    member this.Fs = this.Directory.FileSystem
+
+type InitFailure =
+    | DirectoryDoesNotExist
+    | AlreadyGit
+
+[<RequireQualifiedAccess>]
+module Repository =
+    let internal gitDir (r : Repository) : IDirectoryInfo =
+        r.Fs.Path.Combine(r.Directory.FullName, ".git") |> r.Fs.DirectoryInfo.FromDirectoryName
+
+    let internal objectDir (r : Repository) : IDirectoryInfo =
+        r.Fs.Path.Combine((gitDir r).FullName, "objects") |> r.Fs.DirectoryInfo.FromDirectoryName
+
+    let internal createSubdir (r : IDirectoryInfo) (name : string) : IDirectoryInfo =
+        let output =
+            r.FileSystem.Path.Combine(r.FullName, name)
+            |> r.FileSystem.DirectoryInfo.FromDirectoryName
+        output.Create ()
+        output
+
+    let init (dir : IDirectoryInfo) : Result<Repository, InitFailure> =
+        if not dir.Exists then Error DirectoryDoesNotExist
+        elif not <| Seq.isEmpty (dir.EnumerateDirectories ".git") then Error AlreadyGit
+        else
+
+        let r =
+            {
+                Directory = dir
+            }
+
+        let gitDir = createSubdir dir ".git"
+        let objectDir = createSubdir gitDir "objects"
+        let packDir = createSubdir objectDir "pack"
+        let infoDir = createSubdir objectDir "info"
+
+        r
+        |> Ok
+