desertthunder.dev
an atproto pds written in F# (.NET 9) 馃
pds
fsharp
giraffe
dotnet
atproto
1namespace PDSharp.Core
2
3open System
4open System.Text
5open Org.BouncyCastle.Crypto.Digests
6open Org.BouncyCastle.Crypto.Macs
7open Org.BouncyCastle.Crypto.Parameters
8open Org.BouncyCastle.Security
9
10/// Authentication module for sessions and accounts
11/// TODO: Migrate account storage from in-memory to SQLite/Postgres for production
12module Auth =
13 /// Hash a password with a random salt using SHA-256
14 ///
15 /// Returns: base64(salt)$base64(hash)
16 let hashPassword (password : string) : string =
17 let salt = Array.zeroCreate<byte> 16
18 SecureRandom().NextBytes(salt)
19
20 let passwordBytes = Encoding.UTF8.GetBytes(password)
21 let toHash = Array.append salt passwordBytes
22
23 let digest = Sha256Digest()
24 digest.BlockUpdate(toHash, 0, toHash.Length)
25 let hash = Array.zeroCreate<byte> (digest.GetDigestSize())
26 digest.DoFinal(hash, 0) |> ignore
27
28 $"{Convert.ToBase64String(salt)}${Convert.ToBase64String(hash)}"
29
30 /// Verify a password against a stored hash
31 let verifyPassword (password : string) (storedHash : string) : bool =
32 let parts = storedHash.Split('$')
33
34 if parts.Length <> 2 then
35 false
36 else
37 try
38 let salt = Convert.FromBase64String(parts.[0])
39 let expectedHash = Convert.FromBase64String(parts.[1])
40
41 let passwordBytes = Encoding.UTF8.GetBytes(password)
42 let toHash = Array.append salt passwordBytes
43
44 let digest = Sha256Digest()
45 digest.BlockUpdate(toHash, 0, toHash.Length)
46 let actualHash = Array.zeroCreate<byte> (digest.GetDigestSize())
47 digest.DoFinal(actualHash, 0) |> ignore
48
49 actualHash = expectedHash
50 with _ ->
51 false
52
53 let private base64UrlEncode (bytes : byte[]) : string =
54 Convert.ToBase64String(bytes).Replace('+', '-').Replace('/', '_').TrimEnd('=')
55
56 let private base64UrlDecode (str : string) : byte[] =
57 let padded =
58 match str.Length % 4 with
59 | 2 -> str + "=="
60 | 3 -> str + "="
61 | _ -> str
62
63 Convert.FromBase64String(padded.Replace('-', '+').Replace('_', '/'))
64
65 let private hmacSha256 (secret : byte[]) (data : byte[]) : byte[] =
66 let hmac = HMac(Sha256Digest())
67 hmac.Init(KeyParameter(secret))
68 hmac.BlockUpdate(data, 0, data.Length)
69 let result = Array.zeroCreate<byte> (hmac.GetMacSize())
70 hmac.DoFinal(result, 0) |> ignore
71 result
72
73 /// Token type for domain separation per AT Protocol spec
74 type TokenType =
75 | Access // typ: at+jwt
76 | Refresh // typ: refresh+jwt
77
78 /// Create a JWT token
79 let createToken (secret : string) (tokenType : TokenType) (did : string) (expiresIn : TimeSpan) : string =
80 let now = DateTimeOffset.UtcNow
81 let exp = now.Add(expiresIn)
82
83 let typ =
84 match tokenType with
85 | Access -> "at+jwt"
86 | Refresh -> "refresh+jwt"
87
88 let jti = Guid.NewGuid().ToString("N")
89
90 let header = $"""{{ "alg": "HS256", "typ": "{typ}" }}"""
91 let headerB64 = base64UrlEncode (Encoding.UTF8.GetBytes(header))
92
93 let payload =
94 $"""{{ "sub": "{did}", "iat": {now.ToUnixTimeSeconds()}, "exp": {exp.ToUnixTimeSeconds()}, "jti": "{jti}" }}"""
95
96 let payloadB64 = base64UrlEncode (Encoding.UTF8.GetBytes(payload))
97
98 let signingInput = $"{headerB64}.{payloadB64}"
99 let secretBytes = Encoding.UTF8.GetBytes(secret)
100 let signature = hmacSha256 secretBytes (Encoding.UTF8.GetBytes(signingInput))
101 let signatureB64 = base64UrlEncode signature
102
103 $"{headerB64}.{payloadB64}.{signatureB64}"
104
105 /// Create an access token (short-lived)
106 let createAccessToken (secret : string) (did : string) : string =
107 createToken secret Access did (TimeSpan.FromMinutes(15.0))
108
109 /// Create a refresh token (longer-lived)
110 let createRefreshToken (secret : string) (did : string) : string =
111 createToken secret Refresh did (TimeSpan.FromDays(7.0))
112
113 /// Validation result
114 type TokenValidation =
115 | Valid of did : string * tokenType : TokenType * exp : int64
116 | Invalid of reason : string
117
118 /// Validate a JWT token and extract claims
119 let validateToken (secret : string) (token : string) : TokenValidation =
120 let parts = token.Split('.')
121
122 if parts.Length <> 3 then
123 Invalid "Invalid token format"
124 else
125 try
126 let headerB64, payloadB64, signatureB64 = parts.[0], parts.[1], parts.[2]
127
128 let signingInput = $"{headerB64}.{payloadB64}"
129 let secretBytes = Encoding.UTF8.GetBytes(secret)
130 let expectedSig = hmacSha256 secretBytes (Encoding.UTF8.GetBytes(signingInput))
131 let actualSig = base64UrlDecode signatureB64
132
133 if expectedSig <> actualSig then
134 Invalid "Invalid signature"
135 else
136 let payloadJson = Encoding.UTF8.GetString(base64UrlDecode payloadB64)
137 let headerJson = Encoding.UTF8.GetString(base64UrlDecode headerB64)
138
139 let typMatch =
140 System.Text.RegularExpressions.Regex.Match(headerJson, "\"typ\"\\s*:\\s*\"([^\"]+)\"")
141
142 let tokenType =
143 if typMatch.Success then
144 match typMatch.Groups.[1].Value with
145 | "at+jwt" -> Access
146 | "refresh+jwt" -> Refresh
147 | _ -> Access
148 else
149 Access
150
151 let subMatch =
152 System.Text.RegularExpressions.Regex.Match(payloadJson, "\"sub\"\\s*:\\s*\"([^\"]+)\"")
153
154 let expMatch =
155 System.Text.RegularExpressions.Regex.Match(payloadJson, "\"exp\"\\s*:\\s*([0-9]+)")
156
157 if not subMatch.Success || not expMatch.Success then
158 Invalid "Missing claims"
159 else
160 let did = subMatch.Groups.[1].Value
161 let exp = Int64.Parse(expMatch.Groups.[1].Value)
162 let now = DateTimeOffset.UtcNow.ToUnixTimeSeconds()
163
164 if now > exp then
165 Invalid "Token expired"
166 else
167 Valid(did, tokenType, exp)
168 with ex ->
169 Invalid $"Parse error: {ex.Message}"
170
171 /// Account record
172 type Account = {
173 Did : string
174 Handle : string
175 PasswordHash : string
176 Email : string option
177 CreatedAt : DateTimeOffset
178 }
179
180 let mutable private accounts : Map<string, Account> = Map.empty
181 let mutable private handleIndex : Map<string, string> = Map.empty
182
183 let createAccount (handle : string) (password : string) (email : string option) : Result<Account, string> =
184 if Map.containsKey handle handleIndex then
185 Error "Handle already taken"
186 else
187 let did = $"did:web:{handle}"
188
189 if Map.containsKey did accounts then
190 Error "Account already exists"
191 else
192 let account = {
193 Did = did
194 Handle = handle
195 PasswordHash = hashPassword password
196 Email = email
197 CreatedAt = DateTimeOffset.UtcNow
198 }
199
200 accounts <- Map.add did account accounts
201 handleIndex <- Map.add handle did handleIndex
202 Ok account
203
204 /// Get account by handle
205 let getAccountByHandle (handle : string) : Account option =
206 handleIndex
207 |> Map.tryFind handle
208 |> Option.bind (fun did -> Map.tryFind did accounts)
209
210 /// Get account by DID
211 let getAccountByDid (did : string) : Account option = Map.tryFind did accounts
212
213 /// Clear all accounts (for testing)
214 let resetAccounts () =
215 accounts <- Map.empty
216 handleIndex <- Map.empty