import Control.Arrow.Unicode
import Data.Ascii (Ascii)
import qualified Data.Ascii as A
+import qualified Data.CaseInsensitive as CI
import Data.Maybe
import qualified Data.Text as T
import Network.HTTP.Lucu.Config
= let sStr = A.toString $ A.fromAsciiBuilder $ printStatusCode status
sig = concat [ A.toString (cnfServerSoftware conf)
, " at "
- , T.unpack (cnfServerHost conf)
+ , T.unpack $ CI.original $ cnfServerHost conf
]
in ( eelem "/"
+= ( eelem "html"
-- 1xx responses don't have a body.
-- 2xx responses don't need a body to be completed.
-- 3xx:
- | toStatusCode resStatus ≡ Just MovedPermanently
+ | resStatus ≈ MovedPermanently
= txt ("The resource at " ⧺ path ⧺ " has been moved to ")
<+>
eelem "a" += sattr "href" loc
<+>
txt " permanently."
- | toStatusCode resStatus ≡ Just Found
+ | resStatus ≈ Found
= txt ("The resource at " ⧺ path ⧺ " is currently located at ")
<+>
eelem "a" += sattr "href" loc
<+>
txt ". This is not a permanent relocation."
- | toStatusCode resStatus ≡ Just SeeOther
+ | resStatus ≈ SeeOther
= txt ("The resource at " ⧺ path ⧺ " can be found at ")
<+>
eelem "a" += sattr "href" loc
<+>
txt "."
- | toStatusCode resStatus ≡ Just TemporaryRedirect
+ | resStatus ≈ TemporaryRedirect
= txt ("The resource at " ⧺ path ⧺ " is temporarily located at ")
<+>
eelem "a" += sattr "href" loc
txt "."
-- 4xx:
- | toStatusCode resStatus ≡ Just BadRequest
+ | resStatus ≈ BadRequest
= txt "The server could not understand the request you sent."
- | toStatusCode resStatus ≡ Just Unauthorized
+ | resStatus ≈ Unauthorized
= txt ("You need a valid authentication to access " ⧺ path)
- | toStatusCode resStatus ≡ Just Forbidden
+ | resStatus ≈ Forbidden
= txt ("You don't have permission to access " ⧺ path)
- | toStatusCode resStatus ≡ Just NotFound
+ | resStatus ≈ NotFound
= txt ("The requested URL " ⧺ path ⧺ " was not found on this server.")
- | toStatusCode resStatus ≡ Just Gone
+ | resStatus ≈ Gone
= txt ("The resource at " ⧺ path ⧺ " was here in past times, but has gone permanently.")
- | toStatusCode resStatus ≡ Just RequestEntityTooLarge
+ | resStatus ≈ RequestEntityTooLarge
= txt ("The request entity you sent for " ⧺ path ⧺ " was too large to accept.")
- | toStatusCode resStatus ≡ Just RequestURITooLarge
+ | resStatus ≈ RequestURITooLarge
= txt "The request URI you sent was too large to accept."
-- 5xx:
- | toStatusCode resStatus ≡ Just InternalServerError
+ | resStatus ≈ InternalServerError
= txt ("An internal server error has occured during the process of your request to " ⧺ path)
- | toStatusCode resStatus ≡ Just ServiceUnavailable
+ | resStatus ≈ ServiceUnavailable
= txt "The service is temporarily unavailable. Try later."
| otherwise