{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}

{-|
Helper module for working with S3 servers.
-}

module Test.Sandwich.Contexts.Types.S3 (
  TestS3Server(..)
  , HttpMode(..)

  -- * Contexts
  , testS3Server
  , HasTestS3Server

  -- * Endpoints
  , testS3ServerEndpoint
  , testS3ServerContainerEndpoint

  -- * Misc
  , s3Protocol
  ) where

import Data.String.Interpolate
import Relude
import Test.Sandwich
import Test.Sandwich.Contexts.Types.Network


testS3Server :: Label "testS3Server" TestS3Server
testS3Server :: Label "testS3Server" TestS3Server
testS3Server = Label "testS3Server" TestS3Server
forall {k} (l :: Symbol) (a :: k). Label l a
Label

-- | A generic test S3 server. This can be used by downstream packages like sandwich-contexts-minio.
data TestS3Server = TestS3Server {
  TestS3Server -> NetworkAddress
testS3ServerAddress :: NetworkAddress
  -- | The address of the S3 server within its container, if present.
  -- Useful if you're doing container-to-container networking.
  , TestS3Server -> Maybe NetworkAddress
testS3ServerContainerAddress :: Maybe NetworkAddress
  , TestS3Server -> Text
testS3ServerAccessKeyId :: Text
  , TestS3Server -> Text
testS3ServerSecretAccessKey :: Text
  , TestS3Server -> Maybe Text
testS3ServerBucket :: Maybe Text
  , TestS3Server -> HttpMode
testS3ServerHttpMode :: HttpMode
  } deriving (Int -> TestS3Server -> ShowS
[TestS3Server] -> ShowS
TestS3Server -> String
(Int -> TestS3Server -> ShowS)
-> (TestS3Server -> String)
-> ([TestS3Server] -> ShowS)
-> Show TestS3Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestS3Server -> ShowS
showsPrec :: Int -> TestS3Server -> ShowS
$cshow :: TestS3Server -> String
show :: TestS3Server -> String
$cshowList :: [TestS3Server] -> ShowS
showList :: [TestS3Server] -> ShowS
Show, TestS3Server -> TestS3Server -> Bool
(TestS3Server -> TestS3Server -> Bool)
-> (TestS3Server -> TestS3Server -> Bool) -> Eq TestS3Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestS3Server -> TestS3Server -> Bool
== :: TestS3Server -> TestS3Server -> Bool
$c/= :: TestS3Server -> TestS3Server -> Bool
/= :: TestS3Server -> TestS3Server -> Bool
Eq)

data HttpMode =
  HttpModeHttp
  | HttpModeHttps
  -- | A special mode to allow a server to run in HTTPS mode, but connect to it without HTTPS validation. Useful for tests.
  | HttpModeHttpsNoValidate
  deriving (Int -> HttpMode -> ShowS
[HttpMode] -> ShowS
HttpMode -> String
(Int -> HttpMode -> ShowS)
-> (HttpMode -> String) -> ([HttpMode] -> ShowS) -> Show HttpMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpMode -> ShowS
showsPrec :: Int -> HttpMode -> ShowS
$cshow :: HttpMode -> String
show :: HttpMode -> String
$cshowList :: [HttpMode] -> ShowS
showList :: [HttpMode] -> ShowS
Show, HttpMode -> HttpMode -> Bool
(HttpMode -> HttpMode -> Bool)
-> (HttpMode -> HttpMode -> Bool) -> Eq HttpMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpMode -> HttpMode -> Bool
== :: HttpMode -> HttpMode -> Bool
$c/= :: HttpMode -> HttpMode -> Bool
/= :: HttpMode -> HttpMode -> Bool
Eq)

type HasTestS3Server context = HasLabel context "testS3Server" TestS3Server

-- | Generate an S3 connection string for the given server.
testS3ServerEndpoint :: TestS3Server -> Text
testS3ServerEndpoint :: TestS3Server -> Text
testS3ServerEndpoint serv :: TestS3Server
serv@(TestS3Server {testS3ServerAddress :: TestS3Server -> NetworkAddress
testS3ServerAddress=(NetworkAddressTCP String
hostname PortNumber
port)}) =
  [i|#{s3Protocol serv}://#{hostname}:#{port}|]
testS3ServerEndpoint serv :: TestS3Server
serv@(TestS3Server {testS3ServerAddress :: TestS3Server -> NetworkAddress
testS3ServerAddress=(NetworkAddressUnix String
path)}) =
  [i|#{s3Protocol serv}://#{path}|]

-- | Generate an S3 connection string for the given containerized server, for the network address inside the container.
-- Returns 'Nothing' if this server isn't containerized.
testS3ServerContainerEndpoint :: TestS3Server -> Maybe Text
testS3ServerContainerEndpoint :: TestS3Server -> Maybe Text
testS3ServerContainerEndpoint serv :: TestS3Server
serv@(TestS3Server {testS3ServerContainerAddress :: TestS3Server -> Maybe NetworkAddress
testS3ServerContainerAddress=(Just (NetworkAddressTCP String
hostname PortNumber
port))}) =
  Text -> Maybe Text
forall a. a -> Maybe a
Just [i|#{s3Protocol serv}://#{hostname}:#{port}|]
testS3ServerContainerEndpoint serv :: TestS3Server
serv@(TestS3Server {testS3ServerContainerAddress :: TestS3Server -> Maybe NetworkAddress
testS3ServerContainerAddress=(Just (NetworkAddressUnix String
path))}) =
  Text -> Maybe Text
forall a. a -> Maybe a
Just [i|#{s3Protocol serv}://#{path}|]
testS3ServerContainerEndpoint TestS3Server
_ = Maybe Text
forall a. Maybe a
Nothing

-- | Return either "http" or "https", based on the 'testS3ServerHttpMode'.
s3Protocol :: TestS3Server -> Text
s3Protocol :: TestS3Server -> Text
s3Protocol (TestS3Server {Maybe Text
Maybe NetworkAddress
Text
NetworkAddress
HttpMode
testS3ServerAddress :: TestS3Server -> NetworkAddress
testS3ServerContainerAddress :: TestS3Server -> Maybe NetworkAddress
testS3ServerAccessKeyId :: TestS3Server -> Text
testS3ServerSecretAccessKey :: TestS3Server -> Text
testS3ServerBucket :: TestS3Server -> Maybe Text
testS3ServerHttpMode :: TestS3Server -> HttpMode
testS3ServerAddress :: NetworkAddress
testS3ServerContainerAddress :: Maybe NetworkAddress
testS3ServerAccessKeyId :: Text
testS3ServerSecretAccessKey :: Text
testS3ServerBucket :: Maybe Text
testS3ServerHttpMode :: HttpMode
..}) = if HttpMode
testS3ServerHttpMode HttpMode -> HttpMode -> Bool
forall a. Eq a => a -> a -> Bool
== HttpMode
HttpModeHttp then Text
"http" else Text
"https"