Skip to content
Browse files

Remove package bounds, and update for ghc-7.6

  • Loading branch information...
1 parent 78a5909 commit 0c664df1bb600040e1ccc5c0af1d669e230b5168 @elliottt committed Aug 28, 2013
Showing with 41 additions and 39 deletions.
  1. +13 −13 openid.cabal
  2. +2 −2 src/Codec/Encryption/DH.hsc
  3. +26 −24 src/Network/OpenID/SSL.hs
View
26 openid.cabal
@@ -26,15 +26,15 @@ source-repository head
location: git://github.com/elliottt/hsopenid.git
library
- build-depends: base >= 4.0.0.0 && < 5.0.0.0,
- bytestring >= 0.9.1.0 && < 0.10.0.0,
- containers >= 0.2.0.0 && < 0.5.0.0,
- HTTP >= 4000.0.9 && < 4000.3.0.0,
- monadLib >= 3.6.0.0 && < 3.7.0.0,
- network >= 2.2.0.0 && < 2.4.0.0,
- time >= 1.1.0.0 && < 1.3.0.0,
- xml >= 1.3.0.0 && < 1.5.0.0,
- HsOpenSSL >= 0.9.0.0 && < 0.11.0.0
+ build-depends: base >= 4.0.0.0,
+ bytestring >= 0.9.1.0,
+ containers >= 0.2.0.0,
+ HTTP >= 4000.0.9,
+ monadLib >= 3.6.0.0,
+ network >= 2.2.0.0,
+ time >= 1.1.0.0,
+ xml >= 1.3.0.0,
+ HsOpenSSL >= 0.9.0.0
hs-source-dirs: src
exposed-modules: Codec.Binary.Base64,
Codec.Encryption.DH,
@@ -67,10 +67,10 @@ executable openid-test
if flag(examples)
buildable: True
- build-depends: base >= 4.0.0.0 && < 5.0.0.0,
- monadLib >= 3.6.0.0 && < 3.7.0.0,
- network >= 2.2.0.0 && < 2.4.0.0,
- HsOpenSSL >= 0.9.0.0 && < 0.11.0.0,
+ build-depends: base >= 4.0.0.0,
+ monadLib >= 3.6.0.0,
+ network >= 2.2.0.0,
+ HsOpenSSL >= 0.9.0.0,
openid
else
View
4 src/Codec/Encryption/DH.hsc
@@ -15,10 +15,10 @@ module Codec.Encryption.DH (
import Data.Bits (shiftL,shiftR,(.|.),testBit)
import Data.List
import Data.Word (Word8)
-import Foreign.C (CInt,CUChar)
+import Foreign.C (CInt(..),CUChar(..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array
- (peekArray,withArray,allocaArray,withArrayLen,mallocArray)
+ (peekArray,allocaArray,withArrayLen,mallocArray)
import Foreign.Ptr (Ptr,nullPtr)
import Foreign.Storable (Storable(..))
import System.IO.Unsafe (unsafePerformIO)
View
50 src/Network/OpenID/SSL.hs
@@ -16,7 +16,7 @@ module Network.OpenID.SSL (
) where
import OpenSSL.Session as Session
-import Control.Exception as E
+import qualified Control.Exception as E
import Network.Socket
import Network.Stream
import qualified Data.ByteString as B
@@ -27,18 +27,21 @@ import Data.Word
data SSLHandle = SSLHandle SSLContext SSL
-wrap m = Right `fmap` m `Prelude.catch` handler
+wrap :: IO a -> IO (Either ConnError a)
+wrap m = Right `fmap` m `E.catch` handler
where
+ handler :: E.SomeException -> IO (Either ConnError a)
handler err = return $ Left $ ErrorMisc $ "write: " ++ show err
-wrapRead m = Right `fmap` m `catches` handlers
+wrapRead :: IO String -> IO (Either ConnError String)
+wrapRead m = Right `fmap` m `E.catches` handlers
where
- handlers :: [Handler (Either ConnError String)]
+ handlers :: [E.Handler (Either ConnError String)]
handlers =
- [ Handler ((\_ -> return $ Right "")
+ [ E.Handler ((\_ -> return $ Right "")
:: (ConnectionAbruptlyTerminated -> IO (Either ConnError String)))
- , Handler ((\x -> return $ Left $ ErrorMisc $ "read: " ++ show x)
- :: (SomeException -> IO (Either ConnError String)))
+ , E.Handler ((\x -> return $ Left $ ErrorMisc $ "read: " ++ show x)
+ :: (E.SomeException -> IO (Either ConnError String)))
]
-- The problem is that the OpenSSL library doesn't know that in some
@@ -65,12 +68,12 @@ instance Stream SSLHandle where
wrapRead ((map w2c . B.unpack) <$> Session.read ssl n)
writeBlock (SSLHandle _ ssl) bs
- | not (null bs) = wrap $ Session.write ssl $ B.pack $ map c2w $ bs
+ | not (null bs) = wrap $ Session.write ssl $ B.pack $ map c2w bs
| otherwise = return $ Right ()
-- should this really ignore all exceptions?
close (SSLHandle _ ssl) = Session.shutdown ssl Bidirectional
- `E.catch` ((\_ -> return ()) :: SomeException -> IO ())
+ `E.catch` ((\_ -> return ()) :: E.SomeException -> IO ())
closeOnEnd _ _ = return ()
@@ -83,22 +86,21 @@ sslConnect sock = body `E.catch` handler
Session.connect ssl
return $ Just $ SSLHandle ctx ssl
- handler :: SomeException -> IO (Maybe SSLHandle)
+ handler :: E.SomeException -> IO (Maybe SSLHandle)
handler _ = return Nothing
sslReadWhile :: (Word8 -> Bool) -> SSLHandle -> IO [Word8]
-sslReadWhile pred (SSLHandle _ ssl) = rw
+sslReadWhile p (SSLHandle _ ssl) = loop
where
- rw = do
- txt <- Session.read ssl 1
- if B.null txt
- then return []
- else do
- let c = B.head txt
- if pred c
- then do
- cs <- rw
- return (c:cs)
- else
- return []
-
+ loop = do
+ txt <- Session.read ssl 1
+ if B.null txt
+ then return []
+ else do
+ let c = B.head txt
+ if p c
+ then do
+ cs <- loop
+ return (c:cs)
+ else
+ return []

0 comments on commit 0c664df

Please sign in to comment.
Something went wrong with that request. Please try again.