renamed Request to GemURL
- A request should contain a URL and an optional client certigicate. - renamed accompanying functions accordingly
This commit is contained in:
parent
db718eedcd
commit
a2d8f1a5ea
|
@ -27,7 +27,7 @@ License along with this program. If not, see
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
module Network.GemServ (
|
module Network.GemServ (
|
||||||
encodeRequest,
|
encodeGemURL,
|
||||||
escapeString,
|
escapeString,
|
||||||
unescapeString
|
unescapeString
|
||||||
) where
|
) where
|
||||||
|
@ -43,16 +43,16 @@ import Data.Text.Encoding (decodeUtf8')
|
||||||
|
|
||||||
import Network.GemServ.Types
|
import Network.GemServ.Types
|
||||||
|
|
||||||
-- | Encodes a 'Request' into a 'String'
|
-- | Encodes a 'GemURL' into a 'String'
|
||||||
encodeRequest :: Request -> String
|
encodeGemURL :: GemURL -> String
|
||||||
encodeRequest req =
|
encodeGemURL url =
|
||||||
"gemini://" ++ authority ++ "/" ++ path ++ query
|
"gemini://" ++ authority ++ "/" ++ path ++ query
|
||||||
where
|
where
|
||||||
authority = reqHost req ++ case reqPort req of
|
authority = gemHost url ++ case gemPort url of
|
||||||
Just port -> ':' : show port
|
Just port -> ':' : show port
|
||||||
Nothing -> ""
|
Nothing -> ""
|
||||||
path = intercalate "/" $ map escapeString $ reqPath req
|
path = intercalate "/" $ map escapeString $ gemPath url
|
||||||
query = case reqQuery req of
|
query = case gemQuery url of
|
||||||
"" -> ""
|
"" -> ""
|
||||||
q -> '?' : escapeString q
|
q -> '?' : escapeString q
|
||||||
|
|
||||||
|
|
|
@ -25,34 +25,34 @@ License along with this program. If not, see
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Network.GemServ.Types (
|
module Network.GemServ.Types (
|
||||||
Request (..),
|
GemURL (..),
|
||||||
newRequest
|
newGemURL
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
|
|
||||||
-- | Gemini request
|
-- | Gemini URL
|
||||||
data Request = Request
|
data GemURL = GemURL
|
||||||
{ reqHost :: String
|
{ gemHost :: String
|
||||||
-- ^ The host part of the authority section, e.g.: "example.com"
|
-- ^ The host part of the authority section, e.g.: "example.com"
|
||||||
, reqPort :: Maybe Word32
|
, gemPort :: Maybe Word32
|
||||||
-- ^ The port number (if supplied)
|
-- ^ The port number (if supplied)
|
||||||
, reqPath :: [String]
|
, gemPath :: [String]
|
||||||
-- ^ The decoded path segments
|
-- ^ The decoded path segments
|
||||||
, reqQuery :: String
|
, gemQuery :: String
|
||||||
-- ^ The decoded request query
|
-- ^ The decoded request query
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
-- | Builds a new request
|
-- | Builds a new 'GemURL'
|
||||||
newRequest
|
newGemURL
|
||||||
:: String
|
:: String
|
||||||
-- ^ The hostname
|
-- ^ The hostname
|
||||||
-> Request
|
-> GemURL
|
||||||
newRequest host = Request
|
newGemURL host = GemURL
|
||||||
{ reqHost = host
|
{ gemHost = host
|
||||||
, reqPort = Nothing
|
, gemPort = Nothing
|
||||||
, reqPath = []
|
, gemPath = []
|
||||||
, reqQuery = ""
|
, gemQuery = ""
|
||||||
}
|
}
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|
|
@ -29,38 +29,38 @@ import Network.GemServ.Types
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Network.GemServ" $ do
|
spec = describe "Network.GemServ" $ do
|
||||||
encodeRequestSpec
|
encodeGemURLSpec
|
||||||
escapeStringSpec
|
escapeStringSpec
|
||||||
unescapeStringSpec
|
unescapeStringSpec
|
||||||
|
|
||||||
encodeRequestSpec :: Spec
|
encodeGemURLSpec :: Spec
|
||||||
encodeRequestSpec = describe "encodeRequest" $ mapM_
|
encodeGemURLSpec = describe "encodeGemURL" $ mapM_
|
||||||
( \(desc, req, expected) -> context desc $
|
( \(desc, req, expected) -> context desc $
|
||||||
it ("should be " ++ show expected) $
|
it ("should be " ++ show expected) $
|
||||||
encodeRequest req `shouldBe` expected
|
encodeGemURL req `shouldBe` expected
|
||||||
)
|
)
|
||||||
|
|
||||||
-- description, request, expected
|
-- description, request, expected
|
||||||
[ ( "simple", simpleReq, simpleExp )
|
[ ( "simple", simpleURL, simpleExp )
|
||||||
, ( "with port", withPortReq, withPortExp )
|
, ( "with port", withPortURL, withPortExp )
|
||||||
, ( "with path", withPathReq, withPathExp )
|
, ( "with path", withPathURL, withPathExp )
|
||||||
, ( "with query", withQueryReq, withQueryExp )
|
, ( "with query", withQueryURL, withQueryExp )
|
||||||
, ( "with escape", withEscapeReq, withEscapeExp )
|
, ( "with escape", withEscapeURL, withEscapeExp )
|
||||||
]
|
]
|
||||||
|
|
||||||
where
|
where
|
||||||
simpleReq = newRequest "example.com"
|
simpleURL = newGemURL "example.com"
|
||||||
simpleExp = "gemini://example.com/"
|
simpleExp = "gemini://example.com/"
|
||||||
withPortReq = simpleReq { reqPort = Just 1965 }
|
withPortURL = simpleURL { gemPort = Just 1965 }
|
||||||
withPortExp = "gemini://example.com:1965/"
|
withPortExp = "gemini://example.com:1965/"
|
||||||
withPathReq = simpleReq { reqPath = ["foo", "bar"] }
|
withPathURL = simpleURL { gemPath = ["foo", "bar"] }
|
||||||
withPathExp = "gemini://example.com/foo/bar"
|
withPathExp = "gemini://example.com/foo/bar"
|
||||||
withQueryReq = simpleReq { reqQuery = "foo" }
|
withQueryURL = simpleURL { gemQuery = "foo" }
|
||||||
withQueryExp = "gemini://example.com/?foo"
|
withQueryExp = "gemini://example.com/?foo"
|
||||||
|
|
||||||
withEscapeReq = simpleReq
|
withEscapeURL = simpleURL
|
||||||
{ reqPath = ["foo bar"]
|
{ gemPath = ["foo bar"]
|
||||||
, reqQuery = "baz quux"
|
, gemQuery = "baz quux"
|
||||||
}
|
}
|
||||||
|
|
||||||
withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
|
withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user