]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
1 | {-# LANGUAGE ScopedTypeVariables #-} |
2 | -- | |
3 | -- Licensed to the Apache Software Foundation (ASF) under one | |
4 | -- or more contributor license agreements. See the NOTICE file | |
5 | -- distributed with this work for additional information | |
6 | -- regarding copyright ownership. The ASF licenses this file | |
7 | -- to you under the Apache License, Version 2.0 (the | |
8 | -- "License"); you may not use this file except in compliance | |
9 | -- with the License. You may obtain a copy of the License at | |
10 | -- | |
11 | -- http://www.apache.org/licenses/LICENSE-2.0 | |
12 | -- | |
13 | -- Unless required by applicable law or agreed to in writing, | |
14 | -- software distributed under the License is distributed on an | |
15 | -- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
16 | -- KIND, either express or implied. See the License for the | |
17 | -- specific language governing permissions and limitations | |
18 | -- under the License. | |
19 | -- | |
20 | ||
21 | module Thrift.Server | |
22 | ( runBasicServer | |
23 | , runThreadedServer | |
24 | ) where | |
25 | ||
26 | import Control.Concurrent ( forkIO ) | |
27 | import Control.Exception | |
28 | import Control.Monad ( forever, when ) | |
29 | ||
30 | import Network | |
31 | ||
32 | import System.IO | |
33 | ||
34 | import Thrift | |
35 | import Thrift.Transport.Handle() | |
36 | import Thrift.Protocol.Binary | |
37 | ||
38 | ||
39 | -- | A threaded sever that is capable of using any Transport or Protocol | |
40 | -- instances. | |
41 | runThreadedServer :: (Protocol i, Protocol o) | |
42 | => (Socket -> IO (i, o)) | |
43 | -> h | |
44 | -> (h -> (i, o) -> IO Bool) | |
45 | -> PortID | |
46 | -> IO a | |
47 | runThreadedServer accepter hand proc_ port = do | |
48 | socket <- listenOn port | |
49 | acceptLoop (accepter socket) (proc_ hand) | |
50 | ||
51 | -- | A basic threaded binary protocol socket server. | |
52 | runBasicServer :: h | |
53 | -> (h -> (BinaryProtocol Handle, BinaryProtocol Handle) -> IO Bool) | |
54 | -> PortNumber | |
55 | -> IO a | |
56 | runBasicServer hand proc_ port = runThreadedServer binaryAccept hand proc_ (PortNumber port) | |
57 | where binaryAccept s = do | |
58 | (h, _, _) <- accept s | |
59 | return (BinaryProtocol h, BinaryProtocol h) | |
60 | ||
61 | acceptLoop :: IO t -> (t -> IO Bool) -> IO a | |
62 | acceptLoop accepter proc_ = forever $ | |
63 | do ps <- accepter | |
64 | forkIO $ handle (\(_ :: SomeException) -> return ()) | |
65 | (loop $ proc_ ps) | |
66 | where loop m = do { continue <- m; when continue (loop m) } |