2021-11-10 15:04:00 -05:00
|
|
|
{-
|
|
|
|
|
2021-11-17 13:15:36 -05:00
|
|
|
gemcap
|
2021-11-10 15:04:00 -05:00
|
|
|
|
|
|
|
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/>.
|
|
|
|
|
|
|
|
-}
|
|
|
|
|
2021-11-18 20:00:52 -05:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2021-11-17 13:15:36 -05:00
|
|
|
module Network.Gemini.Capsule.InternalSpec (spec) where
|
2021-11-10 15:04:00 -05:00
|
|
|
|
2021-11-18 20:00:52 -05:00
|
|
|
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
|
2021-11-10 15:04:00 -05:00
|
|
|
|
|
|
|
spec :: Spec
|
2021-11-18 20:00:52 -05:00
|
|
|
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 ()
|
2021-11-10 15:04:00 -05:00
|
|
|
|
|
|
|
--jl
|