@@ -0,0 +1,92 @@
1+-- | Lookup files stored in memory instead of from the filesystem.
2+module WaiAppStatic.Storage.Embedded
3+ ( -- * Settings
4+ embeddedSettings
5+ ) where
6+
7+import WaiAppStatic.Types
8+import Data.ByteString (ByteString)
9+import Control.Arrow ((&&&), second)
10+import Data.List
11+import Blaze.ByteString.Builder (fromByteString)
12+import qualified Network.Wai as W
13+import qualified Data.Map as Map
14+import Data.Function (on)
15+import qualified Data.Text as T
16+import Data.Ord
17+import qualified Data.ByteString as S
18+import qualified Crypto.Hash.MD5 as MD5
19+import qualified Data.ByteString.Base64 as B64
20+import WaiAppStatic.Storage.Filesystem (defaultFileServerSettings)
21+
22+-- | Serve the list of path/content pairs directly from memory.
23+embeddedSettings :: [(Prelude.FilePath, ByteString)] -> StaticSettings
24+embeddedSettings files = (defaultFileServerSettings $ error "unused")
25+ { ssLookupFile = embeddedLookup $ toEmbedded files
26+ }
27+
28+type Embedded = Map.Map Piece EmbeddedEntry
29+
30+data EmbeddedEntry = EEFile ByteString | EEFolder Embedded
31+
32+embeddedLookup :: Embedded -> Pieces -> IO LookupResult
33+embeddedLookup root pieces =
34+ return $ elookup pieces root
35+ where
36+ elookup :: Pieces -> Embedded -> LookupResult
37+ elookup [] x = LRFolder $ Folder $ map toEntry $ Map.toList x
38+ elookup [p] x | T.null (fromPiece p) = elookup [] x
39+ elookup (p:ps) x =
40+ case Map.lookup p x of
41+ Nothing -> LRNotFound
42+ Just (EEFile f) ->
43+ case ps of
44+ [] -> LRFile $ bsToFile p f
45+ _ -> LRNotFound
46+ Just (EEFolder y) -> elookup ps y
47+
48+toEntry :: (Piece, EmbeddedEntry) -> Either FolderName File
49+toEntry (name, EEFolder{}) = Left name
50+toEntry (name, EEFile bs) = Right File
51+ { fileGetSize = S.length bs
52+ , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs
53+ , fileName = name
54+ , fileGetHash = return $ Just $ runHash bs
55+ , fileGetModified = Nothing
56+ }
57+
58+toEmbedded :: [(Prelude.FilePath, ByteString)] -> Embedded
59+toEmbedded fps =
60+ go texts
61+ where
62+ texts = map (\(x, y) -> (filter (not . T.null . fromPiece) $ toPieces' x, y)) fps
63+ toPieces' "" = []
64+ toPieces' x =
65+ let (y, z) = break (== '/') x
66+ in unsafeToPiece (T.pack y) : toPieces' (drop 1 z)
67+
68+ go :: [(Pieces, ByteString)] -> Embedded
69+ go orig =
70+ Map.fromList $ map (second go') hoisted
71+ where
72+ next = map (\(x, y) -> (head x, (tail x, y))) orig
73+ grouped :: [[(Piece, ([Piece], ByteString))]]
74+ grouped = groupBy ((==) `on` fst) $ sortBy (comparing fst) next
75+ hoisted :: [(Piece, [([Piece], ByteString)])]
76+ hoisted = map (fst . head &&& map snd) grouped
77+
78+ go' :: [(Pieces, ByteString)] -> EmbeddedEntry
79+ go' [([], content)] = EEFile content
80+ go' x = EEFolder $ go $ filter (\y -> not $ null $ fst y) x
81+
82+bsToFile :: Piece -> ByteString -> File
83+bsToFile name bs = File
84+ { fileGetSize = S.length bs
85+ , fileToResponse = \s h -> W.ResponseBuilder s h $ fromByteString bs
86+ , fileName = name
87+ , fileGetHash = return $ Just $ runHash bs
88+ , fileGetModified = Nothing
89+ }
90+
91+runHash :: ByteString -> ByteString
92+runHash = B64.encode . MD5.hash