summaryrefslogtreecommitdiff
path: root/gravatar.ur
blob: 2ecbdde16d30d07bc95a462135af9f1a4e29e97b (plain)
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
(* Copyright 2015 the Massachusetts Institute of Technology

Licensed under the Apache License, Version 2.0 (the "License"); you may not use
this file except in compliance with the License.  You may obtain a copy of the
License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software distributed
under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
CONDITIONS OF ANY KIND, either express or implied.  See the License for the
specific language governing permissions and limitations under the License. *)

fun separate_with (sep : string) (xs : list string) : string =
  List.foldr (fn result x => case x of
                                 "" => result
                               | _ => strcat x (strcat sep result))
             ""
             xs

structure Options = struct
  datatype missing_image_response =
      FourOhFour
    | MysteryMan
    | Identicon
    | Monster
    | Wavatar
    | Retro
    | Blank
    | Url of url

  val show_missing_image_response : show missing_image_response =
    mkShow (fn r =>
              case r of
                  FourOhFour => "404"
                | MysteryMan => "mm"
                | Identicon => "identicon"
                | Monster => "monsterid"
                | Wavatar => "wavatar"
                | Retro => "retro"
                | Blank => "blank"
                | Url u => show u)

  datatype rating = G | PG | R | X

  val show_rating : show rating =
    mkShow (fn r =>
              case r of
                  G => "g"
                | PG => "pg"
                | R => "r"
                | X => "x")

  type t = {
      Size : option int,
      Default : option missing_image_response,
      ForceDefault : bool,
      Rating : option rating
    }

  (* Converts a possibly null value to a component in an HTTP query string. *)
  fun parameter_string [a] (show_a : show a)
                       (url_key : string) (value : option a)
                       : string =
    case value of
        None => ""
      | Some v => strcat url_key (strcat "=" (@show show_a v))

  (* Generates a list of the components in the HTTP query string corresponding
  to [options]. *)
  fun query_string_elements (options : t) : list string =
    parameter_string "s" options.Size
    :: parameter_string "d" options.Default
    :: (case options.ForceDefault of
            False => ""
          | True => "f=y")
    :: parameter_string "r" options.Rating
    :: []

  fun to_query_string (options : t) : string =
    case (separate_with "&" (query_string_elements options)) of
        "" => ""
      | query_string =>
        (* Hey, we got some.  Stick a "?" at the beginning so it can be used
        as a query string. *)
        strcat "?" query_string
  end

fun calculate_hash email =
  show (Hash.md5 (textBlob (String.mp tolower (String.trim email))))

fun url' options email =
  bless
    (strcat "https://secure.gravatar.com/avatar/"
       (strcat (calculate_hash email)
          (Options.to_query_string options)))

fun url email =
  url' {Size = None, Default = None, ForceDefault = False, Rating = None} email