{-|

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 :: Int
inBufSize = Int
1026

-- | process a request and return a response over a 'Connection'
runConnection
  :: Connection a
  -> GemHandler
  -> Maybe Certificate
  -> IO ()
runConnection :: forall a. Connection a -> GemHandler -> Maybe Certificate -> IO ()
runConnection Connection a
conn GemHandler
handler Maybe Certificate
mCert =
  ( forall a. Connection a -> IO (Maybe GemURL)
readURL Connection a
conn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe GemURL
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GemResponse
newGemResponse
      { respStatus :: Word8
respStatus = Word8
59
      , respMeta :: String
respMeta   = String
"bad request"
      }
    Just GemURL
url -> GemHandler
handler (GemURL -> GemRequest
newGemRequest GemURL
url) { reqCert :: Maybe Certificate
reqCert = Maybe Certificate
mCert }
  ) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Connection a -> GemResponse -> IO ()
sendResponse Connection a
conn

-- | Reads a 'GemURL' from a 'Connection'
readURL
  :: Connection a
  -- ^ the connection
  -> IO (Maybe GemURL)
readURL :: forall a. Connection a -> IO (Maybe GemURL)
readURL Connection a
conn =
  forall a. Int -> Connection a -> IO (Maybe String)
strFromConn Int
inBufSize Connection a
conn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> \case
    Maybe String
Nothing  -> forall a. Maybe a
Nothing
    Just String
str -> String -> Maybe GemURL
decodeGemURL String
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 :: forall a. Int -> Connection a -> IO (Maybe String)
strFromConn Int
maxLen Connection a
conn = do
  Maybe ByteString
mbs <- forall a. Int -> Connection a -> IO (Maybe ByteString)
readMax Int
maxLen Connection a
conn
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs  <- Maybe ByteString
mbs
    Text
txt <- case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
      Left UnicodeException
_  -> forall a. Maybe a
Nothing
      Right Text
s -> forall a. a -> Maybe a
Just Text
s
    String -> Maybe String
stripCRLF forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
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 :: forall a. Int -> Connection a -> IO (Maybe ByteString)
readMax Int
maxLen Connection a
conn = do
  let src :: InputStream ByteString
src = forall a. Connection a -> InputStream ByteString
source Connection a
conn
  forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$
    [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InputStream ByteString -> MaybeT IO Builder
readLoop Int
maxLen InputStream ByteString
src

-- | Strips the CR/LF characters from the end of a string, retuning
-- Nothing if they are not present
stripCRLF :: String -> Maybe String
stripCRLF :: String -> Maybe String
stripCRLF = \case
  String
""     -> forall a. Maybe a
Nothing
  String
"\r\n" -> forall a. a -> Maybe a
Just String
""
  Char
c:String
str  -> (Char
cforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
stripCRLF String
str

readLoop :: Int -> S.InputStream BS.ByteString -> MaybeT IO Builder
readLoop :: Int -> InputStream ByteString -> MaybeT IO Builder
readLoop Int
maxLen InputStream ByteString
src = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. InputStream a -> IO (Maybe a)
S.read InputStream ByteString
src) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  Just ByteString
bs -> do
    let
      len :: Int
len = ByteString -> Int
BS.length ByteString
bs
      b :: Builder
b   = ByteString -> Builder
byteString ByteString
bs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> Int
maxLen) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"maximum length exceeded"
    if (Word8 -> Bool) -> ByteString -> Bool
BS.any (forall a. Eq a => a -> a -> Bool
== Word8
0xa) ByteString
bs
      then forall (m :: * -> *) a. Monad m => a -> m a
return Builder
b
      else (Builder
b forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> InputStream ByteString -> MaybeT IO Builder
readLoop (Int
maxLen forall a. Num a => a -> a -> a
- Int
len) InputStream ByteString
src

sendResponse
  :: Connection a
  -- ^ the connection
  -> GemResponse
  -- ^ the response being sent
  -> IO ()
sendResponse :: forall a. Connection a -> GemResponse -> IO ()
sendResponse Connection a
conn GemResponse
resp = forall a. Connection a -> ByteString -> IO ()
send Connection a
conn forall a b. (a -> b) -> a -> b
$ GemResponse -> ByteString
encodeGemResponse GemResponse
resp

--jl