an atproto pds written in F# (.NET 9) 馃
desertthunder.dev
pds
fsharp
giraffe
dotnet
atproto
1namespace PDSharp.Core
2
3open System
4open System.Text.Json
5
6module Lexicon =
7 type LexiconResult =
8 | Ok
9 | Error of string
10
11 module Validation =
12 let private getProperty (p : string) (element : JsonElement) =
13 match element.TryGetProperty(p) with
14 | true, prop -> Some prop
15 | _ -> None
16
17 let private getString (p : string) (element : JsonElement) =
18 match getProperty p element with
19 | Some prop when prop.ValueKind = JsonValueKind.String -> Some(prop.GetString())
20 | _ -> None
21
22 let private validateStringField
23 (element : JsonElement)
24 (fieldName : string)
25 (maxLength : int option)
26 (required : bool)
27 : LexiconResult =
28 match getProperty fieldName element with
29 | Some prop ->
30 if prop.ValueKind <> JsonValueKind.String then
31 Error $"Field '{fieldName}' must be a string"
32 else
33 match maxLength with
34 | Some maxLen when prop.GetString().Length > maxLen ->
35 Error $"Field '{fieldName}' exceeds maximum length of {maxLen}"
36 | _ -> Ok
37 | None ->
38 if required then
39 Error $"Missing required field '{fieldName}'"
40 else
41 Ok
42
43 let private validateIsoDate (element : JsonElement) (fieldName : string) (required : bool) : LexiconResult =
44 match getProperty fieldName element with
45 | Some prop ->
46 if prop.ValueKind <> JsonValueKind.String then
47 Error $"Field '{fieldName}' must be a string"
48 else
49 let s = prop.GetString()
50 let mutable dt = DateTimeOffset.MinValue
51
52 if DateTimeOffset.TryParse(s, &dt) then
53 Ok
54 else
55 Error $"Field '{fieldName}' must be a valid ISO 8601 date string"
56 | None ->
57 if required then
58 Error $"Missing required field '{fieldName}'"
59 else
60 Ok
61
62 let private validateRef (element : JsonElement) (fieldName : string) (required : bool) : LexiconResult =
63 match getProperty fieldName element with
64 | Some prop ->
65 if prop.ValueKind <> JsonValueKind.Object then
66 Error $"Field '{fieldName}' must be an object"
67 else
68 match validateStringField prop "uri" None true, validateStringField prop "cid" None true with
69 | Ok, Ok -> Ok
70 | Error e, _ -> Error $"Field '{fieldName}': {e}"
71 | _, Error e -> Error $"Field '{fieldName}': {e}"
72 | None ->
73 if required then
74 Error $"Missing required field '{fieldName}'"
75 else
76 Ok
77
78 let validatePost (record : JsonElement) : LexiconResult =
79 let textCheck = validateStringField record "text" (Some 3000) true
80 let dateCheck = validateIsoDate record "createdAt" true
81
82 match textCheck, dateCheck with
83 | Ok, Ok -> Ok
84 | Error e, _ -> Error e
85 | _, Error e -> Error e
86
87 let validateLike (record : JsonElement) : LexiconResult =
88 let subjectCheck = validateRef record "subject" true
89 let dateCheck = validateIsoDate record "createdAt" true
90
91 match subjectCheck, dateCheck with
92 | Ok, Ok -> Ok
93 | Error e, _ -> Error e
94 | _, Error e -> Error e
95
96 let validateRepost (record : JsonElement) : LexiconResult =
97 let subjectCheck = validateRef record "subject" true
98 let dateCheck = validateIsoDate record "createdAt" true
99
100 match subjectCheck, dateCheck with
101 | Ok, Ok -> Ok
102 | Error e, _ -> Error e
103 | _, Error e -> Error e
104
105 let validateFollow (record : JsonElement) : LexiconResult =
106 let subjectCheck = validateStringField record "subject" None true
107 let dateCheck = validateIsoDate record "createdAt" true
108
109 match subjectCheck, dateCheck with
110 | Ok, Ok -> Ok
111 | Error e, _ -> Error e
112 | _, Error e -> Error e
113
114 let validateProfile (record : JsonElement) : LexiconResult =
115 let nameCheck = validateStringField record "displayName" (Some 640) false
116 let descCheck = validateStringField record "description" (Some 2560) false
117
118 match nameCheck, descCheck with
119 | Ok, Ok -> Ok
120 | Error e, _ -> Error e
121 | _, Error e -> Error e
122
123 /// Unknown records are valid but unvalidated.
124 let validate (collection : string) (record : JsonElement) : LexiconResult =
125 match collection with
126 | "app.bsky.feed.post" -> Validation.validatePost record
127 | "app.bsky.feed.like" -> Validation.validateLike record
128 | "app.bsky.feed.repost" -> Validation.validateRepost record
129 | "app.bsky.graph.follow" -> Validation.validateFollow record
130 | "app.bsky.actor.profile" -> Validation.validateProfile record
131 | _ -> Ok