implemented basic logic for readURL
This commit is contained in:
parent
893ab49256
commit
5c83bf3123
|
|
@ -24,6 +24,7 @@ extra-source-files:
|
|||
library
|
||||
exposed-modules:
|
||||
Network.Gemini.Capsule
|
||||
Network.Gemini.Capsule.Encoding
|
||||
Network.Gemini.Capsule.Internal
|
||||
Network.Gemini.Capsule.Types
|
||||
other-modules:
|
||||
|
|
@ -34,6 +35,7 @@ library
|
|||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, bytestring >=0.10.12.0 && <0.11
|
||||
, io-streams
|
||||
, network
|
||||
, tcp-streams >=1.0.1.1 && <1.1
|
||||
, text >=1.2.4.1 && <1.3
|
||||
|
|
@ -46,6 +48,7 @@ test-suite gemcap-test
|
|||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Network.Gemini.Capsule.EncodingSpec
|
||||
Network.Gemini.Capsule.InternalSpec
|
||||
Network.Gemini.CapsuleSpec
|
||||
Paths_gemcap
|
||||
|
|
@ -57,6 +60,7 @@ test-suite gemcap-test
|
|||
, bytestring >=0.10.12.0 && <0.11
|
||||
, gemcap
|
||||
, hspec >=2.7.10 && <2.8
|
||||
, io-streams
|
||||
, network
|
||||
, tcp-streams >=1.0.1.1 && <1.1
|
||||
, text >=1.2.4.1 && <1.3
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@ dependencies:
|
|||
- bytestring >= 0.10.12.0 && < 0.11
|
||||
- tcp-streams >= 1.0.1.1 && < 1.1
|
||||
- text >= 1.2.4.1 && < 1.3
|
||||
- io-streams
|
||||
- network
|
||||
- tls
|
||||
- x509
|
||||
|
|
|
|||
|
|
@ -24,36 +24,18 @@ License along with this program. If not, see
|
|||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE
|
||||
LambdaCase,
|
||||
OverloadedStrings,
|
||||
ScopedTypeVariables,
|
||||
RecordWildCards #-}
|
||||
{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
|
||||
|
||||
module Network.Gemini.Capsule (
|
||||
-- * Running a Gemini Server
|
||||
runGemCapsule,
|
||||
-- * Encoding/Decoding Functions
|
||||
encodeGemURL,
|
||||
decodeGemURL,
|
||||
escapeString,
|
||||
unescapeString
|
||||
runGemCapsule
|
||||
) where
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Exception (IOException, try)
|
||||
import Control.Exception.Base (bracket, finally)
|
||||
import Control.Monad (void)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Data.Char (chr, ord, toLower)
|
||||
import qualified Data.Connection as C
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.List (find, intercalate)
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8')
|
||||
import Data.TLSSetting (makeServerParams)
|
||||
import Data.X509 (Certificate, CertificateChain (..), getSigned, signedObject)
|
||||
import qualified Network.Socket as S
|
||||
|
|
@ -85,106 +67,13 @@ runGemCapsule settings handler = bracket
|
|||
listenLoop sock params handler
|
||||
)
|
||||
|
||||
-- | Encodes a 'GemURL' into a 'String'
|
||||
encodeGemURL :: GemURL -> String
|
||||
encodeGemURL url =
|
||||
"gemini://" ++ authority ++ "/" ++ path ++ query
|
||||
where
|
||||
authority = gemHost url ++ case gemPort url of
|
||||
Just port -> ':' : show port
|
||||
Nothing -> ""
|
||||
path = intercalate "/" $ map escapeString $ gemPath url
|
||||
query = case gemQuery url of
|
||||
Nothing -> ""
|
||||
Just q -> '?' : escapeString q
|
||||
|
||||
-- | Decodes a 'GemURL' from a 'String' (if possible)
|
||||
decodeGemURL :: String -> Maybe GemURL
|
||||
decodeGemURL str = do
|
||||
let txt = T.pack str
|
||||
|
||||
noProt <- case T.splitOn "://" txt of
|
||||
[prot, rest] -> if T.toLower prot == "gemini"
|
||||
then Just rest
|
||||
else Nothing
|
||||
_ -> Nothing
|
||||
|
||||
noFrag <- case T.splitOn "#" noProt of
|
||||
[x, _] -> Just x
|
||||
[x] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
(noQuery, query) <- case T.splitOn "?" noFrag of
|
||||
[nq, q] -> Just (nq, Just q)
|
||||
[nq] -> Just (nq, Nothing)
|
||||
_ -> Nothing
|
||||
|
||||
gemQuery <- case query of
|
||||
Just q -> Just <$> unescapeString (T.unpack q)
|
||||
Nothing -> Just Nothing
|
||||
|
||||
(auth, path) <- case T.splitOn "/" noQuery of
|
||||
[a] -> Just (a, [])
|
||||
[a, ""] -> Just (a, [])
|
||||
a:ps -> Just (a, ps)
|
||||
_ -> Nothing
|
||||
|
||||
gemPath <- mapM (unescapeString . T.unpack) path
|
||||
|
||||
(host, gemPort) <- case T.splitOn ":" auth of
|
||||
[h, p] -> case reads $ T.unpack p of
|
||||
[(n, "")] -> Just (h, Just n)
|
||||
_ -> Nothing
|
||||
[h] -> Just (h, Nothing)
|
||||
_ -> Nothing
|
||||
|
||||
let gemHost = T.unpack host
|
||||
Just GemURL {..}
|
||||
|
||||
-- | add required escape sequences to a string
|
||||
escapeString :: String -> String
|
||||
escapeString = concatMap
|
||||
( \n -> let ch = chr $ fromIntegral n in
|
||||
if ch `elem` unescaped
|
||||
then [ch]
|
||||
else '%' : toHex n
|
||||
) . BSL.unpack . toLazyByteString . stringUtf8
|
||||
where
|
||||
unescaped = ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] ++ "~-_."
|
||||
toHex =
|
||||
( \n -> let
|
||||
high = n `div` 16
|
||||
low = n `mod` 16
|
||||
in [hexDigits !! high, hexDigits !! low]
|
||||
) . fromIntegral
|
||||
|
||||
-- | decode an escaped string back to its original value
|
||||
unescapeString :: String -> Maybe String
|
||||
unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
|
||||
Right t -> Just $ T.unpack t
|
||||
_ -> Nothing
|
||||
where
|
||||
toBytes = \case
|
||||
"" -> []
|
||||
'%':h:l:sub -> let
|
||||
h' = toLower h
|
||||
l' = toLower l
|
||||
in if h' `elem` hexDigits && l' `elem` hexDigits
|
||||
then toByte h' l' : toBytes sub
|
||||
else fromIntegral (ord '%') : toBytes (h : l : sub)
|
||||
ch:sub ->
|
||||
BSL.unpack (toLazyByteString $ charUtf8 ch) ++ toBytes sub
|
||||
toByte h l = toNum h * 16 + toNum l
|
||||
toNum ch = fst $ fromJust $
|
||||
find (\x -> snd x == ch) $ zip [0..] hexDigits
|
||||
|
||||
listenLoop :: S.Socket -> ServerParams -> GemHandler -> IO a
|
||||
listenLoop sock params handler = do
|
||||
certRef <- newIORef Nothing
|
||||
let params' = adjustServerParams certRef params
|
||||
try (accept params' sock) >>= \case
|
||||
Left (_ :: IOException) -> return ()
|
||||
Right conn -> void $ forkIO $ finally
|
||||
Left (_::IOException) -> return ()
|
||||
Right conn -> void $ forkIO $ finally
|
||||
(readIORef certRef >>= runConnection conn handler)
|
||||
(C.close conn)
|
||||
listenLoop sock params handler
|
||||
|
|
@ -222,7 +111,4 @@ runConnection conn handler mCert =
|
|||
Just url -> handler (newGemRequest url) { reqCert = mCert }
|
||||
) >>= sendResponse conn
|
||||
|
||||
hexDigits :: String
|
||||
hexDigits = ['0'..'9'] ++ ['a'..'f']
|
||||
|
||||
--jl
|
||||
|
|
|
|||
|
|
@ -0,0 +1,143 @@
|
|||
{-|
|
||||
|
||||
Module : Network.Gemini.Capsule.Encoding
|
||||
Description : funcitons to encode/decode our data types
|
||||
Copyright : (C) Jonathan Lamothe
|
||||
License : AGPL-3.0-or-later
|
||||
Maintainer : jonathan@jlamothe.net
|
||||
Stability : experimental
|
||||
Portability : POSIX
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public
|
||||
License along with this program. If not, see
|
||||
<https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase, OverloadedStrings, RecordWildCards #-}
|
||||
|
||||
module Network.Gemini.Capsule.Encoding (
|
||||
encodeGemURL,
|
||||
decodeGemURL,
|
||||
escapeString,
|
||||
unescapeString
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Data.Char (chr, ord, toLower)
|
||||
import Data.List (find, intercalate)
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8')
|
||||
|
||||
import Network.Gemini.Capsule.Types
|
||||
|
||||
-- | Encodes a 'GemURL' into a 'String'
|
||||
encodeGemURL :: GemURL -> String
|
||||
encodeGemURL url =
|
||||
"gemini://" ++ authority ++ "/" ++ path ++ query
|
||||
where
|
||||
authority = gemHost url ++ case gemPort url of
|
||||
Just port -> ':' : show port
|
||||
Nothing -> ""
|
||||
path = intercalate "/" $ map escapeString $ gemPath url
|
||||
query = case gemQuery url of
|
||||
Nothing -> ""
|
||||
Just q -> '?' : escapeString q
|
||||
|
||||
-- | Decodes a 'GemURL' from a 'String' (if possible)
|
||||
decodeGemURL :: String -> Maybe GemURL
|
||||
decodeGemURL str = do
|
||||
let txt = T.pack str
|
||||
|
||||
noProt <- case T.splitOn "://" txt of
|
||||
[prot, rest] -> if T.toLower prot == "gemini"
|
||||
then Just rest
|
||||
else Nothing
|
||||
_ -> Nothing
|
||||
|
||||
noFrag <- case T.splitOn "#" noProt of
|
||||
[x, _] -> Just x
|
||||
[x] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
(noQuery, query) <- case T.splitOn "?" noFrag of
|
||||
[nq, q] -> Just (nq, Just q)
|
||||
[nq] -> Just (nq, Nothing)
|
||||
_ -> Nothing
|
||||
|
||||
gemQuery <- case query of
|
||||
Just q -> Just <$> unescapeString (T.unpack q)
|
||||
Nothing -> Just Nothing
|
||||
|
||||
(auth, path) <- case T.splitOn "/" noQuery of
|
||||
[a] -> Just (a, [])
|
||||
[a, ""] -> Just (a, [])
|
||||
a:ps -> Just (a, ps)
|
||||
_ -> Nothing
|
||||
|
||||
gemPath <- mapM (unescapeString . T.unpack) path
|
||||
|
||||
(host, gemPort) <- case T.splitOn ":" auth of
|
||||
[h, p] -> case reads $ T.unpack p of
|
||||
[(n, "")] -> Just (h, Just n)
|
||||
_ -> Nothing
|
||||
[h] -> Just (h, Nothing)
|
||||
_ -> Nothing
|
||||
|
||||
let gemHost = T.unpack host
|
||||
Just GemURL {..}
|
||||
|
||||
-- | add required escape sequences to a string
|
||||
escapeString :: String -> String
|
||||
escapeString = concatMap
|
||||
( \n -> let ch = chr $ fromIntegral n in
|
||||
if ch `elem` unescaped
|
||||
then [ch]
|
||||
else '%' : toHex n
|
||||
) . BSL.unpack . toLazyByteString . stringUtf8
|
||||
where
|
||||
unescaped = ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] ++ "~-_."
|
||||
toHex =
|
||||
( \n -> let
|
||||
high = n `div` 16
|
||||
low = n `mod` 16
|
||||
in [hexDigits !! high, hexDigits !! low]
|
||||
) . fromIntegral
|
||||
|
||||
-- | decode an escaped string back to its original value
|
||||
unescapeString :: String -> Maybe String
|
||||
unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
|
||||
Right t -> Just $ T.unpack t
|
||||
_ -> Nothing
|
||||
where
|
||||
toBytes = \case
|
||||
"" -> []
|
||||
'%':h:l:sub -> let
|
||||
h' = toLower h
|
||||
l' = toLower l
|
||||
in if h' `elem` hexDigits && l' `elem` hexDigits
|
||||
then toByte h' l' : toBytes sub
|
||||
else fromIntegral (ord '%') : toBytes (h : l : sub)
|
||||
ch:sub ->
|
||||
BSL.unpack (toLazyByteString $ charUtf8 ch) ++ toBytes sub
|
||||
toByte h l = toNum h * 16 + toNum l
|
||||
toNum ch = fst $ fromJust $
|
||||
find (\x -> snd x == ch) $ zip [0..] hexDigits
|
||||
|
||||
hexDigits :: String
|
||||
hexDigits = ['0'..'9'] ++ ['a'..'f']
|
||||
|
||||
--jl
|
||||
|
|
@ -30,6 +30,8 @@ time.
|
|||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Network.Gemini.Capsule.Internal (
|
||||
readURL,
|
||||
sendResponse
|
||||
|
|
@ -37,14 +39,24 @@ module Network.Gemini.Capsule.Internal (
|
|||
|
||||
import Data.Connection (Connection)
|
||||
|
||||
import Network.Gemini.Capsule.Encoding
|
||||
import Network.Gemini.Capsule.Types
|
||||
|
||||
-- Constants
|
||||
|
||||
-- Maximum size to read from a conneciton
|
||||
inBufSize :: Int
|
||||
inBufSize = 1026
|
||||
|
||||
-- | Reads a 'GemURL' from a 'Connection'
|
||||
readURL
|
||||
:: Connection a
|
||||
-- ^ the connection
|
||||
-> IO (Maybe GemURL)
|
||||
readURL = undefined
|
||||
readURL conn =
|
||||
strFromConn inBufSize conn >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just str -> return $ decodeGemURL str
|
||||
|
||||
-- | Sends a 'GemResponse' to a 'Connection'
|
||||
sendResponse
|
||||
|
|
@ -55,4 +67,15 @@ sendResponse
|
|||
-> IO ()
|
||||
sendResponse = undefined
|
||||
|
||||
-- | Reads up to a maxumum number of bytes from a 'Connection', UTF-8
|
||||
-- decodes it, and returns the resulting string (if possible) without
|
||||
-- the trailing CR/LF
|
||||
strFromConn
|
||||
:: Int
|
||||
-- ^ The maximum number of bytes to read
|
||||
-> Connection a
|
||||
-- ^ The connection to read from
|
||||
-> IO (Maybe String)
|
||||
strFromConn = undefined
|
||||
|
||||
--jl
|
||||
|
|
|
|||
|
|
@ -0,0 +1,146 @@
|
|||
{-
|
||||
|
||||
gemcap
|
||||
|
||||
Cooyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
|
||||
|
||||
This program is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU Affero General Public License as
|
||||
published by the Free Software Foundation, either version 3 of the
|
||||
License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Affero General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Affero General Public
|
||||
License along with this program. If not, see
|
||||
<https://www.gnu.org/licenses/>.
|
||||
|
||||
-}
|
||||
|
||||
module Network.Gemini.Capsule.EncodingSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
|
||||
import Network.Gemini.Capsule.Encoding
|
||||
import Network.Gemini.Capsule.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Encoding" $ do
|
||||
encodeGemURLSpec
|
||||
decodeGemURLSpec
|
||||
escapeStringSpec
|
||||
unescapeStringSpec
|
||||
|
||||
encodeGemURLSpec :: Spec
|
||||
encodeGemURLSpec = describe "encodeGemURL" $ mapM_
|
||||
( \(desc, req, expected) -> context desc $
|
||||
it ("should be " ++ show expected) $
|
||||
encodeGemURL req `shouldBe` expected
|
||||
)
|
||||
|
||||
-- description, request, expected
|
||||
[ ( "simple", simpleURL, simpleExp )
|
||||
, ( "with port", withPortURL, withPortExp )
|
||||
, ( "with path", withPathURL, withPathExp )
|
||||
, ( "with query", withQueryURL, withQueryExp )
|
||||
, ( "blank query", blankQueryURL, blankQueryExp )
|
||||
, ( "with escape", withEscapeURL, withEscapeExp )
|
||||
]
|
||||
|
||||
where
|
||||
simpleURL = newGemURL "example.com"
|
||||
simpleExp = "gemini://example.com/"
|
||||
withPortURL = simpleURL { gemPort = Just 1965 }
|
||||
withPortExp = "gemini://example.com:1965/"
|
||||
withPathURL = simpleURL { gemPath = ["foo", "bar"] }
|
||||
withPathExp = "gemini://example.com/foo/bar"
|
||||
withQueryURL = simpleURL { gemQuery = Just "foo" }
|
||||
withQueryExp = "gemini://example.com/?foo"
|
||||
blankQueryURL = simpleURL { gemQuery = Just "" }
|
||||
blankQueryExp = "gemini://example.com/?"
|
||||
|
||||
withEscapeURL = simpleURL
|
||||
{ gemPath = ["foo bar"]
|
||||
, gemQuery = Just "baz quux"
|
||||
}
|
||||
|
||||
withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
|
||||
|
||||
decodeGemURLSpec :: Spec
|
||||
decodeGemURLSpec = describe "decodeGemURL" $ mapM_
|
||||
( \(str, expected) -> context (show str) $
|
||||
it ("should be " ++ show expected) $
|
||||
decodeGemURL str `shouldBe` expected
|
||||
)
|
||||
|
||||
-- URL string, expected
|
||||
[ ( simpleStr, Just simpleURL )
|
||||
, ( withSlashStr, Just simpleURL )
|
||||
, ( withPathStr, Just withPathURL )
|
||||
, ( withQueryStr, Just withQueryURL )
|
||||
, ( pathQueryStr, Just pathQueryURL )
|
||||
, ( blankQueryStr, Just blankQueryURL )
|
||||
, ( withFragmentStr, Just simpleURL )
|
||||
, ( escapedStr, Just escapedURL )
|
||||
, ( httpStr, Nothing )
|
||||
, ( malformed, Nothing )
|
||||
, ( "", Nothing )
|
||||
]
|
||||
|
||||
where
|
||||
simpleStr = "gemini://example.com"
|
||||
simpleURL = newGemURL "example.com"
|
||||
withSlashStr = simpleStr ++ "/"
|
||||
withPathStr = simpleStr ++ "/foo/bar"
|
||||
withPathURL = simpleURL { gemPath = ["foo", "bar"] }
|
||||
withQueryStr = simpleStr ++ "?foo"
|
||||
withQueryURL = simpleURL { gemQuery = Just "foo" }
|
||||
pathQueryStr = withPathStr ++ "?baz"
|
||||
pathQueryURL = withPathURL { gemQuery = Just "baz" }
|
||||
blankQueryStr = simpleStr ++"?"
|
||||
blankQueryURL = simpleURL { gemQuery = Just "" }
|
||||
withFragmentStr = simpleStr ++ "#foo"
|
||||
escapedStr = simpleStr ++ "/foo%20bar/baz?quux%20stuff"
|
||||
|
||||
escapedURL = simpleURL
|
||||
{ gemPath = ["foo bar", "baz"]
|
||||
, gemQuery = Just "quux stuff"
|
||||
}
|
||||
|
||||
httpStr = "http://example.com"
|
||||
malformed = "foo"
|
||||
|
||||
escapeStringSpec :: Spec
|
||||
escapeStringSpec = describe "escapeString" $ mapM_
|
||||
( \(input, expected) -> context (show input) $
|
||||
it ("should be " ++ show expected) $
|
||||
escapeString input `shouldBe` expected
|
||||
)
|
||||
|
||||
-- input, expected
|
||||
[ ( "~foo-bar_baz.quux", "~foo-bar_baz.quux" )
|
||||
, ( "foo:/?=&#%", "foo%3a%2f%3f%3d%26%23%25" )
|
||||
, ( "foo\xe9", "foo%c3%a9" )
|
||||
]
|
||||
|
||||
unescapeStringSpec :: Spec
|
||||
unescapeStringSpec = describe "unescapeString" $ mapM_
|
||||
( \(input, expected) -> context (show input) $
|
||||
it ("should be " ++ show expected) $
|
||||
unescapeString input `shouldBe` expected
|
||||
)
|
||||
|
||||
-- input, expected
|
||||
[ ( "foo", Just "foo" )
|
||||
, ( "foo%20bar", Just "foo bar" )
|
||||
, ( "foo%7x", Just "foo%7x" )
|
||||
, ( "foo%a", Just "foo%a" )
|
||||
, ( "foo%", Just "foo%" )
|
||||
, ( "foo%c3%a9", Just "foo\xe9" )
|
||||
, ( "foo%ff", Nothing )
|
||||
]
|
||||
|
||||
--jl
|
||||
|
|
@ -20,11 +20,70 @@ License along with this program. If not, see
|
|||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Network.Gemini.Capsule.InternalSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, describe)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Char (ord)
|
||||
import Data.Connection (Connection (..))
|
||||
import System.IO.Streams (nullInput, unRead)
|
||||
import Test.Hspec (Spec, context, describe, shouldReturn, xit)
|
||||
|
||||
import Network.Gemini.Capsule.Types
|
||||
import Network.Gemini.Capsule.Internal
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Internal" $ return ()
|
||||
spec = describe "Internal" $ do
|
||||
readURLSpec
|
||||
sendResponseSpec
|
||||
strFromConnSpec
|
||||
|
||||
readURLSpec :: Spec
|
||||
readURLSpec = describe "readURL" $ mapM_
|
||||
( \(desc, ioConn, expect) -> context desc $
|
||||
xit ("should return " ++ show expect) $
|
||||
do
|
||||
conn <- ioConn
|
||||
readURL conn `shouldReturn` expect
|
||||
)
|
||||
|
||||
-- description, connection, expected result
|
||||
[ ( "valid URL", validConn, Just validExp )
|
||||
, ( "long URL", longConn, Just longExp )
|
||||
, ( "too long URL", tooLongConn, Nothing )
|
||||
, ( "gibberish input", gibConn, Nothing )
|
||||
]
|
||||
|
||||
where
|
||||
validConn = mkConn "gemini://example.com/\r\n"
|
||||
longConn = mkConn longBS
|
||||
tooLongConn = mkConn tooLongBS
|
||||
gibConn = mkConn "aosidjfwoeinboijwefr"
|
||||
longBS = BS.pack (take 1024 bytes) <> "\r\n"
|
||||
tooLongBS = BS.pack (take 1025 bytes) <> "\r\n"
|
||||
bytes = BS.unpack prefix ++ repeat (fromIntegral $ ord 'A')
|
||||
validExp = newGemURL "example.com"
|
||||
longExp = validExp { gemPath = [longDir] }
|
||||
longDir = replicate (1024 - BS.length prefix) 'A'
|
||||
prefix = "gemini://example.com/"
|
||||
mkConn bs = do
|
||||
s <- nullInput
|
||||
unRead bs s
|
||||
return sampleConnection { source = s }
|
||||
|
||||
sendResponseSpec :: Spec
|
||||
sendResponseSpec = describe "sendResponse" $ return ()
|
||||
|
||||
sampleConnection :: Connection a
|
||||
sampleConnection = Connection
|
||||
{ source = undefined
|
||||
, send = const $ return ()
|
||||
, close = return ()
|
||||
, connExtraInfo = undefined
|
||||
}
|
||||
|
||||
strFromConnSpec :: Spec
|
||||
strFromConnSpec = describe "strFromConn" $ return ()
|
||||
|
||||
--jl
|
||||
|
|
|
|||
|
|
@ -22,128 +22,14 @@ License along with this program. If not, see
|
|||
|
||||
module Network.Gemini.CapsuleSpec (spec) where
|
||||
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
import Test.Hspec (Spec, describe)
|
||||
|
||||
import qualified Network.Gemini.Capsule.EncodingSpec as Encoding
|
||||
import qualified Network.Gemini.Capsule.InternalSpec as Internal
|
||||
|
||||
import Network.Gemini.Capsule
|
||||
import Network.Gemini.Capsule.Types
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Network.Gemini.Capsule" $ do
|
||||
Encoding.spec
|
||||
Internal.spec
|
||||
encodeGemURLSpec
|
||||
decodeGemURLSpec
|
||||
escapeStringSpec
|
||||
unescapeStringSpec
|
||||
|
||||
encodeGemURLSpec :: Spec
|
||||
encodeGemURLSpec = describe "encodeGemURL" $ mapM_
|
||||
( \(desc, req, expected) -> context desc $
|
||||
it ("should be " ++ show expected) $
|
||||
encodeGemURL req `shouldBe` expected
|
||||
)
|
||||
|
||||
-- description, request, expected
|
||||
[ ( "simple", simpleURL, simpleExp )
|
||||
, ( "with port", withPortURL, withPortExp )
|
||||
, ( "with path", withPathURL, withPathExp )
|
||||
, ( "with query", withQueryURL, withQueryExp )
|
||||
, ( "blank query", blankQueryURL, blankQueryExp )
|
||||
, ( "with escape", withEscapeURL, withEscapeExp )
|
||||
]
|
||||
|
||||
where
|
||||
simpleURL = newGemURL "example.com"
|
||||
simpleExp = "gemini://example.com/"
|
||||
withPortURL = simpleURL { gemPort = Just 1965 }
|
||||
withPortExp = "gemini://example.com:1965/"
|
||||
withPathURL = simpleURL { gemPath = ["foo", "bar"] }
|
||||
withPathExp = "gemini://example.com/foo/bar"
|
||||
withQueryURL = simpleURL { gemQuery = Just "foo" }
|
||||
withQueryExp = "gemini://example.com/?foo"
|
||||
blankQueryURL = simpleURL { gemQuery = Just "" }
|
||||
blankQueryExp = "gemini://example.com/?"
|
||||
|
||||
withEscapeURL = simpleURL
|
||||
{ gemPath = ["foo bar"]
|
||||
, gemQuery = Just "baz quux"
|
||||
}
|
||||
|
||||
withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
|
||||
|
||||
decodeGemURLSpec :: Spec
|
||||
decodeGemURLSpec = describe "decodeGemURL" $ mapM_
|
||||
( \(str, expected) -> context (show str) $
|
||||
it ("should be " ++ show expected) $
|
||||
decodeGemURL str `shouldBe` expected
|
||||
)
|
||||
|
||||
-- URL string, expected
|
||||
[ ( simpleStr, Just simpleURL )
|
||||
, ( withSlashStr, Just simpleURL )
|
||||
, ( withPathStr, Just withPathURL )
|
||||
, ( withQueryStr, Just withQueryURL )
|
||||
, ( pathQueryStr, Just pathQueryURL )
|
||||
, ( blankQueryStr, Just blankQueryURL )
|
||||
, ( withFragmentStr, Just simpleURL )
|
||||
, ( escapedStr, Just escapedURL )
|
||||
, ( httpStr, Nothing )
|
||||
, ( malformed, Nothing )
|
||||
, ( "", Nothing )
|
||||
]
|
||||
|
||||
where
|
||||
simpleStr = "gemini://example.com"
|
||||
simpleURL = newGemURL "example.com"
|
||||
withSlashStr = simpleStr ++ "/"
|
||||
withPathStr = simpleStr ++ "/foo/bar"
|
||||
withPathURL = simpleURL { gemPath = ["foo", "bar"] }
|
||||
withQueryStr = simpleStr ++ "?foo"
|
||||
withQueryURL = simpleURL { gemQuery = Just "foo" }
|
||||
pathQueryStr = withPathStr ++ "?baz"
|
||||
pathQueryURL = withPathURL { gemQuery = Just "baz" }
|
||||
blankQueryStr = simpleStr ++"?"
|
||||
blankQueryURL = simpleURL { gemQuery = Just "" }
|
||||
withFragmentStr = simpleStr ++ "#foo"
|
||||
escapedStr = simpleStr ++ "/foo%20bar/baz?quux%20stuff"
|
||||
|
||||
escapedURL = simpleURL
|
||||
{ gemPath = ["foo bar", "baz"]
|
||||
, gemQuery = Just "quux stuff"
|
||||
}
|
||||
|
||||
httpStr = "http://example.com"
|
||||
malformed = "foo"
|
||||
|
||||
escapeStringSpec :: Spec
|
||||
escapeStringSpec = describe "escapeString" $ mapM_
|
||||
( \(input, expected) -> context (show input) $
|
||||
it ("should be " ++ show expected) $
|
||||
escapeString input `shouldBe` expected
|
||||
)
|
||||
|
||||
-- input, expected
|
||||
[ ( "~foo-bar_baz.quux", "~foo-bar_baz.quux" )
|
||||
, ( "foo:/?=&#%", "foo%3a%2f%3f%3d%26%23%25" )
|
||||
, ( "foo\xe9", "foo%c3%a9" )
|
||||
]
|
||||
|
||||
unescapeStringSpec :: Spec
|
||||
unescapeStringSpec = describe "unescapeString" $ mapM_
|
||||
( \(input, expected) -> context (show input) $
|
||||
it ("should be " ++ show expected) $
|
||||
unescapeString input `shouldBe` expected
|
||||
)
|
||||
|
||||
-- input, expected
|
||||
[ ( "foo", Just "foo" )
|
||||
, ( "foo%20bar", Just "foo bar" )
|
||||
, ( "foo%7x", Just "foo%7x" )
|
||||
, ( "foo%a", Just "foo%a" )
|
||||
, ( "foo%", Just "foo%" )
|
||||
, ( "foo%c3%a9", Just "foo\xe9" )
|
||||
, ( "foo%ff", Nothing )
|
||||
]
|
||||
|
||||
--jl
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user