diff --git a/acid-state.cabal b/acid-state.cabal --- a/acid-state.cabal +++ b/acid-state.cabal @@ -1,5 +1,5 @@ Name: acid-state -Version: 0.15.2 +Version: 0.16.0 Synopsis: Add ACID guarantees to any serializable Haskell data structure. Description: Use regular Haskell data structures as your database and get stronger ACID guarantees than most RDBMS offer. Homepage: https://github.com/acid-state/acid-state @@ -10,7 +10,7 @@ Category: Database Build-type: Simple Cabal-version: >=1.10 -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.3 +tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.3, GHC == 8.8.1 Extra-source-files: CHANGELOG.md test-state/OldStateTest1/*.log @@ -55,8 +55,9 @@ filelock, filepath, mtl, - network < 2.9, - template-haskell, + network < 3.2, + network-bsd, + template-haskell < 2.16, th-expand-syns if os(windows) diff --git a/examples/KeyValue.hs b/examples/KeyValue.hs --- a/examples/KeyValue.hs +++ b/examples/KeyValue.hs @@ -11,7 +11,6 @@ import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy -import Network import System.Environment import System.Exit import System.IO diff --git a/examples/Proxy.hs b/examples/Proxy.hs --- a/examples/Proxy.hs +++ b/examples/Proxy.hs @@ -11,7 +11,6 @@ import Control.Monad.Reader import Control.Monad.State import Data.SafeCopy -import Network import System.Environment import System.IO @@ -45,17 +44,19 @@ openLocal = openLocalState (StressState 0) openRemote :: String -> IO (AcidState ProxyStressState) -openRemote socket = openRemoteState skipAuthenticationPerform "localhost" (UnixSocket socket) +openRemote socket = openRemoteState skipAuthenticationPerform "localhost" port +port = 6303 + main :: IO () main = do args <- getArgs case args of ["server", socket] -> do acid <- openLocal - acidServer skipAuthenticationCheck (UnixSocket socket) acid + acidServer skipAuthenticationCheck port acid ["proxy", from, to] -> do acid <- openRemote from - acidServer skipAuthenticationCheck (UnixSocket to) acid + acidServer skipAuthenticationCheck port acid ["query", socket] -> do acid <- openRemote socket n <- query acid QueryState diff --git a/examples/RemoteClient.hs b/examples/RemoteClient.hs --- a/examples/RemoteClient.hs +++ b/examples/RemoteClient.hs @@ -4,7 +4,7 @@ import Data.Acid import Data.Acid.Advanced import Data.Acid.Remote -import Network +import Network.Socket (SockAddr(..)) import RemoteCommon import System.Environment import System.IO @@ -13,7 +13,9 @@ -- This is how AcidState is used: open :: IO (AcidState StressState) -open = openRemoteState skipAuthenticationPerform "localhost" (PortNumber 8080) +open = openRemoteState skipAuthenticationPerform "localhost" 8080 +-- on Unixy systems we could use a Unix Domain Socket +-- open = openRemoteStateSockAddr skipAuthenticationPerform (SockAddrUnix "remote.socket") main :: IO () main = do args <- getArgs diff --git a/examples/RemoteServer.hs b/examples/RemoteServer.hs --- a/examples/RemoteServer.hs +++ b/examples/RemoteServer.hs @@ -2,10 +2,12 @@ import Control.Exception (bracket) import Data.Acid (closeAcidState, openLocalState) -import Data.Acid.Remote (acidServer, skipAuthenticationCheck) -import Network (PortID (..)) +import Data.Acid.Remote (acidServer, acidServerSockAddr, skipAuthenticationCheck) import RemoteCommon (StressState (..)) +import Network.Socket (SockAddr(..)) main :: IO () main = bracket (openLocalState $ StressState 0) - closeAcidState $ acidServer skipAuthenticationCheck (PortNumber 8080) + closeAcidState $ acidServer skipAuthenticationCheck 8080 +-- on Unixy systems we could use a Unix Domain Socket +-- closeAcidState $ acidServerSockAddr skipAuthenticationCheck (SockAddrUnix "remote.socket") diff --git a/examples/errors/Exceptions.hs b/examples/errors/Exceptions.hs --- a/examples/errors/Exceptions.hs +++ b/examples/errors/Exceptions.hs @@ -29,7 +29,7 @@ -- The transaction we will execute over the state. failEvent :: Update MyState () -failEvent = fail "fail!" +failEvent = pure $ error "fail!" errorEvent :: Update MyState () errorEvent = error "error!" diff --git a/src/Data/Acid/Remote.hs b/src/Data/Acid/Remote.hs --- a/src/Data/Acid/Remote.hs +++ b/src/Data/Acid/Remote.hs @@ -25,7 +25,7 @@ 'openRemoteState' and 'acidServer' communicate over an unencrypted socket. If you need an encrypted connection, see @acid-state-tls@. -On Unix®-like systems you can use 'UnixSocket' to create a socket file for +On Unix®-like systems you can use 'SockAddrUnix' to create a socket file for local communication between the client and server. Access can be controlled by setting the permissions of the parent directory containing the socket file. @@ -33,7 +33,7 @@ It is also possible to perform some simple authentication using 'sharedSecretCheck' and 'sharedSecretPerform'. Keep in mind that secrets will be sent in plain-text if you do not use -@acid-state-tls@. If you are using a 'UnixSocket' additional +@acid-state-tls@. If you are using a 'SockAddrUnix' additional authentication may not be required, so you can use 'skipAuthenticationCheck' and 'skipAuthenticationPerform'. @@ -78,8 +78,10 @@ ( -- * Server/Client acidServer + , acidServerSockAddr , acidServer' , openRemoteState + , openRemoteStateSockAddr -- * Authentication , skipAuthenticationCheck , skipAuthenticationPerform @@ -99,7 +101,7 @@ import Control.Concurrent.STM.TQueue import Control.Exception ( AsyncException(ThreadKilled) , Exception(fromException), IOException, Handler(..) - , SomeException, catch, catches, throw ) + , SomeException, catch, catches, throw, bracketOnError ) import Control.Exception ( throwIO, finally ) import Control.Monad ( forever, liftM, join, when ) import Control.Concurrent ( ThreadId, forkIO, threadDelay, killThread, myThreadId ) @@ -117,11 +119,11 @@ import Data.Set ( Set, member ) import Data.Typeable ( Typeable ) import GHC.IO.Exception ( IOErrorType(..) ) -import Network ( HostName, PortID(..), connectTo, listenOn, withSocketsDo ) -import Network.Socket ( Socket, accept, sClose ) -import Network.Socket.ByteString ( recv, sendAll ) +import Network.BSD ( PortNumber, getProtocolNumber, getHostByName, hostAddress ) +import Network.Socket +import Network.Socket.ByteString as NSB ( recv, sendAll ) import System.Directory ( removeFile ) -import System.IO ( Handle, hPrint, hFlush, hClose, stderr ) +import System.IO ( Handle, hPrint, hFlush, hClose, stderr, IOMode(..) ) import System.IO.Error ( ioeGetErrorType, isFullError, isDoesNotExistError ) debugStrLn :: String -> IO () @@ -163,8 +165,8 @@ socketToCommChannel :: Socket -> CommChannel socketToCommChannel socket = CommChannel { ccPut = sendAll socket - , ccGetSome = recv socket - , ccClose = sClose socket + , ccGetSome = NSB.recv socket + , ccClose = close socket } {- | skip server-side authentication checking entirely. -} @@ -207,32 +209,67 @@ then return () else throwIO (AuthenticationError "shared secret authentication failed.") -{- | Accept connections on @port@ and handle requests using the given 'AcidState'. +{- | Accept connections on @sockAddr@ and handle requests using the given 'AcidState'. This call doesn't return. - On Unix®-like systems you can use 'UnixSocket' to communicate - using a socket file. To control access, you can set the permissions of - the parent directory which contains the socket file. - - see also: 'openRemoteState' and 'sharedSecretCheck'. + see also: 'acidServer', 'openRemoteState' and 'sharedSecretCheck'. -} -acidServer :: (CommChannel -> IO Bool) -- ^ check authentication, see 'sharedSecretPerform' - -> PortID -- ^ Port to listen on +acidServerSockAddr :: (CommChannel -> IO Bool) -- ^ check authentication, see 'sharedSecretPerform' + -> SockAddr -- ^ SockAddr to listen on -> AcidState st -- ^ state to serve -> IO () -acidServer checkAuth port acidState - = withSocketsDo $ - do listenSocket <- listenOn port +acidServerSockAddr checkAuth sockAddr acidState + = do listenSocket <- listenOn sockAddr (acidServer' checkAuth listenSocket acidState) `finally` (cleanup listenSocket) where cleanup socket = - do sClose socket - case port of + do close socket #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) - UnixSocket path -> removeFile path + case sockAddr of + (SockAddrUnix path) -> removeFile path + _ -> pure () #endif - _ -> return () + +{- | Accept connections on @port@ and handle requests using the given 'AcidState'. + This call doesn't return. + + see also: 'acidServerSockAddr', 'openRemoteState' and 'sharedSecretCheck'. + -} +acidServer :: (CommChannel -> IO Bool) -- ^ check authentication, see 'sharedSecretPerform' + -> PortNumber -- ^ Port to listen on + -> AcidState st -- ^ state to serve + -> IO () +acidServer checkAuth port acidState + = acidServerSockAddr checkAuth (SockAddrInet port 0) acidState + +listenOn :: SockAddr -> IO Socket +listenOn sockAddr = do +#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) + proto <- case sockAddr of + (SockAddrUnix {}) -> pure 0 + _ -> getProtocolNumber "tcp" +#else + proto <- getProtocolNumber "tcp" +#endif + bracketOnError + (socket af Stream proto) + close + (\sock -> do + setSocketOption sock ReuseAddr 1 + bind sock sockAddr + listen sock maxListenQueue + return sock + ) + + where + af = case sockAddr of + (SockAddrInet {}) -> AF_INET + (SockAddrInet6 {}) -> AF_INET6 +#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) + (SockAddrUnix {}) -> AF_UNIX +#endif + {- | Works the same way as 'acidServer', but uses pre-binded socket @listenSocket@. Can be useful when fine-tuning of socket binding parameters is needed @@ -343,18 +380,49 @@ {- | Connect to an acid-state server which is sharing an 'AcidState'. -} openRemoteState :: IsAcidic st => (CommChannel -> IO ()) -- ^ authentication function, see 'sharedSecretPerform' - -> HostName -- ^ remote host to connect to (ignored when 'PortID' is 'UnixSocket') - -> PortID -- ^ remote port to connect to + -> HostName -- ^ remote host to connect to + -> PortNumber -- ^ remote port to connect to -> IO (AcidState st) -openRemoteState performAuthorization host port +openRemoteState performAuthorization host port = + do he <- getHostByName host + openRemoteStateSockAddr performAuthorization (SockAddrInet port (hostAddress he)) + +{- | Connect to an acid-state server which is sharing an 'AcidState'. -} +openRemoteStateSockAddr :: IsAcidic st => + (CommChannel -> IO ()) -- ^ authentication function, see 'sharedSecretPerform' + -> SockAddr -- ^ remote SockAddr to connect to + -> IO (AcidState st) +openRemoteStateSockAddr performAuthorization sockAddr = withSocketsDo $ do processRemoteState reconnect where + af :: Family + af = case sockAddr of + (SockAddrInet {}) -> AF_INET + (SockAddrInet6 {}) -> AF_INET6 +#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) + (SockAddrUnix {}) -> AF_UNIX +#endif + -- | reconnect reconnect :: IO CommChannel reconnect = (do debugStrLn "Reconnecting." - handle <- connectTo host port +#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS) && !defined(_WIN32) + proto <- case sockAddr of + (SockAddrUnix {}) -> pure 0 + _ -> getProtocolNumber "tcp" +#else + proto <- getProtocolNumber "tcp" +#endif + handle <- bracketOnError + (socket af Stream proto) + close -- only done if there's an error + (\sock -> do + connect sock sockAddr + socketToHandle sock ReadWriteMode + ) + let cc = handleToCommChannel handle performAuthorization cc debugStrLn "Reconnected." diff --git a/src/Data/Acid/TemplateHaskell.hs b/src/Data/Acid/TemplateHaskell.hs --- a/src/Data/Acid/TemplateHaskell.hs +++ b/src/Data/Acid/TemplateHaskell.hs @@ -373,7 +373,10 @@ instanceD instanceContext (return ty) -#if __GLASGOW_HASKELL__ >= 707 +#if MIN_VERSION_template_haskell(2,15,0) + [ tySynInstD $ tySynEqn Nothing (conT ''MethodResult `appT` structType) (return resultType) + , tySynInstD $ tySynEqn Nothing (conT ''MethodState `appT` structType) (return stateType) +#elif __GLASGOW_HASKELL__ >= 707 [ tySynInstD ''MethodResult (tySynEqn [structType] (return resultType)) , tySynInstD ''MethodState (tySynEqn [structType] (return stateType)) #else