{-| 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 . = 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 ( readURL, sendResponse, 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, source) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8') 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 -- | 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 -- | 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 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 = undefined 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 --jl