1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
(** Migration file representation and parsing. *)
type t = { version : int64; description : string; file_path : string }
let generate_version () : int64 =
let d = Unix.gettimeofday () in
let tm = Unix.localtime d in
let timestamp_str =
Printf.sprintf "%04d%02d%02d%02d%02d%02d" (tm.Unix.tm_year + 1900)
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
tm.Unix.tm_sec
in
Int64.of_string timestamp_str
(** A version stamp is exactly 14 ASCII decimal digits (YYYYMMDDHHMMSS). We
validate the digits explicitly: [Int64.of_string] would otherwise accept a
leading [-]/[+], [0x]/[0o]/[0b] prefixes, and [_] separators, letting bogus
or negative versions slip in. *)
let is_version_stamp (s : string) : bool =
String.length s = 14 && String.for_all (fun c -> c >= '0' && c <= '9') s
let has_sql_suffix (rest : string) : bool =
String.ends_with ~suffix:".sql" (String.lowercase_ascii rest)
let invalid_filename filename =
Types.MigrationError
(Types.ParseError
(Types.InvalidFormat
(Printf.sprintf
"Invalid migration filename '%s' (expected exactly 14 digits then \
'_<description>.sql', e.g. 20240115120000_create_users.sql)"
filename)))
(** Parse version from filename Filename format: YYYYMMDDHHMMSS_description.sql
Example: 20240115120000_create_users.sql -> 20240115120000 *)
let parse_version (filename : string) : (int64, Types.error) result =
let basename = Filename.basename filename in
match String.index_opt basename '_' with
| Some 14 when is_version_stamp (String.sub basename 0 14) ->
Ok (Int64.of_string (String.sub basename 0 14))
| _ -> Error (invalid_filename filename)
(** Parse description from filename Filename format:
YYYYMMDDHHMMSS_description.sql Example: 20240115120000_create_users.sql ->
create_users *)
let parse_description (filename : string) : (string, Types.error) result =
let basename = Filename.basename filename in
match String.index_opt basename '_' with
| Some 14 when is_version_stamp (String.sub basename 0 14) ->
let rest = String.sub basename 15 (String.length basename - 15) in
if has_sql_suffix rest then
let desc = String.sub rest 0 (String.length rest - 4) in
if String.length desc = 0 then
Error
(Types.MigrationError
(Types.ParseError
(Types.InvalidFormat
(Printf.sprintf
"Migration description cannot be empty: '%s'" filename))))
else Ok desc
else
Error
(Types.MigrationError
(Types.ParseError
(Types.InvalidFormat
(Printf.sprintf
"Migration file must have a .sql extension: '%s'" filename))))
| _ -> Error (invalid_filename filename)
let from_file (file_path : string) : (t, Types.error) result =
match parse_version file_path with
| Error e -> Error e
| Ok version -> (
match parse_description file_path with
| Error e -> Error e
| Ok description -> Ok { version; description; file_path })
let read_sql (migration : t) : (string, Types.error) result =
match
try Ok (In_channel.with_open_text migration.file_path In_channel.input_all)
with e -> Error e
with
| Ok content -> Ok content
| Error exn ->
Error (Types.FileError (Types.ReadError (migration.file_path, exn)))
(** MD5 checksum (hex) of the migration file's full contents, used to detect
whether a migration file was modified after it was applied. This is
change-detection, not a security check. *)
let checksum (migration : t) : (string, Types.error) result =
match read_sql migration with
| Error e -> Error e
| Ok content -> Ok (Digest.to_hex (Digest.string content))
(** Parse a section from migration file content Returns the content between a
section marker and the next section or EOF *)
let parse_section (content : string) (section : string) : string option =
let lines = String.split_on_char '\n' content in
let section_marker = "-- +migrate " ^ section in
let rec find_section_start = function
| [] -> None
| line :: rest ->
if String.trim line = section_marker then Some rest
else find_section_start rest
in
match find_section_start lines with
| None -> None
| Some section_lines ->
let rec collect_until_next_section acc = function
| [] -> List.rev acc
| line :: rest ->
let line_trimmed = String.trim line in
if String.starts_with ~prefix:"-- +migrate " line_trimmed then
List.rev acc
else collect_until_next_section (line :: acc) rest
in
let section_content = collect_until_next_section [] section_lines in
let joined = String.concat "\n" section_content in
Some (String.trim joined)
(** Read a named section's SQL ("up"/"down"), erroring if it is missing or
empty. *)
let read_section_sql (migration : t) (section : string) :
(string, Types.error) result =
match read_sql migration with
| Error e -> Error e
| Ok content -> (
match parse_section content section with
| None ->
Error
(Types.MigrationError
(Types.MissingSection (migration.file_path, section)))
| Some sql ->
if String.trim sql = "" then
Error
(Types.MigrationError
(Types.EmptySection (migration.file_path, section)))
else Ok sql)
let read_up_sql (migration : t) : (string, Types.error) result =
read_section_sql migration "up"
let read_down_sql (migration : t) : (string, Types.error) result =
read_section_sql migration "down"
let make_filename (version : int64) (description : string) : string =
Printf.sprintf "%Ld_%s.sql" version description
let compare (a : t) (b : t) : int = Int64.compare a.version b.version
let to_string (migration : t) : string =
Printf.sprintf "[%Ld] %s" migration.version migration.description