Network-NineP 0.3.0 → 0.4.0

raw patch · 9 files changed

+86/−65 lines, 9 filesdep +exceptionsdep +monad-peelPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions, monad-peel

API changes (from Hackage documentation)

Files

• Network-NineP.cabal +9/−5
• Network/NineP/Error.hs +9/−9
• Network/NineP/File.hs +14/−14
• Network/NineP/File/Instances.hs +1/−1
• Network/NineP/Internal/File.hs +6/−5
• Network/NineP/Internal/Msg.hs +20/−19
• Network/NineP/Internal/State.hs +13/−4
• Network/NineP/Server.hs +5/−3
• Test.hs +9/−5

@@ -1,5 +1,5 @@ Name:                Network-NineP-Version:             0.3.0+Version:             0.4.0 Description:         A library providing one with a somewhat higher level interface to 9P2000 protocol than existing implementations. Designed to facilitate rapid development of synthetic filesystems. Synopsis:            High-level abstraction over 9P protocol Maintainer:          Sergey Alirzaev <zl29ah@gmail.com>@@ -9,7 +9,7 @@ Build-Type:          Simple Cabal-Version:       >= 1.6 Stability:           Experimental-Tested-With:         GHC == 7.8.4+Tested-With:         GHC == 7.10.1  Source-repository head   type:              git@@ -18,7 +18,7 @@ Source-repository this   type:              git   location:          https://github.com/l29ah/Network-NineP.git-  tag:               0.3.0+  tag:               0.4.0  Library   Build-Depends:@@ -34,7 +34,9 @@     mstate >= 0.2.4 && < 0.3,     transformers >= 0.3.0.0 && < 0.5,     stateref >= 0.3 && < 0.4,-    convertible >= 1.0.11.1 && < 1.2+    convertible >= 1.0.11.1 && < 1.2,+    exceptions >= 0.8.0.2 && < 0.9,+    monad-peel >= 0.1.1 && < 0.3   Exposed-modules:     Control.Monad.EmbedIO     Network.NineP@@ -46,6 +48,8 @@     Network.NineP.Internal.File     Network.NineP.Internal.Msg     Network.NineP.Internal.State- +  ghc-options: -fno-warn-tabs+ Executable test   Main-is: Test.hs+  ghc-options: -fno-warn-tabs

@@ -1,17 +1,17 @@ -- | -- Stability   :  Ultra-Violence -- Portability :  I'm too young to die+-- The exceptions one would want to throw to be understood by the existing 9P clients.  module Network.NineP.Error 	( NineError(..)-	, module Control.Monad.Error 	) where -import Control.Monad.Error+import Control.Exception+import Data.Typeable import Data.Word --- |Throwable errors-data NineError = +data NineError = 	ENotImplemented String | 	ENotADir | 	EDir |@@ -19,13 +19,12 @@ 	ENoFid Word32 | 	ENoAuthRequired | 	EPermissionDenied |-	OtherError String+	EInval |+	OtherError String deriving (Typeable) -instance Error NineError where-	noMsg = undefined-	strMsg = OtherError+instance Exception NineError --- |See also: @linux/net/9p/error.c@+-- |See also: @linux\/net\/9p\/error.c@ instance Show NineError where 	show (ENotImplemented s) = s ++ " is not implemented" 	show ENotADir = "not a directory"@@ -34,4 +33,5 @@ 	show (ENoFid i) = "fid " ++ show i ++ " is not registered on the server" 	show ENoAuthRequired = "the server doesn't require any kind of authentication" 	show EPermissionDenied = "permission denied"+	show EInval = "Invalid argument" 	show (OtherError s) = s

@@ -17,7 +17,9 @@  import Control.Concurrent.Chan import Control.Exception+import Control.Monad import Control.Monad.EmbedIO+import Control.Monad.Trans import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.ByteString.Lazy.Char8 as B import Data.Bits@@ -35,19 +37,17 @@ 	-> Bool isDir perms = testBit perms 31 -simpleRead :: (Monad m, EmbedIO m) => m ByteString -> Word64 -> Word32 -> ErrorT NineError m ByteString+simpleRead :: (Monad m, EmbedIO m) => m ByteString -> Word64 -> Word32 -> m ByteString simpleRead get offset count = do-		r <- lift $ tryE $ get-		either (throwError . OtherError . (show :: SomeException -> String))-				(return . B.take (fromIntegral count) . B.drop (fromIntegral offset)) r+		r <- get+		(return . B.take (fromIntegral count) . B.drop (fromIntegral offset)) r  -- TODO make it offset-aware-simpleWrite :: (Monad m, EmbedIO m) => (ByteString -> m ()) -> Word64 -> ByteString -> ErrorT NineError m Word32+simpleWrite :: (Monad m, EmbedIO m) => (ByteString -> m ()) -> Word64 -> ByteString -> m Word32 simpleWrite put offset d = case offset of 	_ -> do-		r <- lift $ tryE $ put d-		either (throwError . OtherError . (show :: SomeException -> String))-				(const $ return $ fromIntegral $ B.length d) r+		r <- put d+		(const $ return $ fromIntegral $ B.length d) r 	--_ -> throwError $ OtherError "can't write at offset"  @@ -99,12 +99,12 @@ -- |A directory that stores its contents in the form of 'IORef [(String, NineFile m)]' simpleDirectory :: forall m. (Monad m, EmbedIO m) 			=> String	-- ^File name-			-> (String -> ErrorT NineError m (NineFile m))	-- ^A function for creating new files-			-> (String -> ErrorT NineError m (NineFile m))	-- ^A function for creating new directories-			-> IO (NineFile m)+			-> (String -> m (NineFile m))	-- ^A function for creating new files+			-> (String -> m (NineFile m))	-- ^A function for creating new directories+			-> IO (NineFile m, IORef [(String, NineFile m)]) simpleDirectory name newfile newdir = do 	files <- newIORef [] :: IO (IORef [(String, NineFile m)])-	return (boringDir name [] :: NineFile m) {+	return $ (\f -> (f, files)) $ (boringDir name [] :: NineFile m) { 		create = \name perms -> do 			nf <- (if isDir perms then newdir else newfile) name 			let nelem = (name, nf)@@ -113,11 +113,11 @@ 		getFiles = liftIO $ liftM (map snd) $ readIORef files, 		descend = \name -> do 			d <- liftIO $ readIORef files-			maybe (throwError $ ENoFile name) (return) $ lookup name d+			maybe (throw $ ENoFile name) (return) $ lookup name d 	}  -- |A composition of a 'simpleDirectory' and a 'memoryFile' memoryDirectory :: forall m. (Monad m, EmbedIO m) 			=> String	-- ^File name 			-> IO (NineFile m)-memoryDirectory name = simpleDirectory name (liftIO . memoryFile) (liftIO . memoryDirectory)+memoryDirectory name = liftM fst $ simpleDirectory name (liftIO . memoryFile) (liftIO . memoryDirectory)

@@ -3,7 +3,7 @@ -- Portability :  I'm too young to die -- Instances for dealing with the usual data. -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverloadedStrings, OverlappingInstances, ViewPatterns #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverloadedStrings, ViewPatterns #-}  module Network.NineP.File.Instances 	( Convertible

@@ -6,6 +6,7 @@ 	, boringDir 	) where +import Control.Exception import Control.Monad.EmbedIO import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Map as M@@ -18,10 +19,10 @@ 	RegularFile {         	read :: Word64	-- Offset 			-> Word32 -- Length-			-> ErrorT NineError m (B.ByteString),	-- Resulting data+			-> m (B.ByteString),	-- Resulting data         	write :: Word64	-- Offset 			-> B.ByteString	-- The written data-			-> ErrorT NineError m (Word32),	-- Number of bytes written successfully. Should return @0@ in case of an error.+			-> m (Word32),	-- Number of bytes written successfully. Should return @0@ in case of an error. 		remove :: m (), 		stat :: m Stat, 		wstat :: Stat -> m (),@@ -31,9 +32,9 @@ 		getFiles :: m [NineFile m], 		parent :: m (Maybe (NineFile m)), 		-- |A callback to address a specific file by its name. @.@ and @..@ are handled in the library.-		descend :: String -> ErrorT NineError m (NineFile m),+		descend :: String -> m (NineFile m), 		-- |Create a file under this directory.-		create :: String -> Word32 -> ErrorT NineError m (NineFile m),+		create :: String -> Word32 -> m (NineFile m), 		remove :: m (), 		-- |The directory stat must return only stat for @.@. 		stat :: m Stat,@@ -59,7 +60,7 @@ boringDir name contents = let m = M.fromList contents in Directory { 	getFiles = (return $ map snd $ contents), 	descend = (\x -> case M.lookup x m of-		Nothing -> throwError $ ENoFile x+		Nothing -> throw $ ENoFile x 		Just f -> return f), 	create = (\name perms -> return $ boringFile name), 	remove = (return ()),

@@ -18,6 +18,7 @@ 	) where  import Control.Concurrent.MState hiding (put)+import Control.Exception import Control.Monad.EmbedIO import Control.Monad.Reader import Data.Binary.Put@@ -41,14 +42,14 @@ checkPerms' :: (Monad m, EmbedIO m) => Word32 -> Word8 -> Nine m () checkPerms' have want = do 	-- TODO stop presuming we are owners-	let checkRead = unless (testBit have 2) $ throwError EPermissionDenied-	let checkWrite = unless (testBit have 1) $ throwError EPermissionDenied-	let checkExec = unless (testBit have 0) $ throwError EPermissionDenied+	let checkRead = unless (testBit have 2) $ throw EPermissionDenied+	let checkWrite = unless (testBit have 1) $ throw EPermissionDenied+	let checkExec = unless (testBit have 0) $ throw EPermissionDenied 	when (testBit want 4) $ do 		checkWrite-		throwError $ ENotImplemented "OTRUNC"+		throw $ ENotImplemented "OTRUNC" 	when (testBit want 6) $ do-		throwError $ ENotImplemented "ORCLOSE"+		throw $ ENotImplemented "ORCLOSE" 	case want of 		0 -> checkRead 		1 -> checkWrite@@ -66,7 +67,7 @@ rversion :: Msg -> Nine m [Msg] rversion (Msg _ t (Tversion s v)) = do 	let ver = readVersion v-	lift $ modifyM_ (\st -> st { msize = s, protoVersion = ver })+	modifyM_ (\st -> st { msize = s, protoVersion = ver }) 	return $ return $ Msg TRversion t $ Rversion s $ show ver  rattach (Msg _ t (Tattach fid _ _ _)) = do@@ -75,9 +76,9 @@ 	q <- makeQid root 	return $ return $ Msg TRattach t $ Rattach q  -desc :: (Monad m, EmbedIO m) => NineFile m -> String -> ErrorT NineError m (NineFile m)+desc :: (Monad m, EmbedIO m) => NineFile m -> String -> m (NineFile m) desc f ".." = do-	mp <- lift $ parent f+	mp <- parent f 	return $ case mp of 		Just p -> p 		Nothing -> f@@ -85,9 +86,9 @@  walk :: (Monad m, EmbedIO m) => [Qid] -> [String] -> NineFile m -> Nine m (NineFile m, [Qid]) walk qs [] f = return (f, qs)-walk qs (x:xs) (RegularFile {}) = throwError ENotADir+walk qs (x:xs) (RegularFile {}) = throw ENotADir walk qs (x:xs) d@(Directory {}) = do-	f <- mapErrorT call $ desc d x+	f <- call $ desc d x 	q <- makeQid f 	walk (q:qs) xs f @@ -106,7 +107,7 @@ 				(RegularFile {}) -> flip clearBit 31 				(Directory {}) -> flip setBit 31 			)-	s <- lift $ call $ stat f+	s <- call $ stat f 	return s { st_mode = fixDirBit $ st_mode s, 		st_qid = (st_qid s) { qid_typ = getQidTyp s } } 	@@ -125,7 +126,7 @@ 	return $ return $ Msg TRclunk t $ Rclunk  rauth (Msg {}) = do-	throwError ENoAuthRequired+	throw ENoAuthRequired  open :: (Monad m, EmbedIO m) => NineFile m -> Nine m Qid open f = do@@ -142,9 +143,9 @@ 	f <- lookup fid 	-- TODO check permissions to create 	case f of-		RegularFile {} -> throwError ENotADir+		RegularFile {} -> throw ENotADir 		Directory {} -> do-			nf <- mapErrorT call $ (create f) name perm+			nf <- call $ (create f) name perm 			insert fid nf 			qid <- open f 			iou <- iounit@@ -160,10 +161,10 @@ 			let (a, b) = B.splitAt s d in a : splitMsg' b s 	case f of 		RegularFile {} -> do-			d <- mapErrorT call $ (read f) offset count+			d <- call $ (read f) offset count 			mapM (return . Msg TRread t . Rread) $ splitMsg d $ fromIntegral u 		Directory {} -> do-			contents <- lift $ call $ getFiles f+			contents <- call $ getFiles f 			s <- mapM getStat $ contents 			let d = runPut $ mapM_ put s 			mapM (return . Msg TRread t . Rread) $ splitMsg (B.drop (fromIntegral offset) d) $ fromIntegral u@@ -173,9 +174,9 @@ 	f <- lookup fid 	checkPerms f 1 	case f of-		Directory {} -> throwError EDir+		Directory {} -> throw EDir 		RegularFile {} -> do-			c <- mapErrorT call $ (write f) offset d+			c <- call $ (write f) offset d 			return $ return $ Msg TRwrite t $ Rwrite c  rwstat (Msg _ t (Twstat fid stat)) = do@@ -187,6 +188,6 @@ rremove (Msg _ t (Tremove fid)) = do 	-- TODO check perms 	f <- lookup fid-	throwError $ ENotImplemented "remove"+	throw $ ENotImplemented "remove"  rflush _ = return []

@@ -15,7 +15,11 @@ 	) where  import Control.Concurrent.MState+import Control.Exception (throw)+import Control.Exception.Peel as P+import Control.Monad.Catch import Control.Monad.EmbedIO+import Control.Monad.IO.Peel import Control.Monad.Reader import Control.Monad.State.Class import Data.List (isPrefixOf)@@ -60,8 +64,13 @@ 	mState = m } -type Nine m x = ErrorT NineError (MState (NineState m) (ReaderT (Config m) IO)) x+type Nine m x = MState (NineState m) (ReaderT (Config m) IO) x +instance MonadThrow m => MonadThrow (MState s m) where+	throwM e = lift $ throwM e+instance (MonadCatch m, MonadPeelIO m) => MonadCatch (MState s m) where+	catch = P.catch+ call :: (EmbedIO m) => m a -> MState (NineState m) (ReaderT (Config m) IO) a call x = do 	s <- (return . mState) =<< get@@ -71,17 +80,17 @@ lookup fid = do 	m <- (return . fidMap) =<< get  	case M.lookup fid m of-		Nothing -> throwError $ ENoFid fid+		Nothing -> throw $ ENoFid fid 		Just f -> return f  insert :: Word32 -> NineFile m -> Nine m () insert fid f = do 	m <- (return . fidMap) =<< get -	lift $ modifyM_ (\s -> s { fidMap = M.insert fid f $ fidMap s })+	modifyM_ (\s -> s { fidMap = M.insert fid f $ fidMap s })  delete :: Word32 -> Nine m () delete fid = do-	lift $ modifyM_ (\s -> s { fidMap = M.delete fid $ fidMap s })+	modifyM_ (\s -> s { fidMap = M.delete fid $ fidMap s })  iounit :: Nine m Word32 iounit = do

@@ -12,8 +12,9 @@  import Control.Concurrent import Control.Concurrent.MState hiding (get, put)-import Control.Exception+import Control.Exception (assert) import Control.Monad+import Control.Monad.Catch import Control.Monad.EmbedIO import Control.Monad.Loops import Control.Monad.Reader@@ -118,7 +119,7 @@ handleMsg :: (EmbedIO m) => (Msg -> IO ()) -> Msg -> MState (NineState m) (ReaderT (Config m) IO) () handleMsg say p = do 	let Msg typ t m = p-	r <- runErrorT (case typ of+	r <- try (case typ of 			TTversion -> rversion p 			TTattach -> rattach p 			TTwalk -> rwalk p@@ -135,4 +136,5 @@ 		) 	case r of 		(Right response) -> liftIO $ mapM_ say $ response-		(Left fail) -> liftIO $ say $ Msg TRerror t $ Rerror $ show $ fail+		-- FIXME which exceptions should i catch?+		(Left fail) -> liftIO $ say $ Msg TRerror t $ Rerror $ show $ (fail :: SomeException)

@@ -1,18 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} -import Control.Monad.Error+import Control.Exception import Control.Monad.Trans import qualified Data.ByteString.Lazy.Char8 as B import Data.Word -import Network.NineP+import Network.NineP as N import Network.NineP.Error import Network.NineP.File  --cfg = Config $ boringDir "/" [("boring", boringFile "boring"),("nyak", boringFile "nyak")]-spamwr :: Word64 -> B.ByteString -> ErrorT NineError IO (Word32)+spamwr :: Word64 -> B.ByteString -> IO Word32 spamwr _ d = do-	lift $ B.putStr d+	B.putStr d 	return $ fromIntegral $ B.length d  boringwr _ c = return $ B.take (fromIntegral c) "i am so very boring"@@ -20,7 +20,11 @@ main = do 	memd <- memoryDirectory "/" :: IO (NineFile IO) 	run9PServer $ Config {-			root = boringDir "/" [("lol", (boringFile "lol") { write = spamwr }), ("memd", memd)],+			-- TODO Data.Default?+			root = boringDir "/" [+				("lol", (boringFile "lol") { write = spamwr }),+				("memd", memd),+				("exception", (boringFile "exception") { N.read = \_ _ -> throw $ AssertionFailed "lol" })], 			addr = "unix!/tmp/h9pt", 			monadState = undefined 		}