~alcinnz/hurl

ref: a841435e2a825ecd8d7f27b0140a2a46e6408fb6 hurl/src/Network/URI/Messages.hs -rw-r--r-- 6.5 KiB
a841435e — Adrian Cochrane Support clientside certificates for HTTPS & Gemini. 1 year, 8 months ago
                                                                                
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
{-# LANGUAGE CPP #-}
-- | Module holding localized error messages to be presented as a response.
--
-- To localize error messages provided by HURL, provide your translations between
-- "BEGIN LOCALIZATION" & "END LOCALIZATION" in this file.
--
-- The lines are formatted:
--    trans ("LANG":_) (KEY) = "TRANSLATION"
-- with uppercase indicating the bits you fill in.
--
-- Translations between #if WITH_HTTP_URI & #endif are specific to HTTP error handling.
module Network.URI.Messages (trans, Errors(..)) where

import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)

#if WITH_HTTP_URI
import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..))
import Control.Exception (displayException)
import Network.TLS (TLSException(..), TLSError(..), AlertDescription(..))
import Control.Exception.Base (fromException)
#endif

trans _ (RawXML markup) = markup
--- BEGIN LOCALIZATION
trans ("en":_) (UnsupportedScheme scheme) = "Unsupported protocol " ++ scheme
trans ("en":_) (UnsupportedMIME mime) = "Unsupported filetype " ++ mime
trans ("en":_) (RequiresInstall mime appsMarkup) =
    "<h1>Please install a compatible app to open <code>" ++ linkType ++ "</code> links</h1>\n" ++ appsMarkup
  where linkType = fromMaybe mime $ stripPrefix "x-scheme-handler/" mime
trans ("en":_) (OpenedWith app) = "Opened in " ++ app
trans ("en":_) (ReadFailed msg) = "Failed to read file: " ++ msg
trans ("en":_) MalformedResponse = "Invalid response!"
trans ("en":_) ExcessiveRedirects = "Too many redirects!"
#if WITH_HTTP_URI
trans ("en":_) (Http (InvalidUrlException url msg)) = "Invalid URL " ++ url ++ ": " ++ msg
trans ("en":_) (Http (HttpExceptionRequest _ (TooManyRedirects _))) = "Too many redirects!"
trans ("en":_) (Http (HttpExceptionRequest _ ResponseTimeout)) = "The site took too long to respond!"
trans ("en":_) (Http (HttpExceptionRequest _ ConnectionTimeout)) = "The site took too long to connect!"
trans ("en":_) (Http (HttpExceptionRequest _ (ConnectionFailure err))) = "Could not connect: " ++ displayException err
trans ("en":_) (Http (HttpExceptionRequest _ (InternalException e))) = case fromException e of
    Just (Terminated _ why _) -> "Secure session disconnected! <em>" ++ why ++ "</em>"
    Just (HandshakeFailed (Error_Misc msg)) ->
        "Failed to establish secure connection! <em>" ++ msg ++ "</em>"
    Just (HandshakeFailed (Error_Protocol (_, _, CloseNotify))) ->
        "Secure session disconnected!"
    Just (HandshakeFailed (Error_Protocol (_, _, HandshakeFailure))) ->
        "Failed to negotiate security parameters!"
    Just (HandshakeFailed (Error_Protocol (_, _, BadCertificate))) ->
        "<h1>The site failed to prove it is who it says it is!</h1>"
    Just (HandshakeFailed (Error_Protocol (_, _, UnsupportedCertificate))) -> unlines [
        "<h1>The site failed to prove it is who it says it is!</h1>",
        "<p>It has sent us a cryptographic certificate I failed to make sense of.</p>"
      ]
    Just (HandshakeFailed (Error_Protocol (_, _, CertificateExpired))) -> unlines [
        "<h1>The site failed to prove it is who it says it is!</h1>",
        "<p>The cryptographic certificate it has sent to us has expired!</p>"
      ]
    Just (HandshakeFailed (Error_Protocol (_, _, CertificateRevoked))) -> unlines [
        "<h1>The site failed to prove it is who it says it is!</h1>",
        "<p>The cryptographic certificate it has sent us has been revoked!</p>"
      ]
    Just (HandshakeFailed (Error_Protocol (_, _, CertificateUnknown))) -> unlines [
        "<h1>The site failed to prove it is who it says it is!</h1>",
        "<p>The cryptographic certificate it has sent us belongs to someone else!</p>"
      ]
    Just (HandshakeFailed (Error_Protocol (_, _, UnknownCa))) -> unlines [
        "<h1>The site failed to prove it is who it says it is!</h1>",
        "<p>The authority vouching for it is unknown to me!</p>"
      ]
    Just (HandshakeFailed (Error_Protocol (why, _, _desc))) ->
        "Failed to establish secure connection! <em>" ++ why ++ "</em>"
    Just (HandshakeFailed (Error_Certificate why)) -> unlines [
        "<h1>The site failed to prove it is who it says it is!</h1>",
        "<p>" ++ why ++ "</p>"
      ]
    Just (HandshakeFailed (Error_HandshakePolicy why)) ->
        "Invalid handshake policy: <em>" ++ why ++ "</em>"
    Just (HandshakeFailed Error_EOF) -> "Secure session disconnected!"
    Just (HandshakeFailed (Error_Packet why)) ->
        "Invalid security packet: <em>" ++ why ++ "</em>"
    Just (HandshakeFailed (Error_Packet_unexpected a b)) -> unlines [
        "<p>Invalid security packet: <em>" ++ a ++ "</em></p>",
        "<p>" ++ b ++ "</p>"
      ]
    Just (HandshakeFailed (Error_Packet_Parsing why)) ->
        "Invalid security packet: <em>" ++ why ++ "</em>"
    Just ConnectionNotEstablished ->
        "Attempted to send or recieve data before establishing secure connection!"
    Nothing -> "Internal error: " ++ displayException e
trans ("en":_) (GeminiError '1' '1' label) =
    "<form><label>" ++ label ++ "<input type=password></form>" 
trans ("en":_) (GeminiError '1' _ label) = "<form><label>" ++ label ++ "<input></form>"
trans ("en":_) (GeminiError '4' '1' _) = "Site unavailable!"
trans ("en":_) (GeminiError '4' '2' _) = "Program error!"
trans ("en":_) (GeminiError '4' '3' _) = "Proxy error!"
trans ("en":_) (GeminiError '4' '4' timeout) =
    "Site busy! Please reload after at least " ++ timeout ++ " seconds"
trans ("en":_) (GeminiError '5' '1' _) = "Page not found!"
trans ("en":_) (GeminiError '5' '2' _) = "Page deleted!"
trans ("en":_) (GeminiError '5' '3' _) = "Contacted wrong server!"
trans ("en":_) (GeminiError '5' '9' _) = "Malformed request, my bad!"
trans ("en":_) (GeminiError '6' '1' _) = "<form><label>Authentication required" ++
    "<input type='-argo-keypair' -argo-error='Unauthorized account!'></form>"
trans ("en":_) (GeminiError '6' '2' _) = "<form><label>Authentication required" ++
    "<input type='-argo-keypair' -argo-error='Invalid account!'></form>"
trans ("en":_) (GeminiError '6' _ _) = "<form><label>Authentication required" ++
    "<input type='-argo-keypair' -argo-error='Invalid account!'></form>"
trans ("en":_) (GeminiError _ _ error) = error
#endif
--- END LOCALIZATION

trans (_:locales) err = trans locales err
trans [] err = trans ["en"] err

data Errors = UnsupportedScheme String | UnsupportedMIME String | RequiresInstall String String
    | OpenedWith String | ReadFailed String | RawXML String | MalformedResponse
    | ExcessiveRedirects | GeminiError Char Char String
#if WITH_HTTP_URI
    | Http HttpException
#endif