[Fencommits] fenserve: more. for some reason it doesn't work. I can't figure it out.
Benja Fallenstein
benja.fallenstein at gmail.com
Thu Mar 22 19:49:33 EET 2007
Sat Mar 17 01:15:11 EET 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* more. for some reason it doesn't work. I can't figure it out.
diff -rN -u old-fenserve/FenServe.hs new-fenserve/FenServe.hs
--- old-fenserve/FenServe.hs 2007-03-22 19:49:32.000000000 +0200
+++ new-fenserve/FenServe.hs 2007-03-22 19:49:33.000000000 +0200
@@ -19,49 +19,169 @@
-- Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-- MA 02111-1307 USA
+import Storm
+import Fenfire.RDF
+import Fenfire.Utils
+import qualified Fenfire.Raptor as Raptor
+
import HAppS
-import Control.Monad.State (get, put, modify)
+import Control.Monad.State (State, get, gets, put, modify, execState)
import qualified Data.ByteString as ByteString
import Data.ByteString (ByteString)
import qualified Data.Map as Map
import Data.Map (Map)
-import Data.Maybe (fromMaybe)
+import qualified Data.Set as Set
+import Data.Maybe (fromMaybe, fromJust)
import Data.Typeable
import Network.URI (uriToString)
-data Resource = Dir (Map String Resource) | File { body :: ByteString }
- deriving (Read, Show, Typeable)
+import System.IO.Unsafe (unsafePerformIO)
+
+fs = "http://fenfire.org/2007/fenserve#"
+fs_Directory = IRI "http://fenfire.org/2007/fenserve#Directory"
+fs_DirEntry = IRI "http://fenfire.org/2007/fenserve#DirEntry"
+fs_FileEntry = IRI "http://fenfire.org/2007/fenserve#FileEntry"
+fs_FirstVersion = IRI "http://fenfire.org/2007/fenserve#FirstVersion"
+fs_previousVersion = IRI "http://fenfire.org/2007/fenserve#previousVersion"
+fs_entries = IRI "http://fenfire.org/2007/fenserve#entries"
+fs_filename = IRI "http://fenfire.org/2007/fenserve#filename"
+fs_subdir = IRI "http://fenfire.org/2007/fenserve#"
+fs_representation = IRI "http://fenfire.org/2007/fenserve#representation"
+fs_mimeType = IRI "http://fenfire.org/2007/fenserve#mimeType"
+fs_language = IRI "http://fenfire.org/2007/fenserve#language"
+
+rget :: Node -> Node -> Graph -> Node
+rget p s g = fromJust $ getOne g s p Pos
+
+data Entry = DirEntry { entryName :: String, entrySubdir :: Node }
+ | FileEntry { entryName :: String, entryRepr :: Node }
+
+data Directory = Dir { dirNode :: Node, dirEntries :: [Entry] }
+
+type Ptr = (BlockId, Pool)
+
+instance ToRDF Directory where
+ toRDF (Dir node entries) = do
+ l <- toRDF entries
+ tellTs [ (node, rdf_type, fs_Directory), (node, fs_entries, l) ]
+ return node
+
+instance FromRDF Directory where
+ readRDF g node = do
+ let l = rget fs_entries node g
+ tellTs [ (node, rdf_type, fs_Directory), (node, fs_entries, l) ]
+ entries <- readRDF g l
+ return $ Dir node entries
+
+instance ToRDF Entry where
+ toRDF (FileEntry name repr) = do
+ e <- newBNode; nameR <- toRDF name
+ tellTs [ (e, fs_filename, nameR), (e, rdf_type, fs_FileEntry),
+ (e, fs_representation, repr) ]
+ return e
+ toRDF (DirEntry name subdir) = do
+ e <- newBNode; nameR <- toRDF name
+ tellTs [ (e, fs_filename, nameR), (e, rdf_type, fs_DirEntry),
+ (e, fs_subdir, subdir) ]
+ return e
+
+instance FromRDF Entry where
+ readRDF g node = case rget rdf_type node g of
+ x | x == fs_FileEntry -> do
+ let nameR = rget fs_filename node g
+ name <- readRDF g nameR
+ let repr = rget fs_representation node g
+ tellTs [ (node, fs_filename, nameR),
+ (node, fs_representation, repr) ]
+ return $ FileEntry name repr
+ x | x == fs_DirEntry -> do
+ let nameR = rget fs_filename node g
+ name <- readRDF g nameR
+ let subdir = rget fs_representation node g
+ tellTs [ (node, fs_filename, nameR),
+ (node, fs_subdir, subdir) ]
+ return $ DirEntry name subdir
+
+instance StartState Ptr where
+ startStateM = return $ flip writeGraph Map.empty $
+ setGraphURI "ex:graph" $ listToGraph
+ [ (IRI "ex:graph#dir", rdf_type, fs_Directory)
+ , (IRI "ex:graph#dir", fs_entries, rdf_nil) ]
-instance StartState Resource where startStateM = return $ Dir Map.empty
-instance Serialize Resource where
- typeString _ = "FenServe.Resource"
+instance Serialize Ptr where
+ typeString _ = "FenServe.State"
decodeStringM = defaultDecodeStringM
encodeStringM = defaultEncodeStringM
instance ToMessage ByteString where
toMessageBodyM = return
-just :: SURI -> Maybe [String]
-just = Just . splitPath . path
+asPath :: SURI -> Maybe [String]
+asPath = Just . splitPath . path
main :: IO ()
main = stdHTTP
- [ h just GET $ ok $ \uri () -> get >>= return . Right . getURI uri
- , h just PUT $ ok $ \uri () -> do
+ [ h asPath GET $ ok $ \uri () -> get >>= return . Right . getURI uri
+ , h asPath PUT $ ok $ \uri () -> do
Request { rqBody=Body body } <- getEvent
modify (putURI uri body); return $ Right "Ok."
]
-getURI :: [String] -> Resource -> ByteString
-getURI [] (File s) = s
-getURI (x:xs) (Dir m) = getURI xs (m Map.! x)
-
-putURI :: [String] -> ByteString -> Resource -> Resource
-putURI [x] s (Dir m) = Dir $ Map.insert x (File s) m
-putURI (x:xs) s (Dir m) = Dir $ updateWithDefault (Dir Map.empty) (putURI xs s) x m
+bURI :: BlockId -> String
+bURI bid = "blk:" ++ bid
+
+bID :: Node -> BlockId
+bID (IRI ('b':'l':'k':':':s)) = takeWhile (/= '#') s
+
+readGraph :: (BlockId, Pool) -> Graph
+readGraph (bid, pool) = raptorToGraph triples namespaces (bURI bid) where
+ (triples, namespaces) =
+ unsafePerformIO $ Raptor.bytesToTriples "turtle" (pool Map.! bid) (bURI bid)
+
+writeGraph :: Graph -> Pool -> (BlockId, Pool)
+writeGraph graph pool = addBlock body pool where
+ (triples, namespaces) = graphToRaptor graph
+ body = unsafePerformIO $ Raptor.triplesToBytes triples namespaces ""
+
+getURI :: [String] -> (BlockId, Pool) -> ByteString
+getURI [x] (bid,pool) = f entries where
+ graph = readGraph (bid,pool); node = IRI $ bURI bid ++ "#dir"
+ Dir _ entries = fromRDF graph node
+ f (FileEntry n r : _ ) | n == x = unsafePerformIO $ do print r; print $ Map.keys pool; return $ ByteString.pack [33] --pool Map.! bID r
+ f (_ : es) = f es
+ f [] = ByteString.pack [34]
+getURI (x:xs) (bid,pool) = f entries where
+ graph = readGraph (bid,pool); node = IRI $ bURI bid ++ "#dir"
+ Dir _ entries = fromRDF graph node
+ f (DirEntry n sub : _ ) | n == x = getURI xs (bID sub,pool)
+ f (_ : es) = f es
+
+updateData :: (FromRDF a, ToRDF a) => (a -> a) -> Node -> Endo (BlockId,Pool)
+updateData f node (bid,pool) = let graph = readGraph (bid, pool)
+ graph' = updateRDF f node graph
+ in writeGraph graph' pool
+
+putURI :: [String] -> ByteString -> Endo (BlockId, Pool)
+putURI [x] s (bid,pool) = updateData f' node (bid, pool') where
+ node = IRI $ bURI bid ++ "#dir"
+ (rid, pool') = addBlock s pool; r = IRI $ bURI rid
+
+ f' (Dir n entries) = Dir n (f entries)
+ f (FileEntry n _ : es) | n == x = (FileEntry n r) : es
+ f (e : es) = e : f es
+ f [] = [FileEntry x r]
+
+{-putURI (x:xs) s (bid,pool) = f entries where
+ graph = readGraph (bid,pool); node = IRI $ bURI bid ++ "#dir"
+ Dir _ entries = fromRDF graph node
+ f (DirEntry n sub : _ ) | n == x = getURI xs (bID sub,pool)
+ f (_ : es) = f es-}
+
+--putURI [x] s (Dir m) = Dir $ Map.insert x (File s) m
+--putURI (x:xs) s (Dir m) = Dir $ updateWithDefault (Dir Map.empty) (putURI xs s) x m
updateWithDefault :: Ord k => a -> (a -> a) -> k -> Map k a -> Map k a
updateWithDefault x f = Map.alter (Just . f . fromMaybe x)
diff -rN -u old-fenserve/SHA1.lhs new-fenserve/SHA1.lhs
--- old-fenserve/SHA1.lhs 2007-03-22 19:49:32.000000000 +0200
+++ new-fenserve/SHA1.lhs 2007-03-22 19:49:32.000000000 +0200
@@ -47,6 +47,8 @@
Changed Word/Char/Bits imports to Data.Word/Data.Char/Data.Bits
Benja Fallenstein on 2007-03-16
+
+Converted to use [Word8] instead of String by Benja Fallenstein on 2007-03-16
=============================================================================
> module SHA1 (sha1, sha1_size) where
@@ -59,27 +61,27 @@
> type XYZ = (Word32, Word32, Word32)
> type Rotation = Int
-> sha1 :: String -> String
+> sha1 :: [Word8] -> String
> sha1 s = s5
> where s1_2 = sha1_step_1_2_pad_length s
> abcde = sha1_step_3_init
> abcde' = sha1_step_4_main abcde s1_2
> s5 = sha1_step_5_display abcde'
-> sha1_size :: (Integral a) => a -> String -> String
+> sha1_size :: (Integral a) => a -> [Word8] -> String
> sha1_size l s = s5
-> where s1_2 = s ++ sha1_step_1_2_work (fromIntegral ((toInteger l) `mod` (2^64))) ""
+> where s1_2 = s ++ sha1_step_1_2_work (fromIntegral ((toInteger l) `mod` (2^64))) []
> abcde = sha1_step_3_init
> abcde' = sha1_step_4_main abcde s1_2
> s5 = sha1_step_5_display abcde'
-> sha1_step_1_2_pad_length :: String -> String
+> sha1_step_1_2_pad_length :: [Word8] -> [Word8]
> sha1_step_1_2_pad_length s = sha1_step_1_2_work 0 s
-> sha1_step_1_2_work :: Integer -> String -> String
-> sha1_step_1_2_work c64 "" = padding ++ len
-> where padding = '\128':replicate' (shiftR (fromIntegral $ (440 - c64) `mod` 512) 3) '\000'
-> len = map chr $ size_split 8 c64
+> sha1_step_1_2_work :: Integer -> [Word8] -> [Word8]
+> sha1_step_1_2_work c64 [] = padding ++ len
+> where padding = 128:replicate' (shiftR (fromIntegral $ (440 - c64) `mod` 512) 3) 0
+> len = map fromIntegral $ size_split 8 c64
> sha1_step_1_2_work c64 (c:cs) = c:sha1_step_1_2_work ((c64 + 8) `mod` (2^64)) cs
> replicate' :: Word16 -> a -> [a]
@@ -101,8 +103,8 @@
wm14 = [2,3,4,5,6,7,8,9,10,11,12,13,14,15]
wm16 = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
-> sha1_step_4_main :: ABCDE -> String -> ABCDE
-> sha1_step_4_main abcde "" = {- abcde -} abcde
+> sha1_step_4_main :: ABCDE -> [Word8] -> ABCDE
+> sha1_step_4_main abcde [] = {- abcde -} abcde
> sha1_step_4_main abcde0 s = sha1_step_4_main abcde5 s'
> where (s64, s') = takeDrop 64 s
> s16 = get_word_32s s64
@@ -131,11 +133,11 @@
> = w:sha1_add_ws (n + 1) (w1s ++ [w], w2s ++ [w], w3s ++ [w], w4s ++ [w])
> where w = rotL (foldr1 xor [w1, w2, w3, w4]) 1
-> get_word_32s :: String -> [Word32]
-> get_word_32s "" = []
+> get_word_32s :: [Word8] -> [Word32]
+> get_word_32s [] = []
> get_word_32s ss = this:rest
> where (s, ss') = takeDrop 4 ss
-> this = sum $ zipWith shiftL (map (fromIntegral.ord) s) [24, 16, 8, 0]
+> this = sum $ zipWith shiftL (map fromIntegral s) [24, 16, 8, 0]
> rest = get_word_32s ss'
> takeDrop :: Int -> [a] -> ([a], [a])
diff -rN -u old-fenserve/Storm.hs new-fenserve/Storm.hs
--- old-fenserve/Storm.hs 2007-03-22 19:49:32.000000000 +0200
+++ new-fenserve/Storm.hs 2007-03-22 19:49:33.000000000 +0200
@@ -20,13 +20,14 @@
-- MA 02111-1307 USA
import SHA1
+import qualified Data.ByteString as ByteString
+import Data.ByteString (ByteString)
import qualified Data.Map as Map
import Data.Map (Map)
-type Bytes = String
-type BlockId = Bytes
-type Pool = Map BlockId Bytes
+type BlockId = String
+type Pool = Map BlockId ByteString
-addBlock :: Bytes -> Pool -> (BlockId, Pool)
-addBlock body pool = (id', pool') where id' = sha1 body
+addBlock :: ByteString -> Pool -> (BlockId, Pool)
+addBlock body pool = (id', pool') where id' = sha1 $ ByteString.unpack body
pool' = Map.insert id' body pool
More information about the Fencommits
mailing list