~alcinnz/hurl

ref: 0836606622d85d93c5aa9177efbe01b09eba4f4f hurl/src/Network/URI/Messages.hs -rw-r--r-- 5.2 KiB
08366066 — Adrian Cochrane Switch cryptography library & implement HSTS. 1 year, 9 months ago
                                                                                
09c71046 Adrian Cochrane
47f9ef33 Adrian Cochrane
09c71046 Adrian Cochrane
47f9ef33 Adrian Cochrane
214ebf86 Adrian Cochrane
09c71046 Adrian Cochrane
08366066 Adrian Cochrane
09c71046 Adrian Cochrane
214ebf86 Adrian Cochrane
47f9ef33 Adrian Cochrane
214ebf86 Adrian Cochrane
8d239eb6 Adrian Cochrane
09c71046 Adrian Cochrane
984867b7 Adrian Cochrane
42aa3ea2 Adrian Cochrane
09c71046 Adrian Cochrane
08366066 Adrian Cochrane
09c71046 Adrian Cochrane
47f9ef33 Adrian Cochrane
214ebf86 Adrian Cochrane
984867b7 Adrian Cochrane
42aa3ea2 Adrian Cochrane
09c71046 Adrian Cochrane
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
{-# 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
#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
#if WITH_HTTP_URI
    | Http HttpException
#endif