gemcap.cabal

@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           gemcap
-version:        0.1.0
+version:        0.0.0
 synopsis:       a simple Gemini capsule (server)
 description:    a simple Gemini capsule (server) - see README.md for details
 category:       Gemini

package.yaml

@@ -1,5 +1,5 @@
 name:                gemcap
-version:             0.1.0
+version:             0.0.0
 license:             AGPL-3.0-or-later
 author:              "Jonathan Lamothe"
 maintainer:          "jonathan@jlamothe.net"

src/Network/Gemini/Capsule.hs

@@ -97,4 +97,18 @@ adjustServerParams certRef params = let
   hooks' = hooks { onClientCertificate = certHook' }
   in params { serverHooks = hooks' }
 
+runConnection
+  :: C.Connection a
+  -> GemHandler
+  -> Maybe Certificate
+  -> IO ()
+runConnection conn handler mCert =
+  ( readURL conn >>= \case
+    Nothing -> return $ newGemResponse
+      { respStatus = 59
+      , respMeta   = "bad request"
+      }
+    Just url -> handler (newGemRequest url) { reqCert = mCert }
+  ) >>= sendResponse conn
+
 --jl

src/Network/Gemini/Capsule/Encoding.hs

@@ -30,21 +30,15 @@ module Network.Gemini.Capsule.Encoding (
   encodeGemURL,
   decodeGemURL,
   escapeString,
-  unescapeString,
+  unescapeString
-  encodeGemResponse
 ) where
 
 import qualified Data.ByteString as BS
-import Data.ByteString.Builder (
+import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
-  charUtf8,
-  lazyByteString,
-  stringUtf8,
-  toLazyByteString,
-  word8Dec)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Char (chr, ord, toLower)
 import Data.List (find, intercalate)
-import Data.Maybe (fromJust, fromMaybe)
+import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8')
 
@@ -143,25 +137,6 @@ unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
     toNum ch = fst $ fromJust $
       find (\x -> snd x == ch) $ zip [0..] hexDigits
 
--- | encodes a 'GemResponse' into a lazy ByteString
-encodeGemResponse :: GemResponse -> BSL.ByteString
-encodeGemResponse resp = let
-  code = respStatus resp
-  high = code `div` 10
-  low  = code `mod` 10
-  meta = respMeta resp
-  body = fromMaybe "" $ respBody resp
-
-  builder
-    =  word8Dec high
-    <> word8Dec low
-    <> charUtf8 ' '
-    <> stringUtf8 meta
-    <> stringUtf8 "\r\n"
-    <> lazyByteString body
-
-  in toLazyByteString builder
-
 hexDigits :: String
 hexDigits = ['0'..'9'] ++ ['a'..'f']
 

src/Network/Gemini/Capsule/Internal.hs

@@ -33,8 +33,8 @@ time.
 {-# LANGUAGE LambdaCase #-}
 
 module Network.Gemini.Capsule.Internal (
-  runConnection,
   readURL,
+  sendResponse,
   strFromConn,
   readMax,
   stripCRLF
@@ -46,10 +46,9 @@ import Control.Monad.Trans.Maybe (MaybeT (..))
 import qualified Data.ByteString as BS
 import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
 import qualified Data.ByteString.Lazy as BSL
-import Data.Connection (Connection, send, source)
+import Data.Connection (Connection, source)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8')
-import Data.X509 (Certificate)
 import qualified System.IO.Streams as S
 
 import Network.Gemini.Capsule.Encoding
@@ -61,21 +60,6 @@ import Network.Gemini.Capsule.Types
 inBufSize :: Int
 inBufSize = 1026
 
--- | process a request and return a response over a 'Connection'
-runConnection
-  :: Connection a
-  -> GemHandler
-  -> Maybe Certificate
-  -> IO ()
-runConnection conn handler mCert =
-  ( readURL conn >>= \case
-    Nothing -> return $ newGemResponse
-      { respStatus = 59
-      , respMeta   = "bad request"
-      }
-    Just url -> handler (newGemRequest url) { reqCert = mCert }
-  ) >>= sendResponse conn
-
 -- | Reads a 'GemURL' from a 'Connection'
 readURL
   :: Connection a
@@ -86,6 +70,15 @@ readURL conn =
     Nothing  -> Nothing
     Just str -> decodeGemURL str
 
+-- | Sends a 'GemResponse' to a 'Connection'
+sendResponse
+  :: Connection a
+  -- ^ the connection
+  -> GemResponse
+  -- ^ the response being sent
+  -> 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
@@ -122,10 +115,7 @@ readMax maxLen conn = do
 -- | Strips the CR/LF characters from the end of a string, retuning
 -- Nothing if they are not present
 stripCRLF :: String -> Maybe String
-stripCRLF = \case
+stripCRLF = undefined
-  ""     -> Nothing
-  "\r\n" -> Just ""
-  c:str  -> (c:) <$> stripCRLF str
 
 readLoop :: Int -> S.InputStream BS.ByteString -> MaybeT IO Builder
 readLoop maxLen src = lift (S.read src) >>= \case
@@ -140,12 +130,4 @@ readLoop maxLen src = lift (S.read src) >>= \case
       then return b
       else (b <>) <$> readLoop (maxLen - len) src
 
-sendResponse
-  :: Connection a
-  -- ^ the connection
-  -> GemResponse
-  -- ^ the response being sent
-  -> IO ()
-sendResponse conn resp = send conn $ encodeGemResponse resp
-
 --jl

test/Network/Gemini/Capsule/EncodingSpec.hs

@@ -20,8 +20,6 @@ License along with this program.  If not, see
 
 -}
 
-{-# LANGUAGE OverloadedStrings #-}
-
 module Network.Gemini.Capsule.EncodingSpec (spec) where
 
 import Test.Hspec (Spec, context, describe, it, shouldBe)
@@ -35,7 +33,6 @@ spec = describe "Encoding" $ do
   decodeGemURLSpec
   escapeStringSpec
   unescapeStringSpec
-  encodeGemResponseSpec
 
 encodeGemURLSpec :: Spec
 encodeGemURLSpec = describe "encodeGemURL" $ mapM_
@@ -146,12 +143,4 @@ unescapeStringSpec = describe "unescapeString" $ mapM_
   , ( "foo%ff",    Nothing        )
   ]
 
-encodeGemResponseSpec :: Spec
-encodeGemResponseSpec = describe "encodeGemResponse" $
-  it ("should be " ++ show expect) $
-    encodeGemResponse resp `shouldBe` expect
-  where
-    resp   = newGemResponse { respBody = Just "Success!\r\n" }
-    expect = "20 text/gemini\r\nSuccess!\r\n"
-
 --jl

test/Network/Gemini/Capsule/InternalSpec.hs

@@ -25,70 +25,26 @@ License along with this program.  If not, see
 module Network.Gemini.Capsule.InternalSpec (spec) where
 
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BSL
 import Data.Char (ord)
 import Data.Connection (Connection (..))
-import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
-import Data.X509 (Certificate (..))
 import System.IO.Streams (nullInput, unRead)
-import Test.Hspec (
+import Test.Hspec (Spec, context, describe, it, shouldReturn, xit)
-  Spec,
-  context,
-  describe,
-  it,
-  shouldBe,
-  shouldReturn)
 
 import Network.Gemini.Capsule.Types
 import Network.Gemini.Capsule.Internal
 
 spec :: Spec
 spec = describe "Internal" $ do
-  runConnectionSpec
   readURLSpec
+  sendResponseSpec
   strFromConnSpec
   readMaxSpec
   stripCRLFSpec
 
-runConnectionSpec :: Spec
-runConnectionSpec = describe "runConnection" $ mapM_
-  ( \(desc, ioConnRef, handler, mCert, expect) -> context desc $
-    it ("should return " ++ show expect) $ do
-      (conn, outRef) <- ioConnRef
-      runConnection conn handler mCert
-      readIORef outRef `shouldReturn` expect
-  )
-
-  --  description,            connection,  handler, certificate,     expectation
-  [ ( "basic connection",     basicConn,   basicH,  Nothing,         basicExp    )
-  , ( "no certificate",       basicConn,   certH,   Nothing,         noCertExp   )
-  , ( "with certificate",     basicConn,   certH,   Just sampleCert, basicExp    )
-  , ( "gibberish with CR/LF", gibConnCRLF, basicH,  Nothing,         gibExp      )
-  , ( "gibberish w/o CR/LF",  gibConn,     basicH,  Nothing,         gibExp      )
-  ]
-
-  where
-    basicConn   = mkIOConn ["gemini://example.com/\r\n"]
-    gibConnCRLF = mkIOConn ["aosidjgfoeribjeworifj\r\n"]
-    gibConn     = mkIOConn ["sodifjboije"]
-    basicH _    = return newGemResponse { respBody = Just success }
-
-    certH req = return $ case reqCert req of
-      Nothing -> newGemResponse
-        { respStatus = 60
-        , respMeta   = "certificate required"
-        }
-      Just _ -> newGemResponse { respBody = Just success }
-
-    basicExp  = ["20 text/gemini\r\nSuccess!\r\n"]
-    noCertExp = ["60 certificate required\r\n"]
-    gibExp    = ["59 bad request\r\n"]
-    success   = "Success!\r\n"
-
 readURLSpec :: Spec
 readURLSpec = describe "readURL" $ mapM_
   ( \(desc, ioConn, expect) -> context desc $
-    it ("should return " ++ show expect) $
+    xit ("should return " ++ show expect) $
       do
         conn <- ioConn
         readURL conn `shouldReturn` expect
@@ -114,10 +70,13 @@ readURLSpec = describe "readURL" $ mapM_
     longDir     = replicate (1024 - BS.length prefix) 'A'
     prefix      = "gemini://example.com/"
 
+sendResponseSpec :: Spec
+sendResponseSpec = describe "sendResponse" $ return ()
+
 strFromConnSpec :: Spec
 strFromConnSpec = describe "strFromConn" $ mapM_
   ( \(desc, maxLen, ioConn, expect) -> context desc $
-    it ("should return " ++ show expect) $ do
+    xit ("should return " ++ show expect) $ do
       conn <- ioConn
       strFromConn maxLen conn `shouldReturn` expect
   )
@@ -156,26 +115,7 @@ readMaxSpec = describe "readMax" $ mapM_
     longBS     = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
 stripCRLFSpec :: Spec
-stripCRLFSpec = describe "stripCRLF" $ mapM_
+stripCRLFSpec = describe "stripCRLF" $ return ()
-  ( \(input, expected) -> context (show input) $
-    it ("should be" ++ show expected) $
-      stripCRLF input `shouldBe` expected
-  )
-
-  --  input,     expectation
-  [ ( "foo\r\n", Just "foo"  )
-  , ( "foo\n",   Nothing     )
-  , ( "foo",     Nothing     )
-  , ( "\r\n",    Just ""     )
-  ]
-
-mkIOConn :: [BS.ByteString] -> IO (Connection (), IORef [BSL.ByteString])
-mkIOConn input = do
-  ref  <- newIORef []
-  conn <-
-    ( \c -> c { send = \bs -> modifyIORef' ref (++[bs]) }
-    ) <$> mkInConn input
-  return (conn, ref)
 
 mkInConn :: [BS.ByteString] -> IO (Connection ())
 mkInConn bss = do
@@ -187,16 +127,4 @@ mkInConn bss = do
     connExtraInfo = ()
   return Connection {..}
 
-sampleCert :: Certificate
-sampleCert = Certificate
-  { certVersion      = undefined
-  , certSerial       = undefined
-  , certSignatureAlg = undefined
-  , certIssuerDN     = undefined
-  , certValidity     = undefined
-  , certSubjectDN    = undefined
-  , certPubKey       = undefined
-  , certExtensions   = undefined
-  }
-
 --jl