module Network.OpenID.SSL (
SSLHandle,
sslConnect
) where
import OpenSSL.Session as Session
import Control.Exception as E
import Network.Socket
import Network.Stream
import qualified Data.ByteString as B
import Control.Applicative
import Data.ByteString.Internal (w2c, c2w)
import Data.Word
data SSLHandle = SSLHandle SSLContext SSL
wrap m = Right `fmap` m `Prelude.catch` handler
where
handler err = return $ Left $ ErrorMisc $ "write: " ++ show err
wrapRead m = Right `fmap` m `catches` handlers
where
handlers :: [Handler (Either ConnError String)]
handlers =
[ Handler ((\_ -> return $ Right "")
:: (ConnectionAbruptlyTerminated -> IO (Either ConnError String)))
, Handler ((\x -> return $ Left $ ErrorMisc $ "read: " ++ show x)
:: (SomeException -> IO (Either ConnError String)))
]
instance Stream SSLHandle where
readLine sh =
wrapRead (upd `fmap` sslReadWhile (/= c) sh)
where
c = toEnum (fromEnum '\n')
upd bs = map (toEnum . fromEnum) bs ++ "\n"
readBlock (SSLHandle _ ssl) n =
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
| otherwise = return $ Right ()
close (SSLHandle _ ssl) = Session.shutdown ssl Bidirectional
`E.catch` ((\_ -> return ()) :: SomeException -> IO ())
closeOnEnd _ _ = return ()
sslConnect :: Socket -> IO (Maybe SSLHandle)
sslConnect sock = body `E.catch` handler
where
body = do
ctx <- Session.context
ssl <- Session.connection ctx sock
Session.connect ssl
return $ Just $ SSLHandle ctx ssl
handler :: SomeException -> IO (Maybe SSLHandle)
handler _ = return Nothing
sslReadWhile :: (Word8 -> Bool) -> SSLHandle -> IO [Word8]
sslReadWhile pred (SSLHandle _ ssl) = rw
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 []