an atproto pds written in F# (.NET 9) 馃
desertthunder.dev
pds
fsharp
giraffe
dotnet
atproto
1namespace PDSharp.Core
2
3open System.IO
4open Amazon.S3
5open Amazon.S3.Model
6open PDSharp.Core.Config
7
8/// Interface for binary large object (blob) storage
9type IBlobStore =
10 /// Store a blob by CID
11 abstract member Put : Cid * byte[] -> Async<unit>
12 /// Retrieve a blob by CID
13 abstract member Get : Cid -> Async<byte[] option>
14 /// Check if a blob exists (optional optimization)
15 abstract member Has : Cid -> Async<bool>
16 /// Delete a blob by CID
17 abstract member Delete : Cid -> Async<unit>
18
19module BlobStore =
20
21 /// File-system based blob store
22 type DiskBlobStore(encodedRootPath : string) =
23 let rootPath =
24 if Path.IsPathRooted encodedRootPath then
25 encodedRootPath
26 else
27 Path.Combine(Directory.GetCurrentDirectory(), encodedRootPath)
28
29 do
30 if not (Directory.Exists rootPath) then
31 Directory.CreateDirectory(rootPath) |> ignore
32
33 let getPath (cid : Cid) = Path.Combine(rootPath, cid.ToString())
34
35 interface IBlobStore with
36 member _.Put(cid, data) = async {
37 let path = getPath cid
38
39 if not (File.Exists path) then
40 do! File.WriteAllBytesAsync(path, data) |> Async.AwaitTask
41 }
42
43 member _.Get(cid) = async {
44 let path = getPath cid
45
46 if File.Exists path then
47 let! data = File.ReadAllBytesAsync(path) |> Async.AwaitTask
48 return Some data
49 else
50 return None
51 }
52
53 member _.Has(cid) = async { return File.Exists(getPath cid) }
54
55 member _.Delete(cid) = async {
56 let path = getPath cid
57
58 if File.Exists path then
59 File.Delete path
60 }
61
62 /// S3-based blob store
63 type S3BlobStore(config : S3Config) =
64 let client =
65 let clientConfig =
66 AmazonS3Config(RegionEndpoint = Amazon.RegionEndpoint.GetBySystemName config.Region)
67
68 match config.ServiceUrl with
69 | Some url -> clientConfig.ServiceURL <- url
70 | None -> ()
71
72 clientConfig.ForcePathStyle <- config.ForcePathStyle
73
74 match config.AccessKey, config.SecretKey with
75 | Some access, Some secret -> new AmazonS3Client(access, secret, clientConfig)
76 | _ -> new AmazonS3Client(clientConfig)
77
78 let bucket = config.Bucket
79
80 interface IBlobStore with
81 member _.Put(cid, data) = async {
82 let request = PutObjectRequest()
83 request.BucketName <- bucket
84 request.Key <- cid.ToString()
85 use ms = new MemoryStream(data)
86 request.InputStream <- ms
87 let! _ = client.PutObjectAsync(request) |> Async.AwaitTask
88 ()
89 }
90
91 member _.Get(cid) = async {
92 try
93 let request = GetObjectRequest()
94 request.BucketName <- bucket
95 request.Key <- cid.ToString()
96
97 use! response = client.GetObjectAsync(request) |> Async.AwaitTask
98 use ms = new MemoryStream()
99 do! response.ResponseStream.CopyToAsync(ms) |> Async.AwaitTask
100 return Some(ms.ToArray())
101 with
102 | :? AmazonS3Exception as ex when ex.StatusCode = System.Net.HttpStatusCode.NotFound -> return None
103 | _ -> return None
104 }
105
106 member _.Has(cid) = async {
107 try
108 let request = GetObjectMetadataRequest()
109 request.BucketName <- bucket
110 request.Key <- cid.ToString()
111 let! _ = client.GetObjectMetadataAsync(request) |> Async.AwaitTask
112 return true
113 with
114 | :? AmazonS3Exception as ex when ex.StatusCode = System.Net.HttpStatusCode.NotFound -> return false
115 | _ -> return false
116 }
117
118 member _.Delete(cid) = async {
119 let request = DeleteObjectRequest()
120 request.BucketName <- bucket
121 request.Key <- cid.ToString()
122 let! _ = client.DeleteObjectAsync(request) |> Async.AwaitTask
123 ()
124 }