acid-state 0.15.2 → 0.16.0

raw patch · 8 files changed

+120/−44 lines, 8 filesdep +network-bsddep ~basedep ~networkdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependencies added: network-bsd

Dependency ranges changed: base, network, template-haskell

API changes (from Hackage documentation)

Files

• acid-state.cabal +5/−4
• examples/KeyValue.hs +0/−1
• examples/Proxy.hs +5/−4
• examples/RemoteClient.hs +4/−2
• examples/RemoteServer.hs +5/−3
• examples/errors/Exceptions.hs +1/−1
• src/Data/Acid/Remote.hs +96/−28
• src/Data/Acid/TemplateHaskell.hs +4/−1

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -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")

@@ -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!"

@@ -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."

@@ -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