{-# 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)
import Control.Exception (Exception)

trans :: [String] -> Errors -> String
trans [String]
_ (RawXML String
markup) = String
markup
--- BEGIN LOCALIZATION
(String
"en":[String]
_) `trans` UnsupportedScheme String
scheme = String
"Unsupported protocol " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scheme
(String
"en":[String]
_) `trans` UnsupportedMIME String
mime = String
"Unsupported filetype " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mime
(String
"en":[String]
_) `trans` RequiresInstall String
mime String
appsMarkup =
    String
"<h1>Please install a compatible app to open <code>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
linkType String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
"</code> links</h1>\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
appsMarkup
  where linkType :: String
linkType = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
mime (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"x-scheme-handler/" String
mime
(String
"en":[String]
_) `trans` OpenedWith String
app = String
"Opened in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
app
(String
"en":[String]
_) `trans` ReadFailed String
msg = String
"Failed to read file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
(String
"en":[String]
_) `trans` MalformedResponse String
why = String
"Invalid response! " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why
(String
"en":[String]
_) `trans` Errors
ExcessiveRedirects = String
"Too many redirects!"
(String
"en":[String]
_) `trans` GeminiError Char
'1' Char
'1' String
label =
    String
"<form><label>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<input type=password></form>" 
(String
"en":[String]
_) `trans` GeminiError Char
'1' Char
_ String
label = String
"<form><label>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<input></form>"
(String
"en":[String]
_) `trans` GeminiError Char
'4' Char
'1' String
_ = String
"Site unavailable!"
(String
"en":[String]
_) `trans` GeminiError Char
'4' Char
'2' String
_ = String
"Program error!"
(String
"en":[String]
_) `trans` GeminiError Char
'4' Char
'3' String
_ = String
"Proxy error!"
(String
"en":[String]
_) `trans` GeminiError Char
'4' Char
'4' String
timeout =
    String
"Site busy! Please reload after at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
timeout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" seconds"
(String
"en":[String]
_) `trans` GeminiError Char
'5' Char
'1' String
_ = String
"Page not found! Try the <a href='/'>homepage</a>."
(String
"en":[String]
_) `trans` GeminiError Char
'5' Char
'2' String
_ = String
"Page deleted! Try the <a href='/'>homepage</a>."
(String
"en":[String]
_) `trans` GeminiError Char
'5' Char
'3' String
_ = String
"Contacted wrong server!"
(String
"en":[String]
_) `trans` GeminiError Char
'5' Char
'9' String
_ = String
"Malformed request, my bad!"
(String
"en":[String]
_) `trans` GeminiError Char
'6' Char
'1' String
_ = String
"<form><label>Authentication required" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<-argo-authenticate error='Unauthorized account!'></-argo-authenticate></form>"
(String
"en":[String]
_) `trans` GeminiError Char
'6' Char
'2' String
_ = String
"<form><label>Authentication required" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<-argo-authenticate error='Invalid account!'></-argo-authenticate></form>"
(String
"en":[String]
_) `trans` GeminiError Char
'6' Char
_ String
_ = String
"<form><label>Authentication required" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<-argo-authenticate></-argo-authenticate></form>"
(String
"en":[String]
_) `trans` GeminiError Char
_ Char
_ String
error = String
error
(String
"en":[String]
_) `trans` HTTPStatus Int
400 String
_ = String
"I sent a bad request, according to this site."
(String
"en":[String]
_) `trans` HTTPStatus Int
401 String
_ = String
"Authentication required!" -- FIXME: Support HTTP Basic Auth.
(String
"en":[String]
_) `trans` HTTPStatus Int
402 String
_ = String
"Payment required!"
(String
"en":[String]
_) `trans` HTTPStatus Int
403 String
_ = String
"Access denied!"
(String
"en":[String]
_) `trans` HTTPStatus Int
404 String
_ = String
"Page not found! Try the <a href='/'>homepage</a>."
(String
"en":[String]
_) `trans` HTTPStatus Int
405 String
_ = String
"Bad webform for this destination webaddress! " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<em>Method not allowed</em>."
(String
"en":[String]
_) `trans` HTTPStatus Int
406 String
_ = String
"No representation available for given criteria!"
(String
"en":[String]
_) `trans` HTTPStatus Int
407 String
_ = String
"Authentication into proxyserver required!"
(String
"en":[String]
_) `trans` HTTPStatus Int
408 String
_ = String
"The site took too long to connect! <em>(HTTP 408)</em>"
(String
"en":[String]
_) `trans` HTTPStatus Int
409 String
_ = String
"Request is based on outdated state!"
(String
"en":[String]
_) `trans` HTTPStatus Int
410 String
_ = String
"Page deleted! Try the <a href='/'>homepage</a>."
(String
"en":[String]
_) `trans` HTTPStatus Int
411 String
_ = String
"I sent a bad request, according to this site." String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<em>(Missing <code>Content-Length</code> header)</em>"
(String
"en":[String]
_) `trans` HTTPStatus Int
412 String
_ = String
"Webpage doesn't meet our preconditions."
(String
"en":[String]
_) `trans` HTTPStatus Int
413 String
_ = String
"Payload too large, please upload a smaller file!"
(String
"en":[String]
_) `trans` HTTPStatus Int
414 String
_ = String
"Web address is too long for the site!"
(String
"en":[String]
_) `trans` HTTPStatus Int
415 String
_ = String
"No representation available for supported filetypes!"
(String
"en":[String]
_) `trans` HTTPStatus Int
416 String
_ = String
"Invalid byte-range of requested resource!"
(String
"en":[String]
_) `trans` HTTPStatus Int
417 String
_ = String
"Site cannot satisfy our stated expectations!"
(String
"en":[String]
_) `trans` HTTPStatus Int
418 String
_ = [String] -> String
unlines [
    String
"<p>I'm a little teapot<br/>",
    String
"Short and stout<br/>",
    String
"Here is my handle<br/>",
    String
"And here is my spout.</p>>",
    String
"<p>When I get all steamed up<br/>",
    String
"Hear me shout<br/>",
    String
"<q>Tip me over<br/>",
    String
"And pour me out!</q></p>"
  ]
(String
"en":[String]
_) `trans` HTTPStatus Int
421 String
_ = String
"Contacted wrong server!"
(String
"en":[String]
_) `trans` HTTPStatus Int
422 String
_ = String
"Invalid <strong>WebDAV</strong> request!"
(String
"en":[String]
_) `trans` HTTPStatus Int
423 String
_ = String
"<strong>WebDAV</strong> resource is locked!"
(String
"en":[String]
_) `trans` HTTPStatus Int
424 String
_ = String
"Failed due to previous failure!"
(String
"en":[String]
_) `trans` HTTPStatus Int
425 String
_ = String
"Site requires stronger security on our request!"
(String
"en":[String]
_) `trans` HTTPStatus Int
426 String
_ = String
"Site requires newer networking-protocols!"
(String
"en":[String]
_) `trans` HTTPStatus Int
428 String
_ = String
"Site requires additional protection to avoid loosing changes!"
(String
"en":[String]
_) `trans` HTTPStatus Int
429 String
_ = String
"We sent this site too many requests for it to cope with!"
(String
"en":[String]
_) `trans` HTTPStatus Int
431 String
_ = String
"I sent more auxiliary data than this site can cope with!"
(String
"en":[String]
_) `trans` HTTPStatus Int
451 String
_ = String
"Requested page cannot legally be provided!"

(String
"en":[String]
_) `trans` HTTPStatus Int
500 String
_ = String
"The site experienced an error generating this webpage. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<em>The webmasters have probably already been automatically notified.</em>"
(String
"en":[String]
_) `trans` HTTPStatus Int
501 String
_ =
    String
"Bad webform for this destination webaddress! <em>Method not implemented</em>."
(String
"en":[String]
_) `trans` HTTPStatus Int
502 String
_ = String
"Proxyserver got a malformed response!"
(String
"en":[String]
_) `trans` HTTPStatus Int
503 String
_ = String
"The site is not available right now!"
(String
"en":[String]
_) `trans` HTTPStatus Int
504 String
_ = String
"The site took too long to respond! <em>(Behind proxy)</em>"
(String
"en":[String]
_) `trans` HTTPStatus Int
505 String
_ = String
"The site does not speak the language as me! " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"<em>(Unsupported HTTP version)</em>"
(String
"en":[String]
_) `trans` HTTPStatus Int
506 String
_ = String
"The site is misconfigured!"
(String
"en":[String]
_) `trans` HTTPStatus Int
507 String
_ = String
"Insufficient <strong>WebDAV</strong> storage!"
(String
"en":[String]
_) `trans` HTTPStatus Int
508 String
_ = String
"<strong>WebDAV</strong> loop detected!"
(String
"en":[String]
_) `trans` HTTPStatus Int
510 String
_ = String
"Further request extensions required!"
(String
"en":[String]
_) `trans` HTTPStatus Int
511 String
_ = String
"Authentication into network required!"
(String
"en":[String]
_) `trans` HTTPStatus Int
_ String
error = String
error -- Fallback
(String
"en":[String]
_) `trans` OtherException String
error = String
"Internal Exception <pre><code>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
error String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</code></pre>"
(String
"en":[String]
_) `trans` InvalidUrl String
url String
message =
    String
"Invalid web address <code>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
url String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</code>: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
(String
"en":[String]
_) `trans` ProxyError String
msg Int
code Int
code' String
msg' = [String] -> String
unlines [
    String
"<h1>Proxy failed to forward request!<h1>",
    String
"<p>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</p>",
    String
"<p>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</p>"
  ]
(String
"en":[String]
_) `trans` InvalidRequest String
why =
    String
"Attempted to send invalid auxiliary data: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
(String
"en":[String]
_) `trans` Errors
InsecureUnestablished =
    String
"Attempted to send or recieve data before establishing secure connection!"
(String
"en":[String]
_) `trans` InsecureCertificate String
why = [String] -> String
unlines [
    String
"<h1>The site failed to prove it is who it says it is!</h1>",
    String
"<p>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</p>",
    String
"<p><a href=action:history/back>Leave Insecure Site</a> | ",
        String
"<a href=action:novalidate>Accept Imposter Risk &amp; Continue</a></p>"
  ]
(String
"en":[String]
_) `trans` InsecureTerminated String
why = String
"Secure session disconnected! <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
trans (String
"en":[String]
_) Errors
InsecureCertificateUnknownCA = String
"The authority vouching for it is unknown to me!"
trans (String
"en":[String]
_) Errors
InsecureCertificateUnknown =
    String
"The cryptographic certificate it has sent us to prove its identity instead " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"belongs to someone else!"
trans (String
"en":[String]
_) Errors
InsecureCertificateRevoked =
    String
"The cryptographic certificate it has sent us to prove its identity has been revoked!"
trans (String
"en":[String]
_) Errors
InsecureCertificateExpired =
    String
"The cryptographic certificate it has sent us to prove its identity has expired!"
trans (String
"en":[String]
_) Errors
InsecureCertificateUnsupported =
    String
"It has sent us a cryptographic certificate to prove its identity I failed to make sense of."
(String
"en":[String]
_) `trans` HandshakePacketUnparsed String
why = String
"Invalid security packet: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
(String
"en":[String]
_) `trans` HandshakePacketUnexpected String
a String
b = [String] -> String
unlines [
    String
"<p>Invalid security packet: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em></p>",
    String
"<p>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</p>"
  ]
(String
"en":[String]
_) `trans` HandshakePacketInvalid String
why = String
"Invalid security packet: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
trans (String
"en":[String]
_) Errors
HandshakeEOF = String
"Secure session disconnected!"
(String
"en":[String]
_) `trans` HandshakePolicy String
why = String
"Invalid handshake policy: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
(String
"en":[String]
_) `trans` HandshakeMisc String
why =
    String
"Failed to establish secure connection! <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
trans (String
"en":[String]
_) Errors
HandshakeError = String
"Failed to negotiate security parameters!"
trans (String
"en":[String]
_) Errors
HandshakeClosed = String
"Secure session disconnected!"
(String
"en":[String]
_) `trans` FailedConnect String
why = String
"Failed to open connection to the site: <em>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</em>"
trans (String
"en":[String]
_) Errors
TimeoutConnection = String
"The site took too long to connect!"
trans (String
"en":[String]
_) Errors
TimeoutResponse = String
"The site took too long to respond!"
--- END LOCALIZATION

trans (String
_:[String]
locales) Errors
err = [String] -> Errors -> String
trans [String]
locales Errors
err
trans [] Errors
err = Errors -> String
forall a. Show a => a -> String
show Errors
err

data Errors = UnsupportedScheme String | UnsupportedMIME String | RequiresInstall String String
    | OpenedWith String | ReadFailed String | RawXML String | MalformedResponse String
    | ExcessiveRedirects | HTTPStatus Int String | GeminiError Char Char String
    | OtherException String | InvalidUrl String String | ProxyError String Int Int String
    | InvalidRequest String
    | InsecureUnestablished | InsecureCertificate String | InsecureTerminated String
    | InsecureCertificateUnknownCA | InsecureCertificateUnknown | InsecureCertificateRevoked
    | InsecureCertificateExpired | InsecureCertificateUnsupported
    | HandshakePacketUnparsed String | HandshakePacketUnexpected String String
    | HandshakePacketInvalid String
    | HandshakeEOF | HandshakePolicy String | HandshakeMisc String | HandshakeError | HandshakeClosed
    | FailedConnect String | TimeoutConnection | TimeoutResponse deriving (Int -> Errors -> String -> String
[Errors] -> String -> String
Errors -> String
(Int -> Errors -> String -> String)
-> (Errors -> String)
-> ([Errors] -> String -> String)
-> Show Errors
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Errors] -> String -> String
$cshowList :: [Errors] -> String -> String
show :: Errors -> String
$cshow :: Errors -> String
showsPrec :: Int -> Errors -> String -> String
$cshowsPrec :: Int -> Errors -> String -> String
Show)

instance Exception Errors