    -- | Lookup files stored in memory instead of from the filesystem.
    module WaiAppStatic.Storage.Embedded.Runtime
        ( -- * Settings
          embeddedSettings
        ) where

    import WaiAppStatic.Types
    import Data.ByteString (ByteString)
    import Control.Arrow ((&&&), second)
    import Data.List
    import Data.ByteString.Builder (byteString)
    import qualified Network.Wai as W
    import qualified Data.Map as Map
    import Data.Function (on)
    import qualified Data.Text as T
    import Data.Ord
    import qualified Data.ByteString as S
    import Crypto.Hash (hash, MD5, Digest)
    import Data.ByteArray.Encoding
    import WaiAppStatic.Storage.Filesystem (defaultFileServerSettings)
    import System.FilePath (isPathSeparator)

    -- | Serve the list of path/content pairs directly from memory.
    embeddedSettings :: [(Prelude.FilePath, ByteString)] -> StaticSettings
    embeddedSettings :: [(FilePath, ByteString)] -> StaticSettings
    embeddedSettings files :: [(FilePath, ByteString)]
    files = (FilePath -> StaticSettings
    defaultFileServerSettings (FilePath -> StaticSettings) -> FilePath -> StaticSettings
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    forall a. HasCallStack => FilePath -> a
    error "unused")
        { ssLookupFile :: Pieces -> IO LookupResult
    ssLookupFile = Embedded -> Pieces -> IO LookupResult
    embeddedLookup (Embedded -> Pieces -> IO LookupResult)
    -> Embedded -> Pieces -> IO LookupResult
    forall a b. (a -> b) -> a -> b
    $ [(FilePath, ByteString)] -> Embedded
    toEmbedded [(FilePath, ByteString)]
    files
        }

    type Embedded = Map.Map Piece EmbeddedEntry

    data EmbeddedEntry = EEFile ByteString | EEFolder Embedded

    embeddedLookup :: Embedded -> Pieces -> IO LookupResult
    embeddedLookup :: Embedded -> Pieces -> IO LookupResult
    embeddedLookup root :: Embedded
    root pieces :: Pieces
    pieces =
        LookupResult -> IO LookupResult
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LookupResult -> IO LookupResult)
    -> LookupResult -> IO LookupResult
    forall a b. (a -> b) -> a -> b
    $ Pieces -> Embedded -> LookupResult
    elookup Pieces
    pieces Embedded
    root
      where
        elookup  :: Pieces -> Embedded -> LookupResult
        elookup :: Pieces -> Embedded -> LookupResult
    elookup [] x :: Embedded
    x = Folder -> LookupResult
    LRFolder (Folder -> LookupResult) -> Folder -> LookupResult
    forall a b. (a -> b) -> a -> b
    $ [Either FolderName File] -> Folder
    Folder ([Either FolderName File] -> Folder)
    -> [Either FolderName File] -> Folder
    forall a b. (a -> b) -> a -> b
    $ ((FolderName, EmbeddedEntry) -> Either FolderName File)
    -> [(FolderName, EmbeddedEntry)] -> [Either FolderName File]
    forall a b. (a -> b) -> [a] -> [b]
    map (FolderName, EmbeddedEntry) -> Either FolderName File
    toEntry ([(FolderName, EmbeddedEntry)] -> [Either FolderName File])
    -> [(FolderName, EmbeddedEntry)] -> [Either FolderName File]
    forall a b. (a -> b) -> a -> b
    $ Embedded -> [(FolderName, EmbeddedEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Embedded
    x
        elookup [p :: FolderName
    p] x :: Embedded
    x | Text -> Bool
    T.null (FolderName -> Text
    fromPiece FolderName
    p) = Pieces -> Embedded -> LookupResult
    elookup [] Embedded
    x
        elookup (p :: FolderName
    p:ps :: Pieces
    ps) x :: Embedded
    x =
            case FolderName -> Embedded -> Maybe EmbeddedEntry
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup FolderName
    p Embedded
    x of
                Nothing -> LookupResult
    LRNotFound
                Just (EEFile f :: ByteString
    f) ->
                    case Pieces
    ps of
                        [] -> File -> LookupResult
    LRFile (File -> LookupResult) -> File -> LookupResult
    forall a b. (a -> b) -> a -> b
    $ FolderName -> ByteString -> File
    bsToFile FolderName
    p ByteString
    f
                        _ -> LookupResult
    LRNotFound
                Just (EEFolder y :: Embedded
    y) -> Pieces -> Embedded -> LookupResult
    elookup Pieces
    ps Embedded
    y

    toEntry :: (Piece, EmbeddedEntry) -> Either FolderName File
    toEntry :: (FolderName, EmbeddedEntry) -> Either FolderName File
    toEntry (name :: FolderName
    name, EEFolder{}) = FolderName -> Either FolderName File
    forall a b. a -> Either a b
    Left FolderName
    name
    toEntry (name :: FolderName
    name, EEFile bs :: ByteString
    bs) = File -> Either FolderName File
    forall a b. b -> Either a b
    Right File :: Integer
    -> (Status -> ResponseHeaders -> Response)
    -> FolderName
    -> IO (Maybe ByteString)
    -> Maybe EpochTime
    -> File
    File
        { fileGetSize :: Integer
    fileGetSize = Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    S.length ByteString
    bs
        , fileToResponse :: Status -> ResponseHeaders -> Response
    fileToResponse = \s :: Status
    s h :: ResponseHeaders
    h -> Status -> ResponseHeaders -> Builder -> Response
    W.responseBuilder Status
    s ResponseHeaders
    h (Builder -> Response) -> Builder -> Response
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    byteString ByteString
    bs
        , fileName :: FolderName
    fileName = FolderName
    name
        , fileGetHash :: IO (Maybe ByteString)
    fileGetHash = Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> Maybe ByteString -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    runHash ByteString
    bs
        , fileGetModified :: Maybe EpochTime
    fileGetModified = Maybe EpochTime
    forall a. Maybe a
    Nothing
        }

    toEmbedded :: [(Prelude.FilePath, ByteString)] -> Embedded
    toEmbedded :: [(FilePath, ByteString)] -> Embedded
    toEmbedded fps :: [(FilePath, ByteString)]
    fps =
        [(Pieces, ByteString)] -> Embedded
    go [(Pieces, ByteString)]
    texts
      where
        texts :: [(Pieces, ByteString)]
    texts = ((FilePath, ByteString) -> (Pieces, ByteString))
    -> [(FilePath, ByteString)] -> [(Pieces, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: FilePath
    x, y :: ByteString
    y) -> ((FolderName -> Bool) -> Pieces -> Pieces
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (FolderName -> Bool) -> FolderName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    T.null (Text -> Bool) -> (FolderName -> Text) -> FolderName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FolderName -> Text
    fromPiece) (Pieces -> Pieces) -> Pieces -> Pieces
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Pieces
    toPieces' FilePath
    x, ByteString
    y)) [(FilePath, ByteString)]
    fps
        toPieces' :: FilePath -> Pieces
    toPieces' "" = []
        toPieces' x :: FilePath
    x =
            -- See https://github.com/yesodweb/yesod/issues/626
            --
            -- We want to separate on the forward slash on *all* OSes, and on
            -- Windows, also separate on a backslash.
            let (y :: FilePath
    y, z :: FilePath
    z) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isPathSeparator FilePath
    x
             in Text -> FolderName
    unsafeToPiece (FilePath -> Text
    T.pack FilePath
    y) FolderName -> Pieces -> Pieces
    forall a. a -> [a] -> [a]
    : FilePath -> Pieces
    toPieces' (Int -> FilePath -> FilePath
    forall a. Int -> [a] -> [a]
    drop 1 FilePath
    z)

        go :: [(Pieces, ByteString)] -> Embedded
        go :: [(Pieces, ByteString)] -> Embedded
    go orig :: [(Pieces, ByteString)]
    orig =
            [(FolderName, EmbeddedEntry)] -> Embedded
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(FolderName, EmbeddedEntry)] -> Embedded)
    -> [(FolderName, EmbeddedEntry)] -> Embedded
    forall a b. (a -> b) -> a -> b
    $ ((FolderName, [(Pieces, ByteString)])
     -> (FolderName, EmbeddedEntry))
    -> [(FolderName, [(Pieces, ByteString)])]
    -> [(FolderName, EmbeddedEntry)]
    forall a b. (a -> b) -> [a] -> [b]
    map (([(Pieces, ByteString)] -> EmbeddedEntry)
    -> (FolderName, [(Pieces, ByteString)])
    -> (FolderName, EmbeddedEntry)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second [(Pieces, ByteString)] -> EmbeddedEntry
    go') [(FolderName, [(Pieces, ByteString)])]
    hoisted
          where
            next :: [(FolderName, (Pieces, ByteString))]
    next = ((Pieces, ByteString) -> (FolderName, (Pieces, ByteString)))
    -> [(Pieces, ByteString)] -> [(FolderName, (Pieces, ByteString))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(x :: Pieces
    x, y :: ByteString
    y) -> (Pieces -> FolderName
    forall a. [a] -> a
    head Pieces
    x, (Pieces -> Pieces
    forall a. [a] -> [a]
    tail Pieces
    x, ByteString
    y))) [(Pieces, ByteString)]
    orig
            grouped :: [[(Piece, ([Piece], ByteString))]]
            grouped :: [[(FolderName, (Pieces, ByteString))]]
    grouped = ((FolderName, (Pieces, ByteString))
     -> (FolderName, (Pieces, ByteString)) -> Bool)
    -> [(FolderName, (Pieces, ByteString))]
    -> [[(FolderName, (Pieces, ByteString))]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (FolderName -> FolderName -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (FolderName -> FolderName -> Bool)
    -> ((FolderName, (Pieces, ByteString)) -> FolderName)
    -> (FolderName, (Pieces, ByteString))
    -> (FolderName, (Pieces, ByteString))
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (FolderName, (Pieces, ByteString)) -> FolderName
    forall a b. (a, b) -> a
    fst) ([(FolderName, (Pieces, ByteString))]
     -> [[(FolderName, (Pieces, ByteString))]])
    -> [(FolderName, (Pieces, ByteString))]
    -> [[(FolderName, (Pieces, ByteString))]]
    forall a b. (a -> b) -> a -> b
    $ ((FolderName, (Pieces, ByteString))
     -> (FolderName, (Pieces, ByteString)) -> Ordering)
    -> [(FolderName, (Pieces, ByteString))]
    -> [(FolderName, (Pieces, ByteString))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((FolderName, (Pieces, ByteString)) -> FolderName)
    -> (FolderName, (Pieces, ByteString))
    -> (FolderName, (Pieces, ByteString))
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (FolderName, (Pieces, ByteString)) -> FolderName
    forall a b. (a, b) -> a
    fst) [(FolderName, (Pieces, ByteString))]
    next
            hoisted :: [(Piece, [([Piece], ByteString)])]
            hoisted :: [(FolderName, [(Pieces, ByteString)])]
    hoisted = ([(FolderName, (Pieces, ByteString))]
     -> (FolderName, [(Pieces, ByteString)]))
    -> [[(FolderName, (Pieces, ByteString))]]
    -> [(FolderName, [(Pieces, ByteString)])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FolderName, (Pieces, ByteString)) -> FolderName
    forall a b. (a, b) -> a
    fst ((FolderName, (Pieces, ByteString)) -> FolderName)
    -> ([(FolderName, (Pieces, ByteString))]
        -> (FolderName, (Pieces, ByteString)))
    -> [(FolderName, (Pieces, ByteString))]
    -> FolderName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(FolderName, (Pieces, ByteString))]
    -> (FolderName, (Pieces, ByteString))
    forall a. [a] -> a
    head ([(FolderName, (Pieces, ByteString))] -> FolderName)
    -> ([(FolderName, (Pieces, ByteString))] -> [(Pieces, ByteString)])
    -> [(FolderName, (Pieces, ByteString))]
    -> (FolderName, [(Pieces, ByteString)])
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& ((FolderName, (Pieces, ByteString)) -> (Pieces, ByteString))
    -> [(FolderName, (Pieces, ByteString))] -> [(Pieces, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (FolderName, (Pieces, ByteString)) -> (Pieces, ByteString)
    forall a b. (a, b) -> b
    snd) [[(FolderName, (Pieces, ByteString))]]
    grouped

        go' :: [(Pieces, ByteString)] -> EmbeddedEntry
        go' :: [(Pieces, ByteString)] -> EmbeddedEntry
    go' [([], content :: ByteString
    content)] = ByteString -> EmbeddedEntry
    EEFile ByteString
    content
        go' x :: [(Pieces, ByteString)]
    x = Embedded -> EmbeddedEntry
    EEFolder (Embedded -> EmbeddedEntry) -> Embedded -> EmbeddedEntry
    forall a b. (a -> b) -> a -> b
    $ [(Pieces, ByteString)] -> Embedded
    go ([(Pieces, ByteString)] -> Embedded)
    -> [(Pieces, ByteString)] -> Embedded
    forall a b. (a -> b) -> a -> b
    $ ((Pieces, ByteString) -> Bool)
    -> [(Pieces, ByteString)] -> [(Pieces, ByteString)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\y :: (Pieces, ByteString)
    y -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Pieces -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Pieces -> Bool) -> Pieces -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Pieces, ByteString) -> Pieces
    forall a b. (a, b) -> a
    fst (Pieces, ByteString)
    y) [(Pieces, ByteString)]
    x

    bsToFile :: Piece -> ByteString -> File
    bsToFile :: FolderName -> ByteString -> File
    bsToFile name :: FolderName
    name bs :: ByteString
    bs = File :: Integer
    -> (Status -> ResponseHeaders -> Response)
    -> FolderName
    -> IO (Maybe ByteString)
    -> Maybe EpochTime
    -> File
    File
        { fileGetSize :: Integer
    fileGetSize = Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    S.length ByteString
    bs
        , fileToResponse :: Status -> ResponseHeaders -> Response
    fileToResponse = \s :: Status
    s h :: ResponseHeaders
    h -> Status -> ResponseHeaders -> Builder -> Response
    W.responseBuilder Status
    s ResponseHeaders
    h (Builder -> Response) -> Builder -> Response
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    byteString ByteString
    bs
        , fileName :: FolderName
    fileName = FolderName
    name
        , fileGetHash :: IO (Maybe ByteString)
    fileGetHash = Maybe ByteString -> IO (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> Maybe ByteString -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    runHash ByteString
    bs
        , fileGetModified :: Maybe EpochTime
    fileGetModified = Maybe EpochTime
    forall a. Maybe a
    Nothing
        }

    runHash :: ByteString -> ByteString
    runHash :: ByteString -> ByteString
    runHash = Base -> Digest MD5 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> bout
    convertToBase Base
    Base64 (Digest MD5 -> ByteString)
    -> (ByteString -> Digest MD5) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Digest MD5
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    ba -> Digest a
    hash :: S.ByteString -> Digest MD5)