{-|

Module      : Network.Gemini.Capsule.Types
Description : Gemini capsule types
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/>.

-}

module Network.Gemini.Capsule.Types (
  -- * Types
  GemURL (..),
  GemRequest (..),
  GemResponse (..),
  GemHandler,
  GemCapSettings (..),
  -- * Constructors
  newGemURL,
  newGemRequest,
  newGemResponse,
  newGemCapSettings
) where

import qualified Data.ByteString.Lazy as BSL
import Data.Word (Word8, Word16, Word32)
import Data.X509 (Certificate)

-- | Gemini URL
data GemURL = GemURL
  { GemURL -> String
gemHost :: String
  -- ^ The host part of the authority section, e.g.: "example.com"
  , GemURL -> Maybe Word32
gemPort :: Maybe Word32
  -- ^ The port number (if supplied)
  , GemURL -> [String]
gemPath :: [String]
  -- ^ The decoded path segments
  , GemURL -> Maybe String
gemQuery :: Maybe String
  -- ^ The decoded request query (if supplied)
  } deriving (GemURL -> GemURL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GemURL -> GemURL -> Bool
$c/= :: GemURL -> GemURL -> Bool
== :: GemURL -> GemURL -> Bool
$c== :: GemURL -> GemURL -> Bool
Eq, Int -> GemURL -> ShowS
[GemURL] -> ShowS
GemURL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GemURL] -> ShowS
$cshowList :: [GemURL] -> ShowS
show :: GemURL -> String
$cshow :: GemURL -> String
showsPrec :: Int -> GemURL -> ShowS
$cshowsPrec :: Int -> GemURL -> ShowS
Show)

-- | Describes a Gemini request
data GemRequest = GemRequest
  { GemRequest -> GemURL
reqURL :: GemURL
  -- ^ The URL being requested
  , GemRequest -> Maybe Certificate
reqCert :: Maybe Certificate
  -- ^ The client certificate (if available)
  } deriving (GemRequest -> GemRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GemRequest -> GemRequest -> Bool
$c/= :: GemRequest -> GemRequest -> Bool
== :: GemRequest -> GemRequest -> Bool
$c== :: GemRequest -> GemRequest -> Bool
Eq, Int -> GemRequest -> ShowS
[GemRequest] -> ShowS
GemRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GemRequest] -> ShowS
$cshowList :: [GemRequest] -> ShowS
show :: GemRequest -> String
$cshow :: GemRequest -> String
showsPrec :: Int -> GemRequest -> ShowS
$cshowsPrec :: Int -> GemRequest -> ShowS
Show)

-- | Describes a response to a Gemini request
data GemResponse = GemResponse
  { GemResponse -> Word8
respStatus :: Word8
  -- ^ The response status code
  , GemResponse -> String
respMeta :: String
  -- ^ The response metadata
  , GemResponse -> Maybe ByteString
respBody :: Maybe BSL.ByteString
  -- ^ The response body
  } deriving (GemResponse -> GemResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GemResponse -> GemResponse -> Bool
$c/= :: GemResponse -> GemResponse -> Bool
== :: GemResponse -> GemResponse -> Bool
$c== :: GemResponse -> GemResponse -> Bool
Eq, Int -> GemResponse -> ShowS
[GemResponse] -> ShowS
GemResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GemResponse] -> ShowS
$cshowList :: [GemResponse] -> ShowS
show :: GemResponse -> String
$cshow :: GemResponse -> String
showsPrec :: Int -> GemResponse -> ShowS
$cshowsPrec :: Int -> GemResponse -> ShowS
Show)

-- | Handles a 'GemRequest' to produce a 'GemResponse'
type GemHandler = GemRequest -> IO GemResponse

-- | The settings required to set up a Gemini capsule
data GemCapSettings = GemCapSettings
  { GemCapSettings -> Int
capConnections :: Int
  -- ^ Number of simultaneous connections allowed
  , GemCapSettings -> Word16
capPort :: Word16
  -- ^ The capsule port number
  , GemCapSettings -> String
capCert :: FilePath
  -- ^ The path to the TLS certificate
  , GemCapSettings -> [String]
capCertChain :: [FilePath]
  -- ^ The paths to the chain certificates
  , GemCapSettings -> String
capKey :: FilePath
  -- ^ The path to the private key
  } deriving (GemCapSettings -> GemCapSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GemCapSettings -> GemCapSettings -> Bool
$c/= :: GemCapSettings -> GemCapSettings -> Bool
== :: GemCapSettings -> GemCapSettings -> Bool
$c== :: GemCapSettings -> GemCapSettings -> Bool
Eq, Int -> GemCapSettings -> ShowS
[GemCapSettings] -> ShowS
GemCapSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GemCapSettings] -> ShowS
$cshowList :: [GemCapSettings] -> ShowS
show :: GemCapSettings -> String
$cshow :: GemCapSettings -> String
showsPrec :: Int -> GemCapSettings -> ShowS
$cshowsPrec :: Int -> GemCapSettings -> ShowS
Show)

-- | Builds a new 'GemURL'
newGemURL
  :: String
  -- ^ The hostname
  -> GemURL
newGemURL :: String -> GemURL
newGemURL String
host = GemURL
  { gemHost :: String
gemHost  = String
host
  , gemPort :: Maybe Word32
gemPort  = forall a. Maybe a
Nothing
  , gemPath :: [String]
gemPath  = []
  , gemQuery :: Maybe String
gemQuery = forall a. Maybe a
Nothing
  }

-- | Builds a 'GemRequest'
newGemRequest
  :: GemURL
  -- ^ The request URL
  -> GemRequest
newGemRequest :: GemURL -> GemRequest
newGemRequest GemURL
url = GemRequest
  { reqURL :: GemURL
reqURL  = GemURL
url
  , reqCert :: Maybe Certificate
reqCert = forall a. Maybe a
Nothing
  }

-- | Builds a 'GemResponse'
newGemResponse :: GemResponse
newGemResponse :: GemResponse
newGemResponse = GemResponse
  { respStatus :: Word8
respStatus = Word8
20
  , respMeta :: String
respMeta   = String
"text/gemini"
  , respBody :: Maybe ByteString
respBody   = forall a. Maybe a
Nothing
  }

-- | Builds a reasonable set of server settings.
newGemCapSettings
  :: FilePath
  -- ^ Path to the server certificate
  -> FilePath
  -- ^ Path to the private key
  -> GemCapSettings
newGemCapSettings :: String -> String -> GemCapSettings
newGemCapSettings String
cert String
key = GemCapSettings
  { capConnections :: Int
capConnections = Int
100
  , capPort :: Word16
capPort        = Word16
1965
  , capCert :: String
capCert        = String
cert
  , capCertChain :: [String]
capCertChain   = []
  , capKey :: String
capKey         = String
key
  }

--jl