diff --git a/.tidyrc.json b/.tidyrc.json new file mode 100644 index 0000000..253ccb5 --- /dev/null +++ b/.tidyrc.json @@ -0,0 +1,10 @@ +{ + "importSort": "ide", + "importWrap": "auto", + "indent": 2, + "operatorsFile": null, + "ribbon": 1, + "typeArrowPlacement": "first", + "unicode": "never", + "width": 80 +} diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..684704b --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,26 @@ +# Changelog + +Notable changes are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +Breaking changes: +- Updates for PS v0.15 +- Removed `joinQuery`: Use `append` instead. +- Removed `makeQuery'`: Use `URI.Query.fromString` instead. + +New features: + +Bugfixes: + +Other improvements: + +## [0.7.0] - TBD + +Breaking changes: + +New features: + +Bugfixes: + +Other improvements: \ No newline at end of file diff --git a/bower.json b/bower.json index 08094c9..d77bd95 100644 --- a/bower.json +++ b/bower.json @@ -13,27 +13,25 @@ "output" ], "devDependencies": { - "purescript-psci-support": "^3.0.0", - "purescript-console": "^3.0.0" + "purescript-psci-support": "^6.0.0", + "purescript-console": "^6.0.0" }, "dependencies": { - "purescript-prelude": "^3.1.0", - "purescript-maps": "^3.5.2", - "purescript-maybe": "^3.0.0", - "purescript-strings": "^3.3.1", - "purescript-lists": "^4.9.0", - "purescript-foreign": "^4.0.1", - "purescript-datetime": "^3.3.0", - "purescript-uri": "^4.0.0", - "purescript-pathy": "^4.0.0", - "purescript-transformers": "^3.4.0", - "purescript-string-parsers": "^3.0.1", - "purescript-js-date": "^5.1.0", - "purescript-control": "^3.3.0", - "purescript-monoid": "^3.1.0", - "purescript-tuples": "^4.1.0", - "purescript-exceptions": "^3.1.0", - "purescript-either": "^3.1.0", - "purescript-foreign-generic": "^5.0.0" + "purescript-prelude": "^6.0.0", + "purescript-ordered-collections": "^3.0.0", + "purescript-maybe": "^6.0.0", + "purescript-strings": "^6.0.0", + "purescript-lists": "^7.0.0", + "purescript-foreign": "^7.0.0", + "purescript-datetime": "^6.0.0", + "purescript-uri": "^9.0.0", + "purescript-pathy": "^9.0.0", + "purescript-transformers": "^6.0.0", + "purescript-string-parsers": "^8.0.0", + "purescript-js-date": "^8.0.0", + "purescript-control": "^6.0.0", + "purescript-tuples": "^7.0.0", + "purescript-exceptions": "^6.0.0", + "purescript-either": "^6.0.0" } } diff --git a/src/Network/HTTP/Types/Cookie.js b/src/Network/HTTP/Types/Cookie.js index e7b474f..bad7373 100644 --- a/src/Network/HTTP/Types/Cookie.js +++ b/src/Network/HTTP/Types/Cookie.js @@ -339,8 +339,6 @@ function parse(str, options) { } // XXX Eventually give this a pure PureScript implementation. -function parseImpl(cookieString) { +export function parseImpl(cookieString) { return parse(cookieString); -} - -exports.parseImpl = parseImpl; +} \ No newline at end of file diff --git a/src/Network/HTTP/Types/Cookie.purs b/src/Network/HTTP/Types/Cookie.purs index 1120352..ed78347 100644 --- a/src/Network/HTTP/Types/Cookie.purs +++ b/src/Network/HTTP/Types/Cookie.purs @@ -1,98 +1,104 @@ module Network.HTTP.Types.Cookie - ( Cookie(Cookie) - , setName - , setValue - , setDomain - , setExpires - , setHttpOnly - , setMaxAge - , setPath - , setSecure - , parse - , stringify - , stringify' - ) where - + ( Cookie(Cookie) + , setName + , setValue + , setDomain + , setExpires + , setHttpOnly + , setMaxAge + , setPath + , setSecure + , parse + , stringify + , stringify' + ) where + +import Control.Alt ((<|>)) +import Control.Monad.Except (runExcept) +import Data.DateTime (DateTime) +import Data.DateTime.Instant (Instant, instant) +import Data.Either (Either(Left, Right), either) +import Data.JSDate (toDateTime) +import Data.List (List, intercalate) +import Data.Maybe (Maybe(Just, Nothing), fromMaybe) +import Data.String.NonEmpty as NES +import Data.Time.Duration (Milliseconds(Milliseconds)) +import Foreign (Foreign, readNullOrUndefined, readUndefined, unsafeFromForeign) +import Parsing (runParser) +import Pathy (AbsDir, AbsFile, parseAbsDir, parseAbsFile, posixParser, rootDir) import Prelude - ( ($) - , (<>) - , (<$>) - , (<<<) - , (>>>) - , (>>=) - , class Show - , id - , map - , const - , show - ) - -import Control.Alt ((<|>)) -import Control.Monad.Except (runExcept) -import Data.DateTime (DateTime) -import Data.Time.Duration (Milliseconds(Milliseconds)) -import Data.DateTime.Instant (Instant, instant) -import Data.JSDate (toDateTime) -import Data.Either (Either(Left, Right), either) -import Data.Foreign - ( Foreign - , readNullOrUndefined - , readUndefined - , unsafeFromForeign - ) -import Data.List (List, intercalate) -import Data.Maybe (Maybe(Just, Nothing), fromMaybe) -import Data.Path.Pathy - ( Abs - , Unsandboxed - , parseAbsDir - , parseAbsFile - , rootDir - ) -import Data.URI (Host(NameAddress), URIPath) -import Data.URI.Host (parser) -import Text.Parsing.StringParser (runParser) + ( class Show + , const + , identity + , map + , show + , ($) + , (<$>) + , (<<<) + , (<>) + , (>>=) + , (>>>) + ) +import URI (Host(NameAddress)) +import URI.Host (parser) +import URI.Host.RegName as RegName -- | The cookie object we get back from 'parseImpl'. newtype JSCookie = JSCookie - { key :: String - , value :: String - -- You would expect the following fields to have the types that are - -- commented on them, however those are what the PureScript - -- representation of the type would be. Since JS has no types, we - -- represent them as whatever JS gives back, which is `Undefined|a`, - -- a.k.a., `Foreign`. - , domain :: Foreign -- ^ Undefined String - , expires :: Foreign -- ^ Undefined JSDate - , httpOnly :: Foreign -- ^ Undefined Boolean - , maxAge :: Foreign -- ^ Undefined Number - , path :: Foreign -- ^ Undefined String - , secure :: Foreign -- ^ Undefined Boolean - } + { key :: String + , value :: String + -- You would expect the following fields to have the types that are + -- commented on them, however those are what the PureScript + -- representation of the type would be. Since JS has no types, we + -- represent them as whatever JS gives back, which is `Undefined|a`, + -- a.k.a., `Foreign`. + , domain :: Foreign -- ^ Undefined String + , expires :: Foreign -- ^ Undefined JSDate + , httpOnly :: Foreign -- ^ Undefined Boolean + , maxAge :: Foreign -- ^ Undefined Number + , path :: Foreign -- ^ Undefined String + , secure :: Foreign -- ^ Undefined Boolean + } -- | An type that represents an HTTP Cookie. newtype Cookie = Cookie - { name :: String - , value :: String - , domain :: Maybe Host - , expires :: Maybe DateTime - , httpOnly :: Maybe Boolean - , maxAge :: Maybe Instant - , path :: URIPath Abs Unsandboxed - , secure :: Maybe Boolean - } + { name :: String + , value :: String + , domain :: Maybe Host + , expires :: Maybe DateTime + , httpOnly :: Maybe Boolean + , maxAge :: Maybe Instant + , path :: Either AbsDir AbsFile + , secure :: Maybe Boolean + } instance showCookie :: Show Cookie where - show (Cookie c) = "(Cookie {" - <> " name:" <> show c.name <> "," - <> " value:" <> show c.value <> "," - <> " domain: (" <> show c.domain <> ")," - <> " expires: (" <> show c.expires <> ")," - <> " httpOnly: (" <> show c.httpOnly <> ")," - <> " maxAge: (" <> show c.maxAge <> ")," - <> " path: (" <> show c.path <> ")," - <> " secure: (" <> show c.secure <> ")," - <> " })" + show (Cookie c) = "(Cookie {" + <> " name:" + <> show c.name + <> "," + <> " value:" + <> show c.value + <> "," + <> " domain: (" + <> show c.domain + <> ")," + <> " expires: (" + <> show c.expires + <> ")," + <> " httpOnly: (" + <> show c.httpOnly + <> ")," + <> " maxAge: (" + <> show c.maxAge + <> ")," + <> " path: (" + <> show c.path + <> ")," + <> " secure: (" + <> show c.secure + <> ")," + <> " })" setName :: String -> Cookie -> Cookie setName name (Cookie c) = Cookie c { name = name } @@ -112,7 +118,7 @@ setHttpOnly httpOnly (Cookie c) = Cookie c { httpOnly = Just httpOnly } setMaxAge :: Instant -> Cookie -> Cookie setMaxAge maxAge (Cookie c) = Cookie c { maxAge = Just maxAge } -setPath :: URIPath Abs Unsandboxed -> Cookie -> Cookie +setPath :: Either AbsDir AbsFile -> Cookie -> Cookie setPath path (Cookie c) = Cookie c { path = path } setSecure :: Boolean -> Cookie -> Cookie @@ -121,23 +127,33 @@ setSecure secure (Cookie c) = Cookie c { secure = Just secure } -- | Converts a 'JSCookie' to a PureScript 'Cookie'. toCookie :: JSCookie -> Cookie toCookie (JSCookie c) = Cookie - { name : c.key - , value : c.value - -- XXX If a host can't be parsed, just convert the string domain value into a NameAddress and return it; - -- but maybe we should throw here? - , domain : (\d -> either (const $ NameAddress d) id $ runParser parser d) <$> fromUndefined c.domain - , expires : fromUndefined c.expires >>= toDateTime - , httpOnly: fromUndefined c.httpOnly - , maxAge : fromUndefined c.maxAge >>= (Milliseconds >>> instant) - , path : fromMaybe (Left rootDir) $ fromNullOrUndefined c.path >>= \p -> (Left <$> parseAbsDir p) <|> (Right <$> parseAbsFile p) - , secure : fromUndefined c.secure - } - where - -- This `unsafeFromForeign` here means we're always trusting tough-cookie to parse values properly; - -- I think that's a pretty safe assumption. - fromUndefined :: forall a. Foreign -> Maybe a - fromUndefined = either (const Nothing) (unsafeFromForeign <$> _) <<< runExcept <<< readUndefined - fromNullOrUndefined = either (const Nothing) (unsafeFromForeign <$> _) <<< runExcept <<< readNullOrUndefined + { name: c.key + , value: c.value + -- XXX If a host can't be parsed, just convert the string domain value into a NameAddress and return it; + -- but maybe we should throw here? + , domain: + ( \d -> either (const $ NameAddress $ RegName.fromString d) identity $ + runParser (NES.toString d) parser + ) + <$> + (fromUndefined c.domain >>= NES.fromString) + , expires: fromUndefined c.expires >>= toDateTime + , httpOnly: fromUndefined c.httpOnly + , maxAge: fromUndefined c.maxAge >>= (Milliseconds >>> instant) + , path: fromMaybe (Left rootDir) $ fromNullOrUndefined c.path >>= \p -> + (Left <$> parseAbsDir posixParser p) <|> + (Right <$> parseAbsFile posixParser p) + , secure: fromUndefined c.secure + } + where + -- This `unsafeFromForeign` here means we're always trusting tough-cookie to parse values properly; + -- I think that's a pretty safe assumption. + fromUndefined :: forall a. Foreign -> Maybe a + fromUndefined = either (const Nothing) (unsafeFromForeign <$> _) <<< runExcept + <<< readUndefined + fromNullOrUndefined = either (const Nothing) (unsafeFromForeign <$> _) + <<< runExcept + <<< readNullOrUndefined foreign import parseImpl :: String -> JSCookie @@ -155,4 +171,4 @@ stringify (Cookie { name, value }) = name <> "=" <> value -- | myCookieList` as special processing is needed to convert a 'List' of -- | 'Cookie's into a RFC-compliant Cookie header value string. stringify' :: List Cookie -> String -stringify' = map stringify >>> intercalate ";" +stringify' = map stringify >>> intercalate ";" \ No newline at end of file diff --git a/src/Network/HTTP/Types/Exchange.purs b/src/Network/HTTP/Types/Exchange.purs index fda90bd..9777621 100644 --- a/src/Network/HTTP/Types/Exchange.purs +++ b/src/Network/HTTP/Types/Exchange.purs @@ -1,177 +1,216 @@ module Network.HTTP.Types.Exchange - ( Auth(BasicAuth) - , Request(Request) - , Response(Response) - , http - , https - , defURI - , defRequest - , defRequest' - , makeQuery - , makeQuery' - , joinQuery - , basicAuth - , setUser - , setPassword - , setProtocol - , setHostname - , setPort - , modifyPath - , setPath - , modifyQuery - , setQuery - , modifyFragment - , setFragment - , setURI - , setMethod - , setHeaders - , setCookies - , setAuth - , setBody - , setTimeout - , uriToRequest' - , uriToRequest - , uriToRequest'' - , get - , post - , postWithBody - , put - , putWithBody - , patch - , patchWithBody - , delete - , setResponseStatusCode - , setResponseHeaders - , setResponseBody - , setResponseCookies - , fromJSONWith - ) where + ( Auth(BasicAuth) + , Request(Request) + , Response(Response) + , URI' + , http + , https + , defURI + , defRequest + , defRequest' + , makeQuery + , basicAuth + , setUser + , setPassword + , setProtocol + , setHostname + , setPort + , modifyPath + , setPath + , modifyQuery + , setQuery + , modifyFragment + , setFragment + , setURI + , setMethod + , setHeaders + , setCookies + , setAuth + , setBody + , setTimeout + , uriToRequest' + , uriToRequest + , uriToRequest'' + , get + , post + , postWithBody + , put + , putWithBody + , patch + , patchWithBody + , delete + , setResponseStatusCode + , setResponseHeaders + , setResponseBody + , setResponseCookies + , fromJSONWith + ) where import Prelude - ( ($) - , (<>) - , (<$>) - , (>>>) - , (<<<) - , (>>=) - , class Show - , const - , flip - , pure - , show - ) - -import Control.Monad.Eff.Exception (Error, error) -import Control.Monad.Error.Class (class MonadError, throwError) -import Data.Time.Duration (Milliseconds) -import Data.Either (Either(Left), either) -import Data.List (List, singleton) -import Data.Maybe (Maybe(Just, Nothing)) -import Data.Monoid (mempty) -import Data.Path.Pathy (rootDir) -import Data.Tuple (Tuple(Tuple)) -import Data.URI (Authority(Authority), Fragment, Host(NameAddress) - , HierarchicalPart(HierarchicalPart), Port(..), Query(Query), Scheme(Scheme) - , URIPathAbs, URI(URI)) -import Data.URI.URI (parse) -import Text.Parsing.StringParser (ParseError(ParseError)) - -import Network.HTTP.Types.Cookie (Cookie) -import Network.HTTP.Types.Header (Headers) -import Network.HTTP.Types.Method (Method(DELETE, GET, PATCH, POST ,PUT)) + +import Control.Alt ((<|>)) +import Control.Monad.Error.Class (class MonadError, throwError) +import Data.Either (Either(..), either) +import Data.List (List) +import Data.Map as Map +import Data.Maybe (Maybe(Just, Nothing)) +import Data.String.NonEmpty (nes) +import Data.Time.Duration (Milliseconds) +import Data.Tuple (Tuple(Tuple)) +import Effect.Exception (Error, error) +import Network.HTTP.Types.Cookie (Cookie) +import Network.HTTP.Types.Header (Headers) +import Network.HTTP.Types.Method (Method(DELETE, GET, PATCH, POST, PUT)) import Network.HTTP.Types.StatusCode (StatusCode) +import Parsing (Parser, parseErrorMessage, runParser) +import Parsing.Combinators (optionMaybe) +import Parsing.Combinators.Array (many) +import Pathy (AbsDir, AbsFile, parseAbsDir, parseAbsFile, posixParser, rootDir) +import Type.Proxy (Proxy(..)) +import URI + ( Authority(Authority) + , Fragment + , HierPath + , HierarchicalPart(..) + , Host(NameAddress) + , Port + , Query + , Scheme + , URI(URI) + , UserInfo + ) +import URI.Host as Host +import URI.Host.RegName as RegName +import URI.Path as Path +import URI.Port as Port +import URI.Query as Query +import URI.Scheme as Scheme +import URI.URI (parser) -- | A type that represents an HTTP Authentication Scheme. data Auth = BasicAuth (Maybe String) (Maybe String) instance showAuth :: Show Auth where - show (BasicAuth user password) = - "(BasicAuth " <> show user <> " " <> show password <> " )" + show (BasicAuth user password) = + "(BasicAuth " <> show user <> " " <> show password <> " )" + +type URI' = URI UserInfo (Array (Tuple Host (Maybe Port))) + (Maybe (Either AbsDir AbsFile)) + HierPath + Query + Fragment -- | A type that represents an HTTP Request. newtype Request = Request - { uri :: URI - , method :: Method - , headers :: Headers - , cookies :: List Cookie - , auth :: Maybe Auth -- ^ If Auth information is provided in both the request.uri and request.auth, the auth in request.auth is preferred. - , body :: String - , timeout :: Maybe Milliseconds - } + { uri :: URI' + , method :: Method + , headers :: Headers + , cookies :: List Cookie + , auth :: + Maybe Auth -- ^ If Auth information is provided in both the request.uri and request.auth, the auth in request.auth is preferred. + , body :: String + , timeout :: Maybe Milliseconds + } instance showRequest :: Show Request where - show (Request r) = "(Request {" - <> " uri: (" <> show r.uri <> ")," - <> " method: (" <> show r.method <> ")," - <> " headers: (" <> show r.headers <> ")," - <> " cookies: (" <> show r.cookies <> ")," - <> " auth: (" <> show r.auth <> ")," - <> " body:" <> show r.body <> "," - <> " timeout: (" <> show r.timeout <> ")," - <> " })" + show (Request r) = "(Request {" + <> " uri: (" + <> show r.uri + <> ")," + <> " method: (" + <> show r.method + <> ")," + <> " headers: (" + <> show r.headers + <> ")," + <> " cookies: (" + <> show r.cookies + <> ")," + <> " auth: (" + <> show r.auth + <> ")," + <> " body:" + <> show r.body + <> "," + <> " timeout: (" + <> show r.timeout + <> ")," + <> " })" -- | A type that represents an HTTP Response. newtype Response = Response - { statusCode :: StatusCode - , headers :: Headers - , body :: String - , cookies :: List Cookie - } + { statusCode :: StatusCode + , headers :: Headers + , body :: String + , cookies :: List Cookie + } instance showResponse :: Show Response where - show (Response r) = "(Response {" - <> " statusCode: (" <> show r.statusCode <> ")," - <> " headers: (" <> show r.headers <> ")," - <> " body:" <> show r.body <> "," - <> " cookies: (" <> show r.cookies <> ")," - <> " })" + show (Response r) = "(Response {" + <> " statusCode: (" + <> show r.statusCode + <> ")," + <> " headers: (" + <> show r.headers + <> ")," + <> " body:" + <> show r.body + <> "," + <> " cookies: (" + <> show r.cookies + <> ")," + <> " })" -- | A Scheme set to `http:`. http :: Scheme -http = Scheme "http" +http = Scheme.unsafeFromString "http" -- | A Scheme set to `https:`. https :: Scheme -https = Scheme "https" +https = Scheme.unsafeFromString "https" -- | A 'default' base url useful for constructing requests. Equivalent to -- | . -defURI :: URI +defURI :: URI' defURI = URI - (Just http) - (HierarchicalPart - (Just - (Authority - Nothing - [(Tuple (NameAddress "localhost") (Just $ Port 80))] - ) - ) - (Just (Left rootDir)) - ) - Nothing - Nothing + http + ( HierarchicalPartAuth + ( Authority + Nothing + [ ( Tuple + ( NameAddress $ RegName.fromString $ nes + (Proxy :: _ "localhost") + ) + (Just $ Port.unsafeFromInt 80) + ) + ] + ) + (Just (Left rootDir)) + ) + Nothing + Nothing -- | A 'default' record useful for constructing requests. Equivalent to a -- | request that is sent to with the GET method, no -- | headers, cookies, authentication, body or timeout. -defRequest :: - { uri :: URI - , method :: Method - , headers :: Headers - , cookies :: List Cookie - , auth :: Maybe Auth - , body :: String - , timeout :: Maybe Milliseconds - } +defRequest + :: { uri :: URI' + , method :: Method + , headers :: Headers + , cookies :: List Cookie + , auth :: Maybe Auth + , body :: String + , timeout :: Maybe Milliseconds + } defRequest = - { uri : defURI - , method : GET - , headers: mempty - , cookies: mempty - , auth : Nothing - , body : "" - , timeout: Nothing - } + { uri: defURI + , method: GET + , headers: Map.empty + , cookies: mempty + , auth: Nothing + , body: "" + , timeout: Nothing + } -- | A 'default' request useful for constructing requests. It wraps the -- | 'defRequest' record with the 'Request' constructor. @@ -181,17 +220,7 @@ defRequest' = Request defRequest -- | Constructs a query string from a pair (e.g.: `makeQuery animal cat` == -- | `?animal=cat`). makeQuery :: String -> String -> Query -makeQuery key = Query <<< singleton <<< Tuple key <<< Just - --- | Constructs a query string from a single string (e.g.: `makeQuery' hungry` == --- | `?hungry`). -makeQuery' :: String -> Query -makeQuery' = Query <<< singleton <<< flip Tuple Nothing - --- | Kinda-sorta like a Monoid over Query; combines two queries (e.q.: ` --- | joinQuery (?animal=cat) (?hungry)` == `?hungry&animal=cat`). -joinQuery :: Query -> Query -> Query -joinQuery (Query l1) (Query l2) = Query (l1 <> l2) +makeQuery key value = Query.fromString $ key <> "=" <> value -- | Constructs a 'BasicAuth' from two strings. The same as the constructor, -- | only it wraps the strings in `Just` first. @@ -205,44 +234,73 @@ setPassword :: String -> Auth -> Auth setPassword password (BasicAuth u _) = BasicAuth u (Just password) setProtocol :: Scheme -> Request -> Request -setProtocol protocol (Request r@{ uri: (URI uriScheme h q f) }) = - Request r { uri = URI (Just protocol) h q f } +setProtocol protocol (Request r@{ uri: (URI _uriScheme h q f) }) = + Request r { uri = URI protocol h q f } setHostname :: Host -> Request -> Request -setHostname hostname (Request r@{ uri: (URI s (HierarchicalPart (Just (Authority u [(Tuple _ p)])) u') q f) }) = - Request r { uri = URI s (HierarchicalPart (Just (Authority u [(Tuple hostname p)])) u') q f } +setHostname + hostname + ( Request + r@ + { uri: + ( URI s (HierarchicalPartAuth (Authority u [ (Tuple _ p) ]) u') q + f + ) + } + ) = + Request r + { uri = URI s + (HierarchicalPartAuth (Authority u [ (Tuple hostname p) ]) u') + q + f + } setHostname _ r = r setPort :: Port -> Request -> Request -setPort port (Request r@{ uri: (URI s (HierarchicalPart (Just (Authority u [(Tuple h _)])) u') q f) }) = - Request r { uri = URI s (HierarchicalPart (Just (Authority u [(Tuple h (Just port))])) u') q f } +setPort + port + ( Request + r@ + { uri: + ( URI s (HierarchicalPartAuth (Authority u [ (Tuple h _) ]) u') q + f + ) + } + ) = + Request r + { uri = URI s + (HierarchicalPartAuth (Authority u [ (Tuple h (Just port)) ]) u') + q + f + } setPort _ r = r -modifyPath :: (URIPathAbs -> URIPathAbs) -> Request -> Request -modifyPath fn (Request r@{ uri: (URI s (HierarchicalPart a (Just u)) q f) }) = - Request r { uri = URI s (HierarchicalPart a (Just $ fn u)) q f } -modifyPath _ r = r +modifyPath + :: (Either AbsDir AbsFile -> Either AbsDir AbsFile) -> Request -> Request +modifyPath fn (Request r@{ uri: (URI s (HierarchicalPartAuth a (Just u)) q f) }) = + Request r { uri = URI s (HierarchicalPartAuth a (Just $ fn u)) q f } +modifyPath _ r = r -setPath :: URIPathAbs -> Request -> Request +setPath :: Either AbsDir AbsFile -> Request -> Request setPath = modifyPath <<< const modifyQuery :: (Query -> Query) -> Request -> Request modifyQuery fn (Request r@{ uri: (URI s h (Just q) f) }) = - Request r { uri = URI s h (Just $ fn q) f } + Request r { uri = URI s h (Just $ fn q) f } modifyQuery _ r = r setQuery :: Query -> Request -> Request setQuery = modifyQuery <<< const modifyFragment :: (Fragment -> Fragment) -> Request -> Request -modifyFragment fn (Request r@{uri: (URI s h q (Just f)) }) = - Request r { uri = URI s h q (Just $ fn f) } -modifyFragment _ r = r +modifyFragment fn (Request r@{ uri: (URI s h q (Just f)) }) = + Request r { uri = URI s h q (Just $ fn f) } +modifyFragment _ r = r setFragment :: Fragment -> Request -> Request setFragment = modifyFragment <<< const -setURI :: URI -> Request -> Request +setURI :: URI' -> Request -> Request setURI uri (Request r) = Request r { uri = uri } setMethod :: Method -> Request -> Request @@ -265,24 +323,37 @@ setTimeout timeout (Request r) = Request r { timeout = Just timeout } -- | Constructs a 'Request' from a 'URI'. The request has all of the values of -- | 'defRequest', with the URI set to the passed parameter. -uriToRequest' :: URI -> Request +uriToRequest' :: URI' -> Request uriToRequest' uri = Request defRequest { uri = uri } +uriParser :: Parser String URI' +uriParser = + parser + { parseFragment: pure + , parseHierPath: pure + , parseHosts: many $ Tuple <$> Host.parser <*> optionMaybe Port.parser + , parsePath: + ( \p -> pure $ (Left <$> parseAbsDir posixParser p) <|> + (Right <$> parseAbsFile posixParser p) + ) <<< Path.print + , parseQuery: pure + , parseUserInfo: pure + } + -- | Constructs a 'Request' from a uri string. The request has all of the -- | values of 'defRequest', with the URI set to the passed parameter. If the -- | uri string could not be parsed, the parsing error is thrown. uriToRequest :: forall m. MonadError Error m => String -> m Request -uriToRequest = parse >>> - either (extractErrorMessage >>> error >>> throwError) - (uriToRequest' >>> pure) - where - extractErrorMessage (ParseError msg) = msg +uriToRequest = flip runParser uriParser >>> + either (parseErrorMessage >>> error >>> throwError) + (uriToRequest' >>> pure) -- | Constructs a 'Request' from a uri string. The request has all of the -- | values of 'defRequest', with the URI set to the passed parameter. If the -- | uri string could not be parsed, `Nothing` is returned. uriToRequest'' :: String -> Maybe Request -uriToRequest'' = parse >>> either (const Nothing) (uriToRequest' >>> pure) +uriToRequest'' = flip runParser uriParser >>> either (const Nothing) + (uriToRequest' >>> pure) -- | Constructs a 'Request' from a uri string. The request has all of the -- | values of 'defRequest', with the URI set to the passed parameter, and the @@ -341,7 +412,8 @@ delete :: forall m. MonadError Error m => String -> m Request delete uri = setMethod DELETE <$> uriToRequest uri setResponseStatusCode :: StatusCode -> Response -> Response -setResponseStatusCode statusCode (Response r) = Response r { statusCode = statusCode } +setResponseStatusCode statusCode (Response r) = Response r + { statusCode = statusCode } setResponseHeaders :: Headers -> Response -> Response setResponseHeaders headers (Response r) = Response r { headers = headers } @@ -359,12 +431,15 @@ setResponseCookies cookies (Response r) = Response r { cookies = cookies } -- | The given function is expected to take the string body, and return a `Show -- | errmsg => m (Left errmsg)` if the conversion fails, or a `m (Right a)` if -- | the conversion is successful (where `m` is our `MonadError Error m`). -fromJSONWith' :: forall m a e. MonadError Error m => Show e => - (String -> m (Either e a)) -> - Response -> - m a +fromJSONWith' + :: forall m a e + . MonadError Error m + => Show e + => (String -> m (Either e a)) + -> Response + -> m a fromJSONWith' fn (Response r) = - fn r.body >>= either (throwError <<< error <<< show) pure + fn r.body >>= either (throwError <<< error <<< show) pure -- | Takes a completed 'Response', extracts its string body, and converts that -- | to our desired type using the given function. Throws an error if the @@ -373,8 +448,11 @@ fromJSONWith' fn (Response r) = -- | The given function is expected to take the string body, and return a `Show -- | errmsg => Left errmsg` if the conversion fails, or a `Right a` if the -- | conversion is successful. -fromJSONWith :: forall m a e. MonadError Error m => Show e => - (String -> Either e a) -> - Response -> - m a +fromJSONWith + :: forall m a e + . MonadError Error m + => Show e + => (String -> Either e a) + -> Response + -> m a fromJSONWith fn = fromJSONWith' (pure <<< fn) diff --git a/src/Network/HTTP/Types/Header.purs b/src/Network/HTTP/Types/Header.purs index d5c5b75..08bdfb1 100644 --- a/src/Network/HTTP/Types/Header.purs +++ b/src/Network/HTTP/Types/Header.purs @@ -1,142 +1,141 @@ module Network.HTTP.Types.Header - ( HeaderValue(HVStr, HVList) - , HeaderName - ( AIM - , Accept - , AcceptAdditions - , AcceptCharset - , AcceptEncoding - , AcceptFeatures - , AcceptLanguage - , AcceptRanges - , Age - , Allow - , Alternates - , AuthenticationInfo - , Authorization - , CExt - , CMan - , COpt - , CPEP - , CPEPInfo - , CacheControl - , Connection - , ContentBase - , ContentDisposition - , ContentEncoding - , ContentID - , ContentLanguage - , ContentLength - , ContentLocation - , ContentMD5 - , ContentRange - , ContentScriptType - , ContentStyleType - , ContentType - , ContentVersion - , Cookie - , Cookie2 - , DAV - , Date - , DefaultStyle - , DeltaBase - , Depth - , DerivedFrom - , Destination - , DifferentialID - , Digest - , ETag - , Expect - , Expires - , Ext - , From - , GetProfile - , Host - , IM - , If - , IfMatch - , IfModifiedSince - , IfNoneMatch - , IfRange - , IfUnmodifiedSince - , KeepAlive - , Label - , LastModified - , Link - , Location - , LockToken - , MIMEVersion - , Man - , MaxForwards - , Meter - , Negotiate - , Opt - , OrderingType - , Overwrite - , P3P - , PEP - , PICSLabel - , PepInfo - , Position - , Pragma - , ProfileObject - , Protocol - , ProtocolInfo - , ProtocolQuery - , ProtocolRequest - , ProxyAuthenticate - , ProxyAuthenticationInfo - , ProxyAuthorization - , ProxyFeatures - , ProxyInstruction - , Public - , Range - , Referer - , RetryAfter - , Safe - , SecurityScheme - , Server - , SetCookie - , SetCookie2 - , SetProfile - , SoapAction - , StatusURI - , SurrogateCapability - , SurrogateControl - , TCN - , TE - , Timeout - , Trailer - , TransferEncoding - , URI - , Upgrade - , UserAgent - , VariantVary - , Vary - , Via - , WWWAuthenticate - , WantDigest - , Warning - , Custom - ) - , Headers - , headerNameFromString - ) where - -import Prelude - ( (==) - , (<>) - , class Eq - , class Ord - , class Show - , Ordering(GT, LT) - , compare - , show - ) + ( HeaderValue(HVStr, HVList) + , HeaderName + ( AIM + , Accept + , AcceptAdditions + , AcceptCharset + , AcceptEncoding + , AcceptFeatures + , AcceptLanguage + , AcceptRanges + , Age + , Allow + , Alternates + , AuthenticationInfo + , Authorization + , CExt + , CMan + , COpt + , CPEP + , CPEPInfo + , CacheControl + , Connection + , ContentBase + , ContentDisposition + , ContentEncoding + , ContentID + , ContentLanguage + , ContentLength + , ContentLocation + , ContentMD5 + , ContentRange + , ContentScriptType + , ContentStyleType + , ContentType + , ContentVersion + , Cookie + , Cookie2 + , DAV + , Date + , DefaultStyle + , DeltaBase + , Depth + , DerivedFrom + , Destination + , DifferentialID + , Digest + , ETag + , Expect + , Expires + , Ext + , From + , GetProfile + , Host + , IM + , If + , IfMatch + , IfModifiedSince + , IfNoneMatch + , IfRange + , IfUnmodifiedSince + , KeepAlive + , Label + , LastModified + , Link + , Location + , LockToken + , MIMEVersion + , Man + , MaxForwards + , Meter + , Negotiate + , Opt + , OrderingType + , Overwrite + , P3P + , PEP + , PICSLabel + , PepInfo + , Position + , Pragma + , ProfileObject + , Protocol + , ProtocolInfo + , ProtocolQuery + , ProtocolRequest + , ProxyAuthenticate + , ProxyAuthenticationInfo + , ProxyAuthorization + , ProxyFeatures + , ProxyInstruction + , Public + , Range + , Referer + , RetryAfter + , Safe + , SecurityScheme + , Server + , SetCookie + , SetCookie2 + , SetProfile + , SoapAction + , StatusURI + , SurrogateCapability + , SurrogateControl + , TCN + , TE + , Timeout + , Trailer + , TransferEncoding + , URI + , Upgrade + , UserAgent + , VariantVary + , Vary + , Via + , WWWAuthenticate + , WantDigest + , Warning + , Custom + ) + , Headers + , headerNameFromString + ) where import Data.List.NonEmpty (NonEmptyList) -import Data.Map (Map) -import Data.String (toLower) +import Data.Map (Map) +import Data.String (toLower) +import Prelude + ( class Eq + , class Ord + , class Show + , Ordering(GT, LT) + , compare + , show + , (<>) + , (==) + ) -- | A header value is either a string by itself (e.g.: `'text/html; -- | charset=UTF-8'`), or a non-empty list of strings in the case of a @@ -145,389 +144,390 @@ import Data.String (toLower) data HeaderValue = HVStr String | HVList (NonEmptyList String) instance showHeaderValue :: Show HeaderValue where - show (HVStr s) = "HVStr " <> s - show (HVList ss) = "HVList (" <> show ss <> ")" + show (HVStr s) = "HVStr " <> s + show (HVList ss) = "HVList (" <> show ss <> ")" instance eqHeaderValue :: Eq HeaderValue where - eq (HVStr s1) (HVStr s2) = s1 == s2 - eq (HVStr _) (HVList _) = false - eq (HVList l1) (HVList l2) = l1 == l2 - eq (HVList _) (HVStr _) = false + eq (HVStr s1) (HVStr s2) = s1 == s2 + eq (HVStr _) (HVList _) = false + eq (HVList l1) (HVList l2) = l1 == l2 + eq (HVList _) (HVStr _) = false instance ordHeaderValue :: Ord HeaderValue where - compare (HVStr s1) (HVStr s2) = compare s1 s2 - compare (HVStr _) (HVList _) = LT -- Strings are "less than" Lists. - compare (HVList l1) (HVList l2) = compare l1 l2 - compare (HVList _) (HVStr _) = GT -- Lists are "greater than" Strings. + compare (HVStr s1) (HVStr s2) = compare s1 s2 + compare (HVStr _) (HVList _) = LT -- Strings are "less than" Lists. + compare (HVList l1) (HVList l2) = compare l1 l2 + compare (HVList _) (HVStr _) = GT -- Lists are "greater than" Strings. -- | A list of standard headers. If it's non-standard, use the -- | 'Custom' constructor. -data HeaderName = AIM - | Accept - | AcceptAdditions - | AcceptCharset - | AcceptEncoding - | AcceptFeatures - | AcceptLanguage - | AcceptRanges - | Age - | Allow - | Alternates - | AuthenticationInfo - | Authorization - | CExt - | CMan - | COpt - | CPEP - | CPEPInfo - | CacheControl - | Connection - | ContentBase - | ContentDisposition - | ContentEncoding - | ContentID - | ContentLanguage - | ContentLength - | ContentLocation - | ContentMD5 - | ContentRange - | ContentScriptType - | ContentStyleType - | ContentType - | ContentVersion - | Cookie - | Cookie2 - | DAV - | Date - | DefaultStyle - | DeltaBase - | Depth - | DerivedFrom - | Destination - | DifferentialID - | Digest - | ETag - | Expect - | Expires - | Ext - | From - | GetProfile - | Host - | IM - | If - | IfMatch - | IfModifiedSince - | IfNoneMatch - | IfRange - | IfUnmodifiedSince - | KeepAlive - | Label - | LastModified - | Link - | Location - | LockToken - | MIMEVersion - | Man - | MaxForwards - | Meter - | Negotiate - | Opt - | OrderingType - | Overwrite - | P3P - | PEP - | PICSLabel - | PepInfo - | Position - | Pragma - | ProfileObject - | Protocol - | ProtocolInfo - | ProtocolQuery - | ProtocolRequest - | ProxyAuthenticate - | ProxyAuthenticationInfo - | ProxyAuthorization - | ProxyFeatures - | ProxyInstruction - | Public - | Range - | Referer - | RetryAfter - | Safe - | SecurityScheme - | Server - | SetCookie - | SetCookie2 - | SetProfile - | SoapAction - | StatusURI - | SurrogateCapability - | SurrogateControl - | TCN - | TE - | Timeout - | Trailer - | TransferEncoding - | URI - | Upgrade - | UserAgent - | VariantVary - | Vary - | Via - | WWWAuthenticate - | WantDigest - | Warning - | Custom String +data HeaderName + = AIM + | Accept + | AcceptAdditions + | AcceptCharset + | AcceptEncoding + | AcceptFeatures + | AcceptLanguage + | AcceptRanges + | Age + | Allow + | Alternates + | AuthenticationInfo + | Authorization + | CExt + | CMan + | COpt + | CPEP + | CPEPInfo + | CacheControl + | Connection + | ContentBase + | ContentDisposition + | ContentEncoding + | ContentID + | ContentLanguage + | ContentLength + | ContentLocation + | ContentMD5 + | ContentRange + | ContentScriptType + | ContentStyleType + | ContentType + | ContentVersion + | Cookie + | Cookie2 + | DAV + | Date + | DefaultStyle + | DeltaBase + | Depth + | DerivedFrom + | Destination + | DifferentialID + | Digest + | ETag + | Expect + | Expires + | Ext + | From + | GetProfile + | Host + | IM + | If + | IfMatch + | IfModifiedSince + | IfNoneMatch + | IfRange + | IfUnmodifiedSince + | KeepAlive + | Label + | LastModified + | Link + | Location + | LockToken + | MIMEVersion + | Man + | MaxForwards + | Meter + | Negotiate + | Opt + | OrderingType + | Overwrite + | P3P + | PEP + | PICSLabel + | PepInfo + | Position + | Pragma + | ProfileObject + | Protocol + | ProtocolInfo + | ProtocolQuery + | ProtocolRequest + | ProxyAuthenticate + | ProxyAuthenticationInfo + | ProxyAuthorization + | ProxyFeatures + | ProxyInstruction + | Public + | Range + | Referer + | RetryAfter + | Safe + | SecurityScheme + | Server + | SetCookie + | SetCookie2 + | SetProfile + | SoapAction + | StatusURI + | SurrogateCapability + | SurrogateControl + | TCN + | TE + | Timeout + | Trailer + | TransferEncoding + | URI + | Upgrade + | UserAgent + | VariantVary + | Vary + | Via + | WWWAuthenticate + | WantDigest + | Warning + | Custom String instance showHeaderName :: Show HeaderName where - show AIM = "A-IM" - show Accept = "Accept" - show AcceptAdditions = "Accept-Additions" - show AcceptCharset = "Accept-Charset" - show AcceptEncoding = "Accept-Encoding" - show AcceptFeatures = "Accept-Features" - show AcceptLanguage = "Accept-Language" - show AcceptRanges = "Accept-Ranges" - show Age = "Age" - show Allow = "Allow" - show Alternates = "Alternates" - show AuthenticationInfo = "Authentication-Info" - show Authorization = "Authorization" - show CExt = "C-Ext" - show CMan = "C-Man" - show COpt = "C-Opt" - show CPEP = "C-PEP" - show CPEPInfo = "C-PEP-Info" - show CacheControl = "Cache-Control" - show Connection = "Connection" - show ContentBase = "Content-Base" - show ContentDisposition = "Content-Disposition" - show ContentEncoding = "Content-Encoding" - show ContentID = "Content-ID" - show ContentLanguage = "Content-Language" - show ContentLength = "Content-Length" - show ContentLocation = "Content-Location" - show ContentMD5 = "Content-MD5" - show ContentRange = "Content-Range" - show ContentScriptType = "Content-Script-Type" - show ContentStyleType = "Content-Style-Type" - show ContentType = "Content-Type" - show ContentVersion = "Content-Version" - show Cookie = "Cookie" - show Cookie2 = "Cookie2" - show DAV = "DAV" - show Date = "Date" - show DefaultStyle = "Default-Style" - show DeltaBase = "Delta-Base" - show Depth = "Depth" - show DerivedFrom = "Derived-From" - show Destination = "Destination" - show DifferentialID = "Differential-ID" - show Digest = "Digest" - show ETag = "ETag" - show Expect = "Expect" - show Expires = "Expires" - show Ext = "Ext" - show From = "From" - show GetProfile = "GetProfile" - show Host = "Host" - show IM = "IM" - show If = "If" - show IfMatch = "If-Match" - show IfModifiedSince = "If-Modified-Since" - show IfNoneMatch = "If-None-Match" - show IfRange = "If-Range" - show IfUnmodifiedSince = "If-Unmodified-Since" - show KeepAlive = "Keep-Alive" - show Label = "Label" - show LastModified = "Last-Modified" - show Link = "Link" - show Location = "Location" - show LockToken = "Lock-Token" - show MIMEVersion = "MIME-Version" - show Man = "Man" - show MaxForwards = "Max-Forwards" - show Meter = "Meter" - show Negotiate = "Negotiate" - show Opt = "Opt" - show OrderingType = "Ordering-Type" - show Overwrite = "Overwrite" - show P3P = "P3P" - show PEP = "PEP" - show PICSLabel = "PICS-Label" - show PepInfo = "Pep-Info" - show Position = "Position" - show Pragma = "Pragma" - show ProfileObject = "ProfileObject" - show Protocol = "Protocol" - show ProtocolInfo = "Protocol-Info" - show ProtocolQuery = "Protocol-Query" - show ProtocolRequest = "Protocol-Request" - show ProxyAuthenticate = "Proxy-Authenticate" - show ProxyAuthenticationInfo = "Proxy-Authentication-Info" - show ProxyAuthorization = "Proxy-Authorization" - show ProxyFeatures = "Proxy-Features" - show ProxyInstruction = "Proxy-Instruction" - show Public = "Public" - show Range = "Range" - show Referer = "Referer" - show RetryAfter = "Retry-After" - show Safe = "Safe" - show SecurityScheme = "Security-Scheme" - show Server = "Server" - show SetCookie = "Set-Cookie" - show SetCookie2 = "Set-Cookie2" - show SetProfile = "SetProfile" - show SoapAction = "SoapAction" - show StatusURI = "Status-URI" - show SurrogateCapability = "Surrogate-Capability" - show SurrogateControl = "Surrogate-Control" - show TCN = "TCN" - show TE = "TE" - show Timeout = "Timeout" - show Trailer = "Trailer" - show TransferEncoding = "Transfer-Encoding" - show URI = "URI" - show Upgrade = "Upgrade" - show UserAgent = "User-Agent" - show VariantVary = "Variant-Vary" - show Vary = "Vary" - show Via = "Via" - show WWWAuthenticate = "WWW-Authenticate" - show WantDigest = "Want-Digest" - show Warning = "Warning" - show (Custom h) = h + show AIM = "A-IM" + show Accept = "Accept" + show AcceptAdditions = "Accept-Additions" + show AcceptCharset = "Accept-Charset" + show AcceptEncoding = "Accept-Encoding" + show AcceptFeatures = "Accept-Features" + show AcceptLanguage = "Accept-Language" + show AcceptRanges = "Accept-Ranges" + show Age = "Age" + show Allow = "Allow" + show Alternates = "Alternates" + show AuthenticationInfo = "Authentication-Info" + show Authorization = "Authorization" + show CExt = "C-Ext" + show CMan = "C-Man" + show COpt = "C-Opt" + show CPEP = "C-PEP" + show CPEPInfo = "C-PEP-Info" + show CacheControl = "Cache-Control" + show Connection = "Connection" + show ContentBase = "Content-Base" + show ContentDisposition = "Content-Disposition" + show ContentEncoding = "Content-Encoding" + show ContentID = "Content-ID" + show ContentLanguage = "Content-Language" + show ContentLength = "Content-Length" + show ContentLocation = "Content-Location" + show ContentMD5 = "Content-MD5" + show ContentRange = "Content-Range" + show ContentScriptType = "Content-Script-Type" + show ContentStyleType = "Content-Style-Type" + show ContentType = "Content-Type" + show ContentVersion = "Content-Version" + show Cookie = "Cookie" + show Cookie2 = "Cookie2" + show DAV = "DAV" + show Date = "Date" + show DefaultStyle = "Default-Style" + show DeltaBase = "Delta-Base" + show Depth = "Depth" + show DerivedFrom = "Derived-From" + show Destination = "Destination" + show DifferentialID = "Differential-ID" + show Digest = "Digest" + show ETag = "ETag" + show Expect = "Expect" + show Expires = "Expires" + show Ext = "Ext" + show From = "From" + show GetProfile = "GetProfile" + show Host = "Host" + show IM = "IM" + show If = "If" + show IfMatch = "If-Match" + show IfModifiedSince = "If-Modified-Since" + show IfNoneMatch = "If-None-Match" + show IfRange = "If-Range" + show IfUnmodifiedSince = "If-Unmodified-Since" + show KeepAlive = "Keep-Alive" + show Label = "Label" + show LastModified = "Last-Modified" + show Link = "Link" + show Location = "Location" + show LockToken = "Lock-Token" + show MIMEVersion = "MIME-Version" + show Man = "Man" + show MaxForwards = "Max-Forwards" + show Meter = "Meter" + show Negotiate = "Negotiate" + show Opt = "Opt" + show OrderingType = "Ordering-Type" + show Overwrite = "Overwrite" + show P3P = "P3P" + show PEP = "PEP" + show PICSLabel = "PICS-Label" + show PepInfo = "Pep-Info" + show Position = "Position" + show Pragma = "Pragma" + show ProfileObject = "ProfileObject" + show Protocol = "Protocol" + show ProtocolInfo = "Protocol-Info" + show ProtocolQuery = "Protocol-Query" + show ProtocolRequest = "Protocol-Request" + show ProxyAuthenticate = "Proxy-Authenticate" + show ProxyAuthenticationInfo = "Proxy-Authentication-Info" + show ProxyAuthorization = "Proxy-Authorization" + show ProxyFeatures = "Proxy-Features" + show ProxyInstruction = "Proxy-Instruction" + show Public = "Public" + show Range = "Range" + show Referer = "Referer" + show RetryAfter = "Retry-After" + show Safe = "Safe" + show SecurityScheme = "Security-Scheme" + show Server = "Server" + show SetCookie = "Set-Cookie" + show SetCookie2 = "Set-Cookie2" + show SetProfile = "SetProfile" + show SoapAction = "SoapAction" + show StatusURI = "Status-URI" + show SurrogateCapability = "Surrogate-Capability" + show SurrogateControl = "Surrogate-Control" + show TCN = "TCN" + show TE = "TE" + show Timeout = "Timeout" + show Trailer = "Trailer" + show TransferEncoding = "Transfer-Encoding" + show URI = "URI" + show Upgrade = "Upgrade" + show UserAgent = "User-Agent" + show VariantVary = "Variant-Vary" + show Vary = "Vary" + show Via = "Via" + show WWWAuthenticate = "WWW-Authenticate" + show WantDigest = "Want-Digest" + show Warning = "Warning" + show (Custom h) = h instance eqHeaderName :: Eq HeaderName where - eq h1 h2 = show h1 == show h2 + eq h1 h2 = show h1 == show h2 instance ordHeaderName :: Ord HeaderName where - compare h1 h2 = compare (show h1) (show h2) + compare h1 h2 = compare (show h1) (show h2) -- | Creates a 'HeaderName' from a string. If the given string is a -- | non-standard HTTP header name, then a 'Custom' 'HeaderName' is -- | returned. headerNameFromString :: String -> HeaderName headerNameFromString s = headerNameFromString' (toLower s) - where - headerNameFromString' "a-im" = AIM - headerNameFromString' "accept" = Accept - headerNameFromString' "accept-additions" = AcceptAdditions - headerNameFromString' "accept-charset" = AcceptCharset - headerNameFromString' "accept-encoding" = AcceptEncoding - headerNameFromString' "accept-features" = AcceptFeatures - headerNameFromString' "accept-language" = AcceptLanguage - headerNameFromString' "accept-ranges" = AcceptRanges - headerNameFromString' "age" = Age - headerNameFromString' "allow" = Allow - headerNameFromString' "alternates" = Alternates - headerNameFromString' "authentication-info" = AuthenticationInfo - headerNameFromString' "authorization" = Authorization - headerNameFromString' "c-ext" = CExt - headerNameFromString' "c-man" = CMan - headerNameFromString' "c-opt" = COpt - headerNameFromString' "c-pep" = CPEP - headerNameFromString' "c-pep-info" = CPEPInfo - headerNameFromString' "cache-control" = CacheControl - headerNameFromString' "connection" = Connection - headerNameFromString' "content-base" = ContentBase - headerNameFromString' "content-disposition" = ContentDisposition - headerNameFromString' "content-encoding" = ContentEncoding - headerNameFromString' "content-id" = ContentID - headerNameFromString' "content-language" = ContentLanguage - headerNameFromString' "content-length" = ContentLength - headerNameFromString' "content-location" = ContentLocation - headerNameFromString' "content-md5" = ContentMD5 - headerNameFromString' "content-range" = ContentRange - headerNameFromString' "content-script-type" = ContentScriptType - headerNameFromString' "content-style-type" = ContentStyleType - headerNameFromString' "content-type" = ContentType - headerNameFromString' "content-version" = ContentVersion - headerNameFromString' "cookie" = Cookie - headerNameFromString' "cookie2" = Cookie2 - headerNameFromString' "dav" = DAV - headerNameFromString' "date" = Date - headerNameFromString' "default-style" = DefaultStyle - headerNameFromString' "delta-base" = DeltaBase - headerNameFromString' "depth" = Depth - headerNameFromString' "derived-from" = DerivedFrom - headerNameFromString' "destination" = Destination - headerNameFromString' "differential-id" = DifferentialID - headerNameFromString' "digest" = Digest - headerNameFromString' "etag" = ETag - headerNameFromString' "expect" = Expect - headerNameFromString' "expires" = Expires - headerNameFromString' "ext" = Ext - headerNameFromString' "from" = From - headerNameFromString' "getprofile" = GetProfile - headerNameFromString' "host" = Host - headerNameFromString' "im" = IM - headerNameFromString' "if" = If - headerNameFromString' "if-match" = IfMatch - headerNameFromString' "if-modified-since" = IfModifiedSince - headerNameFromString' "if-none-match" = IfNoneMatch - headerNameFromString' "if-range" = IfRange - headerNameFromString' "if-unmodified-since" = IfUnmodifiedSince - headerNameFromString' "keep-alive" = KeepAlive - headerNameFromString' "label" = Label - headerNameFromString' "last-modified" = LastModified - headerNameFromString' "link" = Link - headerNameFromString' "location" = Location - headerNameFromString' "lock-token" = LockToken - headerNameFromString' "mime-version" = MIMEVersion - headerNameFromString' "man" = Man - headerNameFromString' "max-forwards" = MaxForwards - headerNameFromString' "meter" = Meter - headerNameFromString' "negotiate" = Negotiate - headerNameFromString' "opt" = Opt - headerNameFromString' "ordering-type" = OrderingType - headerNameFromString' "overwrite" = Overwrite - headerNameFromString' "p3p" = P3P - headerNameFromString' "pep" = PEP - headerNameFromString' "pics-label" = PICSLabel - headerNameFromString' "pep-info" = PepInfo - headerNameFromString' "position" = Position - headerNameFromString' "pragma" = Pragma - headerNameFromString' "profileobject" = ProfileObject - headerNameFromString' "protocol" = Protocol - headerNameFromString' "protocol-info" = ProtocolInfo - headerNameFromString' "protocol-query" = ProtocolQuery - headerNameFromString' "protocol-request" = ProtocolRequest - headerNameFromString' "proxy-authenticate" = ProxyAuthenticate - headerNameFromString' "proxy-authentication-info" = ProxyAuthenticationInfo - headerNameFromString' "proxy-authorization" = ProxyAuthorization - headerNameFromString' "proxy-features" = ProxyFeatures - headerNameFromString' "proxy-instruction" = ProxyInstruction - headerNameFromString' "public" = Public - headerNameFromString' "range" = Range - headerNameFromString' "referer" = Referer - headerNameFromString' "retry-after" = RetryAfter - headerNameFromString' "safe" = Safe - headerNameFromString' "security-scheme" = SecurityScheme - headerNameFromString' "server" = Server - headerNameFromString' "set-cookie" = SetCookie - headerNameFromString' "set-cookie2" = SetCookie2 - headerNameFromString' "setprofile" = SetProfile - headerNameFromString' "soapaction" = SoapAction - headerNameFromString' "status-uri" = StatusURI - headerNameFromString' "surrogate-capability" = SurrogateCapability - headerNameFromString' "surrogate-control" = SurrogateControl - headerNameFromString' "tcn" = TCN - headerNameFromString' "te" = TE - headerNameFromString' "timeout" = Timeout - headerNameFromString' "trailer" = Trailer - headerNameFromString' "transfer-encoding" = TransferEncoding - headerNameFromString' "uri" = URI - headerNameFromString' "upgrade" = Upgrade - headerNameFromString' "user-agent" = UserAgent - headerNameFromString' "variant-vary" = VariantVary - headerNameFromString' "vary" = Vary - headerNameFromString' "via" = Via - headerNameFromString' "www-authenticate" = WWWAuthenticate - headerNameFromString' "want-digest" = WantDigest - headerNameFromString' "warning" = Warning - headerNameFromString' _ = Custom s + where + headerNameFromString' "a-im" = AIM + headerNameFromString' "accept" = Accept + headerNameFromString' "accept-additions" = AcceptAdditions + headerNameFromString' "accept-charset" = AcceptCharset + headerNameFromString' "accept-encoding" = AcceptEncoding + headerNameFromString' "accept-features" = AcceptFeatures + headerNameFromString' "accept-language" = AcceptLanguage + headerNameFromString' "accept-ranges" = AcceptRanges + headerNameFromString' "age" = Age + headerNameFromString' "allow" = Allow + headerNameFromString' "alternates" = Alternates + headerNameFromString' "authentication-info" = AuthenticationInfo + headerNameFromString' "authorization" = Authorization + headerNameFromString' "c-ext" = CExt + headerNameFromString' "c-man" = CMan + headerNameFromString' "c-opt" = COpt + headerNameFromString' "c-pep" = CPEP + headerNameFromString' "c-pep-info" = CPEPInfo + headerNameFromString' "cache-control" = CacheControl + headerNameFromString' "connection" = Connection + headerNameFromString' "content-base" = ContentBase + headerNameFromString' "content-disposition" = ContentDisposition + headerNameFromString' "content-encoding" = ContentEncoding + headerNameFromString' "content-id" = ContentID + headerNameFromString' "content-language" = ContentLanguage + headerNameFromString' "content-length" = ContentLength + headerNameFromString' "content-location" = ContentLocation + headerNameFromString' "content-md5" = ContentMD5 + headerNameFromString' "content-range" = ContentRange + headerNameFromString' "content-script-type" = ContentScriptType + headerNameFromString' "content-style-type" = ContentStyleType + headerNameFromString' "content-type" = ContentType + headerNameFromString' "content-version" = ContentVersion + headerNameFromString' "cookie" = Cookie + headerNameFromString' "cookie2" = Cookie2 + headerNameFromString' "dav" = DAV + headerNameFromString' "date" = Date + headerNameFromString' "default-style" = DefaultStyle + headerNameFromString' "delta-base" = DeltaBase + headerNameFromString' "depth" = Depth + headerNameFromString' "derived-from" = DerivedFrom + headerNameFromString' "destination" = Destination + headerNameFromString' "differential-id" = DifferentialID + headerNameFromString' "digest" = Digest + headerNameFromString' "etag" = ETag + headerNameFromString' "expect" = Expect + headerNameFromString' "expires" = Expires + headerNameFromString' "ext" = Ext + headerNameFromString' "from" = From + headerNameFromString' "getprofile" = GetProfile + headerNameFromString' "host" = Host + headerNameFromString' "im" = IM + headerNameFromString' "if" = If + headerNameFromString' "if-match" = IfMatch + headerNameFromString' "if-modified-since" = IfModifiedSince + headerNameFromString' "if-none-match" = IfNoneMatch + headerNameFromString' "if-range" = IfRange + headerNameFromString' "if-unmodified-since" = IfUnmodifiedSince + headerNameFromString' "keep-alive" = KeepAlive + headerNameFromString' "label" = Label + headerNameFromString' "last-modified" = LastModified + headerNameFromString' "link" = Link + headerNameFromString' "location" = Location + headerNameFromString' "lock-token" = LockToken + headerNameFromString' "mime-version" = MIMEVersion + headerNameFromString' "man" = Man + headerNameFromString' "max-forwards" = MaxForwards + headerNameFromString' "meter" = Meter + headerNameFromString' "negotiate" = Negotiate + headerNameFromString' "opt" = Opt + headerNameFromString' "ordering-type" = OrderingType + headerNameFromString' "overwrite" = Overwrite + headerNameFromString' "p3p" = P3P + headerNameFromString' "pep" = PEP + headerNameFromString' "pics-label" = PICSLabel + headerNameFromString' "pep-info" = PepInfo + headerNameFromString' "position" = Position + headerNameFromString' "pragma" = Pragma + headerNameFromString' "profileobject" = ProfileObject + headerNameFromString' "protocol" = Protocol + headerNameFromString' "protocol-info" = ProtocolInfo + headerNameFromString' "protocol-query" = ProtocolQuery + headerNameFromString' "protocol-request" = ProtocolRequest + headerNameFromString' "proxy-authenticate" = ProxyAuthenticate + headerNameFromString' "proxy-authentication-info" = ProxyAuthenticationInfo + headerNameFromString' "proxy-authorization" = ProxyAuthorization + headerNameFromString' "proxy-features" = ProxyFeatures + headerNameFromString' "proxy-instruction" = ProxyInstruction + headerNameFromString' "public" = Public + headerNameFromString' "range" = Range + headerNameFromString' "referer" = Referer + headerNameFromString' "retry-after" = RetryAfter + headerNameFromString' "safe" = Safe + headerNameFromString' "security-scheme" = SecurityScheme + headerNameFromString' "server" = Server + headerNameFromString' "set-cookie" = SetCookie + headerNameFromString' "set-cookie2" = SetCookie2 + headerNameFromString' "setprofile" = SetProfile + headerNameFromString' "soapaction" = SoapAction + headerNameFromString' "status-uri" = StatusURI + headerNameFromString' "surrogate-capability" = SurrogateCapability + headerNameFromString' "surrogate-control" = SurrogateControl + headerNameFromString' "tcn" = TCN + headerNameFromString' "te" = TE + headerNameFromString' "timeout" = Timeout + headerNameFromString' "trailer" = Trailer + headerNameFromString' "transfer-encoding" = TransferEncoding + headerNameFromString' "uri" = URI + headerNameFromString' "upgrade" = Upgrade + headerNameFromString' "user-agent" = UserAgent + headerNameFromString' "variant-vary" = VariantVary + headerNameFromString' "vary" = Vary + headerNameFromString' "via" = Via + headerNameFromString' "www-authenticate" = WWWAuthenticate + headerNameFromString' "want-digest" = WantDigest + headerNameFromString' "warning" = Warning + headerNameFromString' _ = Custom s -- | A type alias for a group of HTTP headers. type Headers = Map HeaderName HeaderValue diff --git a/src/Network/HTTP/Types/Method.purs b/src/Network/HTTP/Types/Method.purs index 8e7c62a..a3fc027 100644 --- a/src/Network/HTTP/Types/Method.purs +++ b/src/Network/HTTP/Types/Method.purs @@ -1,61 +1,62 @@ module Network.HTTP.Types.Method - ( Method - ( GET - , HEAD - , POST - , PUT - , DELETE - , CONNECT - , OPTIONS - , TRACE - , PATCH - , Custom - ) - , methodFromString - ) where + ( Method + ( GET + , HEAD + , POST + , PUT + , DELETE + , CONNECT + , OPTIONS + , TRACE + , PATCH + , Custom + ) + , methodFromString + ) where -import Prelude ((==), class Eq, class Show, show) +import Prelude (class Eq, class Show, show, (==)) -- | A list of common methods. If it's non-common, use the 'Custom' -- | constructor. -data Method = GET - | HEAD - | POST - | PUT - | DELETE - | CONNECT - | OPTIONS - | TRACE - | PATCH - | Custom String +data Method + = GET + | HEAD + | POST + | PUT + | DELETE + | CONNECT + | OPTIONS + | TRACE + | PATCH + | Custom String instance showMethod :: Show Method where - show GET = "GET" - show HEAD = "HEAD" - show POST = "POST" - show PUT = "PUT" - show DELETE = "DELETE" - show CONNECT = "CONNECT" - show OPTIONS = "OPTIONS" - show TRACE = "TRACE" - show PATCH = "PATCH" - show (Custom v) = v + show GET = "GET" + show HEAD = "HEAD" + show POST = "POST" + show PUT = "PUT" + show DELETE = "DELETE" + show CONNECT = "CONNECT" + show OPTIONS = "OPTIONS" + show TRACE = "TRACE" + show PATCH = "PATCH" + show (Custom v) = v instance eqMethod :: Eq Method where - eq v1 v2 = show v1 == show v2 + eq v1 v2 = show v1 == show v2 -- | Creates a 'Method' from a string. If the given string is a -- | non-common HTTP method, then a 'Custom' 'Method' is returned. -- -- All HTTP Methods are case-sensitive. methodFromString :: String -> Method -methodFromString "GET" = GET -methodFromString "HEAD" = HEAD -methodFromString "POST" = POST -methodFromString "PUT" = PUT -methodFromString "DELETE" = DELETE +methodFromString "GET" = GET +methodFromString "HEAD" = HEAD +methodFromString "POST" = POST +methodFromString "PUT" = PUT +methodFromString "DELETE" = DELETE methodFromString "CONNECT" = CONNECT methodFromString "OPTIONS" = OPTIONS -methodFromString "TRACE" = TRACE -methodFromString "PATCH" = PATCH -methodFromString s = Custom s +methodFromString "TRACE" = TRACE +methodFromString "PATCH" = PATCH +methodFromString s = Custom s \ No newline at end of file diff --git a/src/Network/HTTP/Types/StatusCode.js b/src/Network/HTTP/Types/StatusCode.js index e0dfa1a..412de29 100644 --- a/src/Network/HTTP/Types/StatusCode.js +++ b/src/Network/HTTP/Types/StatusCode.js @@ -1,6 +1,6 @@ 'use strict'; -function statusCodeFromStringImpl(just) { +export function statusCodeFromStringImpl(just) { return function(nothing) { return function(StatusCode) { return function(reasonPhraseFromString) { @@ -21,6 +21,4 @@ function statusCodeFromStringImpl(just) { return nothing(); } }}}} -} - -exports.statusCodeFromStringImpl = statusCodeFromStringImpl; +} \ No newline at end of file diff --git a/src/Network/HTTP/Types/StatusCode.purs b/src/Network/HTTP/Types/StatusCode.purs index 2a6b13b..6383d53 100644 --- a/src/Network/HTTP/Types/StatusCode.purs +++ b/src/Network/HTTP/Types/StatusCode.purs @@ -1,199 +1,199 @@ module Network.HTTP.Types.StatusCode - ( ReasonPhrase - ( Continue - , SwitchingProtocols - , OK - , Created - , Accepted - , NonAuthoritativeInformation - , NoContent - , ResetContent - , PartialContent - , MultipleChoices - , MovedPermanently - , Found - , SeeOther - , NotModified - , UseProxy - , TemporaryRedirect - , BadRequest - , Unauthorized - , PaymentRequired - , Forbidden - , NotFound - , MethodNotAllowed - , NotAcceptable - , ProxyAuthenticationRequired - , RequestTimeout - , Conflict - , Gone - , LengthRequired - , PreconditionFailed - , PayloadTooLarge - , URITooLong - , UnsupportedMediaType - , RangeNotSatisfiable - , ExpectationFailed - , UpgradeRequired - , InternalServerError - , NotImplemented - , BadGateway - , ServiceUnavailable - , GatewayTimeout - , HTTPVersionNotSupported - , Custom - ) - , StatusCode(StatusCode) - , status100 - , status101 - , status200 - , status201 - , status202 - , status203 - , status204 - , status205 - , status206 - , status300 - , status301 - , status302 - , status303 - , status304 - , status305 - , status307 - , status400 - , status401 - , status402 - , status403 - , status404 - , status405 - , status406 - , status407 - , status408 - , status409 - , status410 - , status411 - , status412 - , status413 - , status414 - , status415 - , status416 - , status417 - , status426 - , status500 - , status501 - , status502 - , status503 - , status504 - , status505 - , getRecognizedStatusCodeFromInt - , reasonPhraseFromString - , statusCodeFromString - ) where - -import Prelude - ( (==) - , (&&) - , (<>) - , class Eq - , class Ord - , class Show - , compare - , const - , show - ) - -import Data.Maybe (Maybe(Just, Nothing)) + ( ReasonPhrase + ( Continue + , SwitchingProtocols + , OK + , Created + , Accepted + , NonAuthoritativeInformation + , NoContent + , ResetContent + , PartialContent + , MultipleChoices + , MovedPermanently + , Found + , SeeOther + , NotModified + , UseProxy + , TemporaryRedirect + , BadRequest + , Unauthorized + , PaymentRequired + , Forbidden + , NotFound + , MethodNotAllowed + , NotAcceptable + , ProxyAuthenticationRequired + , RequestTimeout + , Conflict + , Gone + , LengthRequired + , PreconditionFailed + , PayloadTooLarge + , URITooLong + , UnsupportedMediaType + , RangeNotSatisfiable + , ExpectationFailed + , UpgradeRequired + , InternalServerError + , NotImplemented + , BadGateway + , ServiceUnavailable + , GatewayTimeout + , HTTPVersionNotSupported + , Custom + ) + , StatusCode(StatusCode) + , status100 + , status101 + , status200 + , status201 + , status202 + , status203 + , status204 + , status205 + , status206 + , status300 + , status301 + , status302 + , status303 + , status304 + , status305 + , status307 + , status400 + , status401 + , status402 + , status403 + , status404 + , status405 + , status406 + , status407 + , status408 + , status409 + , status410 + , status411 + , status412 + , status413 + , status414 + , status415 + , status416 + , status417 + , status426 + , status500 + , status501 + , status502 + , status503 + , status504 + , status505 + , getRecognizedStatusCodeFromInt + , reasonPhraseFromString + , statusCodeFromString + ) where + +import Data.Maybe (Maybe(Just, Nothing)) import Data.String (toLower) +import Prelude + ( class Eq + , class Ord + , class Show + , compare + , const + , show + , (&&) + , (<>) + , (==) + ) -- | A list of standard Reason Phrases that (usually) accompany a -- | status code number. If it's non-standard, use the 'Custom' -- | constructor. -data ReasonPhrase = Continue - | SwitchingProtocols - | OK - | Created - | Accepted - | NonAuthoritativeInformation - | NoContent - | ResetContent - | PartialContent - | MultipleChoices - | MovedPermanently - | Found - | SeeOther - | NotModified - | UseProxy - | TemporaryRedirect - | BadRequest - | Unauthorized - | PaymentRequired - | Forbidden - | NotFound - | MethodNotAllowed - | NotAcceptable - | ProxyAuthenticationRequired - | RequestTimeout - | Conflict - | Gone - | LengthRequired - | PreconditionFailed - | PayloadTooLarge - | URITooLong - | UnsupportedMediaType - | RangeNotSatisfiable - | ExpectationFailed - | UpgradeRequired - | InternalServerError - | NotImplemented - | BadGateway - | ServiceUnavailable - | GatewayTimeout - | HTTPVersionNotSupported - | Custom String +data ReasonPhrase + = Continue + | SwitchingProtocols + | OK + | Created + | Accepted + | NonAuthoritativeInformation + | NoContent + | ResetContent + | PartialContent + | MultipleChoices + | MovedPermanently + | Found + | SeeOther + | NotModified + | UseProxy + | TemporaryRedirect + | BadRequest + | Unauthorized + | PaymentRequired + | Forbidden + | NotFound + | MethodNotAllowed + | NotAcceptable + | ProxyAuthenticationRequired + | RequestTimeout + | Conflict + | Gone + | LengthRequired + | PreconditionFailed + | PayloadTooLarge + | URITooLong + | UnsupportedMediaType + | RangeNotSatisfiable + | ExpectationFailed + | UpgradeRequired + | InternalServerError + | NotImplemented + | BadGateway + | ServiceUnavailable + | GatewayTimeout + | HTTPVersionNotSupported + | Custom String instance showReasonPhrase :: Show ReasonPhrase where - show Continue = "Continue" - show SwitchingProtocols = "Switching Protocols" - show OK = "OK" - show Created = "Created" - show Accepted = "Accepted" - show NonAuthoritativeInformation = "Non-Authoritative Information" - show NoContent = "No Content" - show ResetContent = "Reset Content" - show PartialContent = "Partial Content" - show MultipleChoices = "Multiple Choices" - show MovedPermanently = "Moved Permanently" - show Found = "Found" - show SeeOther = "See Other" - show NotModified = "Not Modified" - show UseProxy = "Use Proxy" - show TemporaryRedirect = "Temporary Redirect" - show BadRequest = "Bad Request" - show Unauthorized = "Unauthorized" - show PaymentRequired = "Payment Required" - show Forbidden = "Forbidden" - show NotFound = "Not Found" - show MethodNotAllowed = "Method Not Allowed" - show NotAcceptable = "Not Acceptable" - show ProxyAuthenticationRequired = "Proxy Authentication Required" - show RequestTimeout = "Request Timeout" - show Conflict = "Conflict" - show Gone = "Gone" - show LengthRequired = "Length Required" - show PreconditionFailed = "Precondition Failed" - show PayloadTooLarge = "Payload Too Large" - show URITooLong = "URI Too Long" - show UnsupportedMediaType = "Unsupported Media Type" - show RangeNotSatisfiable = "Range Not Satisfiable" - show ExpectationFailed = "Expectation Failed" - show UpgradeRequired = "Upgrade Required" - show InternalServerError = "Internal Service Error" - show NotImplemented = "Not Implemented" - show BadGateway = "Bad Gateway" - show ServiceUnavailable = "Service Unavailable" - show GatewayTimeout = "Gateway Timeout" - show HTTPVersionNotSupported = "HTTP Version Not Supported" - show (Custom r) = r + show Continue = "Continue" + show SwitchingProtocols = "Switching Protocols" + show OK = "OK" + show Created = "Created" + show Accepted = "Accepted" + show NonAuthoritativeInformation = "Non-Authoritative Information" + show NoContent = "No Content" + show ResetContent = "Reset Content" + show PartialContent = "Partial Content" + show MultipleChoices = "Multiple Choices" + show MovedPermanently = "Moved Permanently" + show Found = "Found" + show SeeOther = "See Other" + show NotModified = "Not Modified" + show UseProxy = "Use Proxy" + show TemporaryRedirect = "Temporary Redirect" + show BadRequest = "Bad Request" + show Unauthorized = "Unauthorized" + show PaymentRequired = "Payment Required" + show Forbidden = "Forbidden" + show NotFound = "Not Found" + show MethodNotAllowed = "Method Not Allowed" + show NotAcceptable = "Not Acceptable" + show ProxyAuthenticationRequired = "Proxy Authentication Required" + show RequestTimeout = "Request Timeout" + show Conflict = "Conflict" + show Gone = "Gone" + show LengthRequired = "Length Required" + show PreconditionFailed = "Precondition Failed" + show PayloadTooLarge = "Payload Too Large" + show URITooLong = "URI Too Long" + show UnsupportedMediaType = "Unsupported Media Type" + show RangeNotSatisfiable = "Range Not Satisfiable" + show ExpectationFailed = "Expectation Failed" + show UpgradeRequired = "Upgrade Required" + show InternalServerError = "Internal Service Error" + show NotImplemented = "Not Implemented" + show BadGateway = "Bad Gateway" + show ServiceUnavailable = "Service Unavailable" + show GatewayTimeout = "Gateway Timeout" + show HTTPVersionNotSupported = "HTTP Version Not Supported" + show (Custom r) = r -- | Creates a 'ReasonPhrase' from a string. If the given string is a -- | non-standard HTTP Reason Phrase, then a 'Custom' 'ReasonPhrase' @@ -204,52 +204,54 @@ instance showReasonPhrase :: Show ReasonPhrase where -- accepting mixed-cased messages. reasonPhraseFromString :: String -> ReasonPhrase reasonPhraseFromString s = reasonPhraseFromString' (toLower s) - where - reasonPhraseFromString' "continue" = Continue - reasonPhraseFromString' "switching protocols" = SwitchingProtocols - reasonPhraseFromString' "ok" = OK - reasonPhraseFromString' "created" = Created - reasonPhraseFromString' "accepted" = Accepted - reasonPhraseFromString' "non-authoritative information" = NonAuthoritativeInformation - reasonPhraseFromString' "no content" = NoContent - reasonPhraseFromString' "reset content" = ResetContent - reasonPhraseFromString' "partial content" = PartialContent - reasonPhraseFromString' "multiple choices" = MultipleChoices - reasonPhraseFromString' "moved permanently" = MovedPermanently - reasonPhraseFromString' "found" = Found - reasonPhraseFromString' "see other" = SeeOther - reasonPhraseFromString' "not modified" = NotModified - reasonPhraseFromString' "use proxy" = UseProxy - reasonPhraseFromString' "temporary redirect" = TemporaryRedirect - reasonPhraseFromString' "bad request" = BadRequest - reasonPhraseFromString' "unauthorized" = Unauthorized - reasonPhraseFromString' "payment required" = PaymentRequired - reasonPhraseFromString' "forbidden" = Forbidden - reasonPhraseFromString' "not found" = NotFound - reasonPhraseFromString' "method not allowed" = MethodNotAllowed - reasonPhraseFromString' "not acceptable" = NotAcceptable - reasonPhraseFromString' "proxy authentication required" = ProxyAuthenticationRequired - reasonPhraseFromString' "request timeout" = RequestTimeout - reasonPhraseFromString' "conflict" = Conflict - reasonPhraseFromString' "gone" = Gone - reasonPhraseFromString' "length required" = LengthRequired - reasonPhraseFromString' "precondition failed" = PreconditionFailed - reasonPhraseFromString' "payload too large" = PayloadTooLarge - reasonPhraseFromString' "uri too long" = URITooLong - reasonPhraseFromString' "unsupported media type" = UnsupportedMediaType - reasonPhraseFromString' "range not satisfiable" = RangeNotSatisfiable - reasonPhraseFromString' "expectation failed" = ExpectationFailed - reasonPhraseFromString' "upgrade required" = UpgradeRequired - reasonPhraseFromString' "internal server error" = InternalServerError - reasonPhraseFromString' "not implemented" = NotImplemented - reasonPhraseFromString' "bad gateway" = BadGateway - reasonPhraseFromString' "service unavailable" = ServiceUnavailable - reasonPhraseFromString' "gateway timeout" = GatewayTimeout - reasonPhraseFromString' "http version not supported" = HTTPVersionNotSupported - reasonPhraseFromString' _ = Custom s + where + reasonPhraseFromString' "continue" = Continue + reasonPhraseFromString' "switching protocols" = SwitchingProtocols + reasonPhraseFromString' "ok" = OK + reasonPhraseFromString' "created" = Created + reasonPhraseFromString' "accepted" = Accepted + reasonPhraseFromString' "non-authoritative information" = + NonAuthoritativeInformation + reasonPhraseFromString' "no content" = NoContent + reasonPhraseFromString' "reset content" = ResetContent + reasonPhraseFromString' "partial content" = PartialContent + reasonPhraseFromString' "multiple choices" = MultipleChoices + reasonPhraseFromString' "moved permanently" = MovedPermanently + reasonPhraseFromString' "found" = Found + reasonPhraseFromString' "see other" = SeeOther + reasonPhraseFromString' "not modified" = NotModified + reasonPhraseFromString' "use proxy" = UseProxy + reasonPhraseFromString' "temporary redirect" = TemporaryRedirect + reasonPhraseFromString' "bad request" = BadRequest + reasonPhraseFromString' "unauthorized" = Unauthorized + reasonPhraseFromString' "payment required" = PaymentRequired + reasonPhraseFromString' "forbidden" = Forbidden + reasonPhraseFromString' "not found" = NotFound + reasonPhraseFromString' "method not allowed" = MethodNotAllowed + reasonPhraseFromString' "not acceptable" = NotAcceptable + reasonPhraseFromString' "proxy authentication required" = + ProxyAuthenticationRequired + reasonPhraseFromString' "request timeout" = RequestTimeout + reasonPhraseFromString' "conflict" = Conflict + reasonPhraseFromString' "gone" = Gone + reasonPhraseFromString' "length required" = LengthRequired + reasonPhraseFromString' "precondition failed" = PreconditionFailed + reasonPhraseFromString' "payload too large" = PayloadTooLarge + reasonPhraseFromString' "uri too long" = URITooLong + reasonPhraseFromString' "unsupported media type" = UnsupportedMediaType + reasonPhraseFromString' "range not satisfiable" = RangeNotSatisfiable + reasonPhraseFromString' "expectation failed" = ExpectationFailed + reasonPhraseFromString' "upgrade required" = UpgradeRequired + reasonPhraseFromString' "internal server error" = InternalServerError + reasonPhraseFromString' "not implemented" = NotImplemented + reasonPhraseFromString' "bad gateway" = BadGateway + reasonPhraseFromString' "service unavailable" = ServiceUnavailable + reasonPhraseFromString' "gateway timeout" = GatewayTimeout + reasonPhraseFromString' "http version not supported" = HTTPVersionNotSupported + reasonPhraseFromString' _ = Custom s instance eqReasonPhrase :: Eq ReasonPhrase where - eq r1 r2 = show r1 == show r2 + eq r1 r2 = show r1 == show r2 -- | A type that represents an HTTP StatusCode. Consists of both it's -- | code (e.g.: '400'), and it's Reason Phrase (e.g.: 'Bad Request'). @@ -258,315 +260,316 @@ instance eqReasonPhrase :: Eq ReasonPhrase where -- more practical to just call it StatusCode, and group the Reason -- Phrase with the status code. newtype StatusCode = StatusCode - { code :: Int - , reasonPhrase :: ReasonPhrase - } + { code :: Int + , reasonPhrase :: ReasonPhrase + } instance showStatusCode :: Show StatusCode where - show (StatusCode { code, reasonPhrase }) = show code - <> " " <> show reasonPhrase + show (StatusCode { code, reasonPhrase }) = show code + <> " " + <> show reasonPhrase instance eqStatusCode :: Eq StatusCode where - eq (StatusCode s1) (StatusCode s2) = s1.code == s2.code - && s1.reasonPhrase == s2.reasonPhrase + eq (StatusCode s1) (StatusCode s2) = s1.code == s2.code + && s1.reasonPhrase == s2.reasonPhrase instance ordStatusCode :: Ord StatusCode where - compare (StatusCode { code: c1 }) (StatusCode { code: c2 }) = - compare c1 c2 + compare (StatusCode { code: c1 }) (StatusCode { code: c2 }) = + compare c1 c2 setCode :: Int -> StatusCode -> StatusCode setCode code (StatusCode s) = StatusCode s { code = code } setResponsePhrase :: ReasonPhrase -> StatusCode -> StatusCode setResponsePhrase reasonPhrase (StatusCode s) = - StatusCode s { reasonPhrase = reasonPhrase } + StatusCode s { reasonPhrase = reasonPhrase } -- | Continue status100 :: StatusCode status100 = StatusCode - { code : 100 - , reasonPhrase: Continue - } + { code: 100 + , reasonPhrase: Continue + } -- | Switching Protocols status101 :: StatusCode status101 = StatusCode - { code : 101 - , reasonPhrase: SwitchingProtocols - } + { code: 101 + , reasonPhrase: SwitchingProtocols + } -- | OK status200 :: StatusCode status200 = StatusCode - { code : 200 - , reasonPhrase: OK - } + { code: 200 + , reasonPhrase: OK + } -- | Created status201 :: StatusCode status201 = StatusCode - { code : 201 - , reasonPhrase: Created - } + { code: 201 + , reasonPhrase: Created + } -- | Accepted status202 :: StatusCode status202 = StatusCode - { code : 202 - , reasonPhrase: Accepted - } + { code: 202 + , reasonPhrase: Accepted + } -- | Non-Authoritative Information status203 :: StatusCode status203 = StatusCode - { code : 203 - , reasonPhrase: NonAuthoritativeInformation - } + { code: 203 + , reasonPhrase: NonAuthoritativeInformation + } -- | No Content status204 :: StatusCode status204 = StatusCode - { code : 204 - , reasonPhrase: NoContent - } + { code: 204 + , reasonPhrase: NoContent + } -- | Reset Content status205 :: StatusCode status205 = StatusCode - { code : 205 - , reasonPhrase: ResetContent - } + { code: 205 + , reasonPhrase: ResetContent + } -- | Partial Content status206 :: StatusCode status206 = StatusCode - { code : 206 - , reasonPhrase: PartialContent - } + { code: 206 + , reasonPhrase: PartialContent + } -- | Multiple Choices status300 :: StatusCode status300 = StatusCode - { code : 300 - , reasonPhrase: MultipleChoices - } + { code: 300 + , reasonPhrase: MultipleChoices + } -- | Moved Permanently status301 :: StatusCode status301 = StatusCode - { code : 301 - , reasonPhrase: MovedPermanently - } + { code: 301 + , reasonPhrase: MovedPermanently + } -- | Found status302 :: StatusCode status302 = StatusCode - { code : 302 - , reasonPhrase: Found - } + { code: 302 + , reasonPhrase: Found + } -- | See Other status303 :: StatusCode status303 = StatusCode - { code : 303 - , reasonPhrase: SeeOther - } + { code: 303 + , reasonPhrase: SeeOther + } -- | Not Modified status304 :: StatusCode status304 = StatusCode - { code : 304 - , reasonPhrase: NotModified - } + { code: 304 + , reasonPhrase: NotModified + } -- | Use Proxy status305 :: StatusCode status305 = StatusCode - { code : 305 - , reasonPhrase: UseProxy - } + { code: 305 + , reasonPhrase: UseProxy + } -- | Temporary Redirect status307 :: StatusCode status307 = StatusCode - { code : 307 - , reasonPhrase: TemporaryRedirect - } + { code: 307 + , reasonPhrase: TemporaryRedirect + } -- | Bad Request status400 :: StatusCode status400 = StatusCode - { code : 400 - , reasonPhrase: BadRequest - } + { code: 400 + , reasonPhrase: BadRequest + } -- | Unauthorized status401 :: StatusCode status401 = StatusCode - { code : 401 - , reasonPhrase: Unauthorized - } + { code: 401 + , reasonPhrase: Unauthorized + } -- | Payment Required status402 :: StatusCode status402 = StatusCode - { code : 402 - , reasonPhrase: PaymentRequired - } + { code: 402 + , reasonPhrase: PaymentRequired + } -- | Forbidden status403 :: StatusCode status403 = StatusCode - { code : 403 - , reasonPhrase: Forbidden - } + { code: 403 + , reasonPhrase: Forbidden + } -- | Not Found status404 :: StatusCode status404 = StatusCode - { code : 404 - , reasonPhrase: NotFound - } + { code: 404 + , reasonPhrase: NotFound + } -- | Method Not Allowed status405 :: StatusCode status405 = StatusCode - { code : 405 - , reasonPhrase: MethodNotAllowed - } + { code: 405 + , reasonPhrase: MethodNotAllowed + } -- | Not Acceptable status406 :: StatusCode status406 = StatusCode - { code : 406 - , reasonPhrase: NotAcceptable - } + { code: 406 + , reasonPhrase: NotAcceptable + } -- | Proxy Authentication Required status407 :: StatusCode status407 = StatusCode - { code : 407 - , reasonPhrase: ProxyAuthenticationRequired - } + { code: 407 + , reasonPhrase: ProxyAuthenticationRequired + } -- | Request Timeout status408 :: StatusCode status408 = StatusCode - { code : 408 - , reasonPhrase: RequestTimeout - } + { code: 408 + , reasonPhrase: RequestTimeout + } -- | Conflict status409 :: StatusCode status409 = StatusCode - { code : 409 - , reasonPhrase: Conflict - } + { code: 409 + , reasonPhrase: Conflict + } -- | Gone status410 :: StatusCode status410 = StatusCode - { code : 410 - , reasonPhrase: Gone - } + { code: 410 + , reasonPhrase: Gone + } -- | Length Required status411 :: StatusCode status411 = StatusCode - { code : 411 - , reasonPhrase: LengthRequired - } + { code: 411 + , reasonPhrase: LengthRequired + } -- | Precondition Failed status412 :: StatusCode status412 = StatusCode - { code : 412 - , reasonPhrase: PreconditionFailed - } + { code: 412 + , reasonPhrase: PreconditionFailed + } -- | Payload Too Large status413 :: StatusCode status413 = StatusCode - { code : 413 - , reasonPhrase: PayloadTooLarge - } + { code: 413 + , reasonPhrase: PayloadTooLarge + } -- | URI Too Long status414 :: StatusCode status414 = StatusCode - { code : 414 - , reasonPhrase: URITooLong - } + { code: 414 + , reasonPhrase: URITooLong + } -- | Unsupported Media Type status415 :: StatusCode status415 = StatusCode - { code : 415 - , reasonPhrase: UnsupportedMediaType - } + { code: 415 + , reasonPhrase: UnsupportedMediaType + } -- | Range Not Satisfiable status416 :: StatusCode status416 = StatusCode - { code : 416 - , reasonPhrase: RangeNotSatisfiable - } + { code: 416 + , reasonPhrase: RangeNotSatisfiable + } -- | Expectation Failed status417 :: StatusCode status417 = StatusCode - { code : 417 - , reasonPhrase: ExpectationFailed - } + { code: 417 + , reasonPhrase: ExpectationFailed + } -- | Upgrade Required status426 :: StatusCode status426 = StatusCode - { code : 426 - , reasonPhrase: UpgradeRequired - } + { code: 426 + , reasonPhrase: UpgradeRequired + } -- | Internal Server Error status500 :: StatusCode status500 = StatusCode - { code : 500 - , reasonPhrase: InternalServerError - } + { code: 500 + , reasonPhrase: InternalServerError + } -- | Not Implemented status501 :: StatusCode status501 = StatusCode - { code : 501 - , reasonPhrase: NotImplemented - } + { code: 501 + , reasonPhrase: NotImplemented + } -- | Bad Gateway status502 :: StatusCode status502 = StatusCode - { code : 502 - , reasonPhrase: BadGateway - } + { code: 502 + , reasonPhrase: BadGateway + } -- | Service Unavailable status503 :: StatusCode status503 = StatusCode - { code : 503 - , reasonPhrase: ServiceUnavailable - } + { code: 503 + , reasonPhrase: ServiceUnavailable + } -- | Gateway Timeout status504 :: StatusCode status504 = StatusCode - { code : 504 - , reasonPhrase: GatewayTimeout - } + { code: 504 + , reasonPhrase: GatewayTimeout + } -- | HTTP Version Not Supported status505 :: StatusCode status505 = StatusCode - { code : 505 - , reasonPhrase: HTTPVersionNotSupported - } + { code: 505 + , reasonPhrase: HTTPVersionNotSupported + } -- | Returns a standard 'StatusCode' if the given integer correlates -- | to a standard status code number. Returns 'Nothing' otherwise. @@ -612,14 +615,19 @@ getRecognizedStatusCodeFromInt 502 = Just status502 getRecognizedStatusCodeFromInt 503 = Just status503 getRecognizedStatusCodeFromInt 504 = Just status504 getRecognizedStatusCodeFromInt 505 = Just status505 -getRecognizedStatusCodeFromInt _ = Nothing - -foreign import statusCodeFromStringImpl :: (StatusCode -> Maybe StatusCode) -> -- Just constructor - (StatusCode -> Maybe StatusCode) -> -- Nothing constructor - ({ code :: Int, reasonPhrase :: ReasonPhrase } -> StatusCode) -> -- StatusCode constructor - (String -> ReasonPhrase) -> -- reasonPhraseFromString - String -> - Maybe StatusCode +getRecognizedStatusCodeFromInt _ = Nothing + +foreign import statusCodeFromStringImpl + :: (StatusCode -> Maybe StatusCode) + -> -- Just constructor + (StatusCode -> Maybe StatusCode) + -> -- Nothing constructor + ({ code :: Int, reasonPhrase :: ReasonPhrase } -> StatusCode) + -> -- StatusCode constructor + (String -> ReasonPhrase) + -> -- reasonPhraseFromString + String + -> Maybe StatusCode -- | Returns a 'StatusCode' if the given string can be coerced into -- | one. The expected string format is `Status-Code SP Reason-Phrase` @@ -627,4 +635,5 @@ foreign import statusCodeFromStringImpl :: (StatusCode -> Maybe StatusCode) -- -- XXX I should replace this with a pure PureScript impl. statusCodeFromString :: String -> Maybe StatusCode -statusCodeFromString = statusCodeFromStringImpl Just (const Nothing) StatusCode reasonPhraseFromString +statusCodeFromString = statusCodeFromStringImpl Just (const Nothing) StatusCode + reasonPhraseFromString \ No newline at end of file