152 lines
4.1 KiB
Haskell
152 lines
4.1 KiB
Haskell
{-|
|
|
|
|
Module : Network.Gemini.Capsule.Internal
|
|
Description : internal functions (do not use)
|
|
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/>.
|
|
|
|
= Important Note
|
|
|
|
This is an internal module. It is not intended to be accessed by
|
|
outside packages, and should be considered subject to change at any
|
|
time.
|
|
|
|
-}
|
|
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Network.Gemini.Capsule.Internal (
|
|
runConnection,
|
|
readURL,
|
|
strFromConn,
|
|
readMax,
|
|
stripCRLF
|
|
) where
|
|
|
|
import Control.Monad (when)
|
|
import Control.Monad.Trans.Class (lift)
|
|
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 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
|
|
import Network.Gemini.Capsule.Types
|
|
|
|
-- Constants
|
|
|
|
-- Maximum size to read from a conneciton
|
|
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
|
|
-- ^ the connection
|
|
-> IO (Maybe GemURL)
|
|
readURL conn =
|
|
strFromConn inBufSize conn >>= return <$> \case
|
|
Nothing -> Nothing
|
|
Just str -> decodeGemURL str
|
|
|
|
-- | 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 maxLen conn = do
|
|
mbs <- readMax maxLen conn
|
|
return $ do
|
|
bs <- mbs
|
|
txt <- case decodeUtf8' bs of
|
|
Left _ -> Nothing
|
|
Right s -> Just s
|
|
stripCRLF $ T.unpack txt
|
|
|
|
-- | Reads from a connection up to a maximum number of bytes or a
|
|
-- newline character is encountered, returning 'Nothing' if the limit
|
|
-- is exceeded
|
|
readMax
|
|
:: Int
|
|
-- ^ the maximum number of bytes
|
|
-> Connection a
|
|
-- ^ the 'Connection' to read from
|
|
-> IO (Maybe BS.ByteString)
|
|
readMax maxLen conn = do
|
|
let src = source conn
|
|
runMaybeT $
|
|
BS.pack . BSL.unpack . toLazyByteString
|
|
<$> readLoop maxLen src
|
|
|
|
-- | Strips the CR/LF characters from the end of a string, retuning
|
|
-- Nothing if they are not present
|
|
stripCRLF :: String -> Maybe String
|
|
stripCRLF = \case
|
|
"" -> 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
|
|
Nothing -> return mempty
|
|
Just bs -> do
|
|
let
|
|
len = BS.length bs
|
|
b = byteString bs
|
|
when (len > maxLen) $
|
|
fail "maximum length exceeded"
|
|
if BS.any (== 0xa) bs
|
|
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
|