0 | module HTTP.Response
 1 |
 2 | import HTTP.API
 3 | import JSON.Simple
 4 |
 5 | %default total
 6 |
 7 | --------------------------------------------------------------------------------
 8 | --          Response
 9 | --------------------------------------------------------------------------------
10 |
11 | ||| HTTP Response
12 | |||
13 | ||| Currently, we include the content / body as a whole. This might
14 | ||| be changed to a stream of data if we ever decide to stream
15 | ||| large amounts of content.
16 | public export
17 | record Response where
18 |   constructor RP
19 |   headers : Headers
20 |   content : List ByteString
21 |
22 | export
23 | empty : Response
24 | empty = RP emptyHeaders []
25 |
26 | export
27 | addHeader :  String -> ByteString  -> Response -> Response
28 | addHeader x y = {headers $= insertHeader x y}
29 |
30 | export
31 | setStatus : Status -> Response -> Response
32 | setStatus s = addHeader "Status" (cast s)
33 |
34 | crlf : ByteString
35 | crlf = "\r\n"
36 |
37 | export
38 | responseBytes : Response -> List ByteString
39 | responseBytes (RP hs bs) =
40 |   case kvList hs of
41 |     [] => crlf :: crlf :: bs
42 |     ps => (ps >>= \(h,v) => [fromString h,":",v,crlf]) ++ crlf :: bs
43 |
44 | export
45 | setContentType : EncodeVia f t -> Response -> Response
46 | setContentType e = addHeader Content_Type (encodeMediaType $ mediaType @{e})
47 |
48 | export
49 | encodeBody :
50 |      Status
51 |   -> t
52 |   -> Headers
53 |   -> All (EncodeVia t) ts
54 |   -> Response
55 |   -> Response
56 | encodeBody s v hs []        rs = setStatus s rs
57 | encodeBody s v hs (e :: es) rs =
58 |   case acceptsMedia hs (mediaType @{e}) of
59 |     False => encodeBody s v hs es rs
60 |     True  => {content := encodeVia v e} rs |> setContentType e |> setStatus s
61 |
62 | --------------------------------------------------------------------------------
63 | --          Common Responses
64 | --------------------------------------------------------------------------------
65 |
66 | encErr : All (EncodeVia RequestErr) [JSON, Text]
67 | encErr = %search
68 |
69 | export
70 | fromError : Maybe URI -> Headers -> RequestErr -> Response
71 | fromError mu hs re@(RE st err _ _ _) =
72 |  let u := maybe "" interpolate mu
73 |   in encodeBody (MkStatus st err) ({path := u} re) hs encErr empty
74 |
75 | export
76 | fromStatus : URI -> Headers -> Status -> Response
77 | fromStatus u hs = fromError (Just u) hs . requestErr
78 |
79 | export
80 | notFound : URI -> Headers -> Response
81 | notFound u hs = fromStatus u hs notFound404
82 |
83 | export
84 | forbidden : URI -> Headers -> Response
85 | forbidden u hs = fromStatus u hs forbidden403
86 |