{- gemserv Cooyright (C) Jonathan Lamothe 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 . -} {-# LANGUAGE OverloadedStrings #-} module Network.GemServ.InternalSpec (spec) where 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, it, shouldReturn) import Network.GemServ.Types import Network.GemServ.Internal spec :: Spec spec = describe "Internal" $ do readURLSpec sendResponseSpec readURLSpec :: Spec readURLSpec = describe "readURL" $ mapM_ ( \(desc, ioConn, expect) -> context desc $ it ("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 = undefined , close = return () , connExtraInfo = undefined } --jl