]> git.proxmox.com Git - ceph.git/blame - ceph/src/jaegertracing/thrift/lib/hs/src/Thrift/Transport/Handle.hs
buildsys: switch source download to quincy
[ceph.git] / ceph / src / jaegertracing / thrift / lib / hs / src / Thrift / Transport / Handle.hs
CommitLineData
f67539c2
TL
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TypeSynonymInstances #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
6--
7-- Licensed to the Apache Software Foundation (ASF) under one
8-- or more contributor license agreements. See the NOTICE file
9-- distributed with this work for additional information
10-- regarding copyright ownership. The ASF licenses this file
11-- to you under the Apache License, Version 2.0 (the
12-- "License"); you may not use this file except in compliance
13-- with the License. You may obtain a copy of the License at
14--
15-- http://www.apache.org/licenses/LICENSE-2.0
16--
17-- Unless required by applicable law or agreed to in writing,
18-- software distributed under the License is distributed on an
19-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
20-- KIND, either express or implied. See the License for the
21-- specific language governing permissions and limitations
22-- under the License.
23--
24
25module Thrift.Transport.Handle
26 ( module Thrift.Transport
27 , HandleSource(..)
28 ) where
29
30import Control.Exception ( catch, throw )
31import Data.ByteString.Internal (c2w)
32import Data.Functor
33
34import Network
35
36import System.IO
37import System.IO.Error ( isEOFError )
38
39import Thrift.Transport
40
41import qualified Data.ByteString.Lazy as LBS
42import Data.Monoid
43
44instance Transport Handle where
45 tIsOpen = hIsOpen
46 tClose = hClose
47 tRead h n = read `Control.Exception.catch` handleEOF mempty
48 where
49 read = do
50 hLookAhead h
51 LBS.hGetNonBlocking h n
52 tReadAll _ 0 = return mempty
53 tReadAll h n = LBS.hGet h n `Control.Exception.catch` throwTransportExn
54 tPeek h = (Just . c2w <$> hLookAhead h) `Control.Exception.catch` handleEOF Nothing
55 tWrite = LBS.hPut
56 tFlush = hFlush
57
58
59-- | Type class for all types that can open a Handle. This class is used to
60-- replace tOpen in the Transport type class.
61class HandleSource s where
62 hOpen :: s -> IO Handle
63
64instance HandleSource FilePath where
65 hOpen s = openFile s ReadWriteMode
66
67instance HandleSource (HostName, PortID) where
68 hOpen = uncurry connectTo
69
70throwTransportExn :: IOError -> IO a
71throwTransportExn e = if isEOFError e
72 then throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN
73 else throw $ TransportExn "Handle tReadAll: Could not read" TE_UNKNOWN
74
75handleEOF :: a -> IOError -> IO a
76handleEOF a e = if isEOFError e
77 then return a
78 else throw $ TransportExn "Handle: Could not read" TE_UNKNOWN