Source file cross_realm_principal_name.ml

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
module Stable = struct
  open! Core.Core_stable

  module V1 = struct
    module User = struct
      type t =
        { username : string
        ; realm : Realm.t
        }
      [@@deriving bin_io, compare, hash, sexp]
    end

    module Service = struct
      type t =
        { service : string
        ; hostname : string
        ; realm : Realm.t
        }
      [@@deriving bin_io, compare, hash, sexp]
    end

    module T = struct
      type t =
        | User of User.t
        | Service of Service.t
      [@@deriving bin_io, compare, hash, sexp]

      include (val Comparator.V1.make ~compare ~sexp_of_t)
    end

    include T
    include Comparable.V1.Make (T)
  end
end

open! Core
open! Async
open! Import

module User = struct
  type t = Stable.V1.User.t =
    { username : string
    ; realm : Realm.t
    }
  [@@deriving compare, fields, hash, sexp_of]

  let to_string { username; realm } = sprintf "%s@%s" username realm

  let with_default_realm username =
    let open Deferred.Or_error.Let_syntax in
    let%bind realm = Realm.default () in
    return { username; realm }
  ;;

  let%expect_test "to_string" =
    let () =
      { username = "user"; realm = "TEST.REALM.COM" } |> to_string |> print_endline
    in
    [%expect {| user@TEST.REALM.COM |}];
    Deferred.unit
  ;;
end

module Service = struct
  type t = Stable.V1.Service.t =
    { service : string
    ; hostname : string
    ; realm : Realm.t
    }
  [@@deriving compare, fields, hash, sexp_of]

  let to_string { service; hostname; realm } = sprintf "%s/%s@%s" service hostname realm

  let with_default_realm ~service ~hostname =
    let open Deferred.Or_error.Let_syntax in
    let%bind realm = Realm.default () in
    return { service; hostname; realm }
  ;;

  let%expect_test "to_string" =
    { service = "ftp"; hostname = "bluebird.domain.com"; realm = "TEST.REALM.COM" }
    |> to_string
    |> print_endline;
    [%expect {|
      ftp/bluebird.domain.com@TEST.REALM.COM |}];
    Deferred.unit
  ;;
end

module T = struct
  type t = Stable.V1.t =
    | User of User.t
    | Service of Service.t
  [@@deriving compare, hash, sexp_of]

  type comparator_witness = Stable.V1.comparator_witness

  let comparator = Stable.V1.comparator
end

include T
include Comparable.Make_plain_using_comparator (T)
include Hashable.Make_plain (T)

let realm = function
  | User user -> User.realm user
  | Service service -> Service.realm service
;;

let to_string = function
  | User user -> User.to_string user
  | Service service -> Service.to_string service
;;

let of_string x =
  let open Or_error.Let_syntax in
  match Principal_parser.parse x with
  | { primary; instance = None; realm = Some realm } ->
    return (User { username = primary; realm })
  | { primary; instance = Some instance; realm = Some realm } ->
    return (Service { service = primary; hostname = instance; realm })
  | { realm = None; _ } -> Or_error.error_s [%message "Realm must be supplied" x]
;;

let of_string_exn s = ok_exn (of_string s)