@@ -0,0 +1,110 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+{-|
5+
6+Module provides Hazelcast monad and functions for opening connection and
7+sending requests.
8+
9+-}
10+
11+
12+module Database.Hazelcast.Rest.Core
13+ ( connect
14+ , HazelcastEnv(..)
15+ , Hazelcast(..)
16+ , MonadHazelcast(..)
17+ , runHazelcast
18+ , sendRequest
19+ , sendRequests
20+ , defaultConnectInfo
21+ -- reexport
22+ , Internal.Reply(..)
23+ , Internal.ConnectInfo(..)
24+ , Internal.HazelcastHost(..)
25+ ) where
26+
27+import Control.Monad.Reader
28+import Data.IORef
29+import qualified Data.List.NonEmpty as NE
30+import Database.Hazelcast.Rest.Cluster
31+import Database.Hazelcast.Rest.Internal as Internal
32+import qualified Network.HTTP.Client as HTTP
33+
34+
35+-- | Open connection with Hazelcast using connection information.
36+connect :: ConnectInfo -> IO HazelcastEnv
37+connect ConnectInfo{..} = do
38+ let
39+ ss = HTTP.defaultManagerSettings
40+ { HTTP.managerConnCount = connectMaxConnections
41+ , HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro
42+ $ connectTimeoutSeconds * 1000000
43+ }
44+ manager <- HTTP.newManager ss
45+ clusterInfo <- ClusterInfo <$> newIORef (NE.toList connectHosts)
46+ pure (HazelcastEnv manager clusterInfo)
47+
48+-- | 'HazelcastEnv' provides opened connection and cluster information.
49+data HazelcastEnv = HazelcastEnv
50+ { henvConnection :: HTTP.Manager
51+ , henvClusterInfo :: ClusterInfo
52+ }
53+
54+-- | 'Hazelcast' type is a wrapper around ReaderT monad contains 'HazelcastEnv'
55+-- type to read.
56+newtype Hazelcast a = Hazelcast
57+ { unHazelcast :: ReaderT HazelcastEnv IO a
58+ } deriving (Monad, MonadIO, Functor, Applicative)
59+
60+-- | 'MonadHazelcast' provides function to lift Hazelcast type to another.
61+class Monad m => MonadHazelcast m where
62+ liftHazelcast :: Hazelcast a -> m a
63+
64+instance MonadHazelcast Hazelcast where
65+ liftHazelcast = id
66+
67+-- | Hazelcast monad runner.
68+runHazelcast :: HazelcastEnv -> Hazelcast a -> IO a
69+runHazelcast hEnv (Hazelcast hazelcast) =
70+ runReaderT hazelcast hEnv
71+
72+-- | Send HTTP request to Hazelcast using 'MonadHazelcast'.
73+sendRequest
74+ :: (MonadHazelcast m)
75+ => HTTP.Request
76+ -> m Reply
77+sendRequest r =
78+ liftHazelcast . Hazelcast $ do
79+ m <- asks henvConnection
80+ c <- asks henvClusterInfo
81+ HazelcastHost{..} <- liftIO $ roundRobinHost c
82+ let
83+ req = r
84+ { HTTP.host = hostAddr
85+ , HTTP.port = fromIntegral hostPort }
86+ liftIO $ Internal.sendHttpRequest m req
87+
88+-- | Send many HTTP requests to Hazelcast using 'MonadHazelcast'.
89+sendRequests
90+ :: (MonadHazelcast m, Traversable t)
91+ => t HTTP.Request
92+ -> m (t Reply)
93+sendRequests rqs =
94+ liftHazelcast . Hazelcast $ do
95+ m <- asks henvConnection
96+ c <- asks henvClusterInfo
97+ HazelcastHost{..} <- liftIO $ roundRobinHost c
98+ let
99+ modifyReq r = r
100+ { HTTP.host = hostAddr
101+ , HTTP.port = fromIntegral hostPort }
102+ liftIO $ traverse (Internal.sendHttpRequest m . modifyReq) rqs
103+
104+-- | Default Hazelcast connection information.
105+defaultConnectInfo :: ConnectInfo
106+defaultConnectInfo = ConnectInfo
107+ { connectHosts = NE.fromList [HazelcastHost "localhost" 5701]
108+ , connectMaxConnections = 50
109+ , connectTimeoutSeconds = 10
110+ }