module Web.Minion.Static (StaticFileResponse, staticFiles, defaultExtsMap) where

import Data.ByteString qualified as Bytes
import Data.ByteString.Lazy qualified as Bytes.Lazy
import Data.Map.Strict qualified as Map
import Data.Void
import Network.HTTP.Media
import System.FilePath (takeExtension)
import Web.Minion
import Web.Minion.Introspect qualified as I
import Web.Minion.Response.Header qualified as Header

type StaticFileResponse = Header.AddHeaders '[Header.AddHeader "Content-Type" Header.RawHeaderValue] LazyBytes

{-# INLINE staticFiles #-}
staticFiles ::
  (Monad m, I.Introspection i I.Response StaticFileResponse) =>
  -- | Use 'defaultExtsMap'
  Map.Map String MediaType ->
  [(FilePath, Bytes.ByteString)] ->
  Router' i Void m
staticFiles :: forall (m :: * -> *) i.
(Monad m, Introspection i 'Response StaticFileResponse) =>
Map String MediaType -> [(String, ByteString)] -> Router' i Void m
staticFiles Map String MediaType
extsMap = ((String, ByteString) -> Router' i Void m)
-> [(String, ByteString)] -> Router' i Void m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(String
path, ByteString
content) ->
  let contentType :: ByteString
contentType = Map String MediaType -> String -> ByteString
forall a. RenderHeader a => Map String a -> String -> ByteString
getContentType Map String MediaType
extsMap (String -> String
takeExtension String
path)
   in String -> Combinator i Void m
forall i ts (m :: * -> *). String -> Combinator i ts m
piece String
path Combinator i Void m -> Combinator i Void m
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> ByteString
-> (DelayedArgs '[] ~> m StaticFileResponse) -> Router' i Void m
forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handle ByteString
GET do
        StaticFileResponse -> m StaticFileResponse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StaticFileResponse -> m StaticFileResponse)
-> StaticFileResponse -> m StaticFileResponse
forall a b. (a -> b) -> a -> b
$
          Header.AddHeaders
            { $sel:headers:AddHeaders :: HList '[AddHeader "Content-Type" RawHeaderValue]
headers = forall {k} (name :: k) a. a -> AddHeader name a
forall (name :: Symbol) a. a -> AddHeader name a
Header.AddHeader @"Content-Type" (ByteString -> RawHeaderValue
Header.RawHeaderValue ByteString
contentType) AddHeader "Content-Type" RawHeaderValue
-> HList '[] -> HList '[AddHeader "Content-Type" RawHeaderValue]
forall t (ts1 :: [*]). t -> HList ts1 -> HList (t : ts1)
:# HList '[]
HNil
            , $sel:body:AddHeaders :: LazyBytes
body = ByteString -> LazyBytes
LazyBytes (ByteString -> LazyBytes) -> ByteString -> LazyBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Bytes.Lazy.fromStrict ByteString
content
            }

getContentType :: (RenderHeader a) => Map.Map String a -> FilePath -> Bytes.ByteString
getContentType :: forall a. RenderHeader a => Map String a -> String -> ByteString
getContentType Map String a
extsMap String
path = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"application/octet-stream" a -> ByteString
forall h. RenderHeader h => h -> ByteString
renderHeader (Maybe a -> ByteString) -> Maybe a -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Map String a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String
takeExtension String
path) Map String a
extsMap

defaultExtsMap :: Map.Map String MediaType
defaultExtsMap :: Map String MediaType
defaultExtsMap =
  [(String, MediaType)] -> Map String MediaType
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ String
".aac" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/aac"
    , String
".abw" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-abiword"
    , String
".arc" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-freearc"
    , String
".avif" String -> MediaType -> (String, MediaType)
~> MediaType
"image/avif"
    , String
".avi" String -> MediaType -> (String, MediaType)
~> MediaType
"video/x-msvideo"
    , String
".azw" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.amazon.ebook"
    , String
".bin" String -> MediaType -> (String, MediaType)
~> MediaType
"application/octet-stream"
    , String
".bmp" String -> MediaType -> (String, MediaType)
~> MediaType
"image/bmp"
    , String
".bz" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-bzip"
    , String
".bz2" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-bzip2"
    , String
".cda" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-cdf"
    , String
".csh" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-csh"
    , String
".css" String -> MediaType -> (String, MediaType)
~> MediaType
"text/css"
    , String
".csv" String -> MediaType -> (String, MediaType)
~> MediaType
"text/csv"
    , String
".doc" String -> MediaType -> (String, MediaType)
~> MediaType
"application/msword"
    , String
".docx" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
    , String
".eot" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.ms-fontobject"
    , String
".epub" String -> MediaType -> (String, MediaType)
~> MediaType
"application/epub+zip"
    , String
".gz" String -> MediaType -> (String, MediaType)
~> MediaType
"application/gzip"
    , String
".gif" String -> MediaType -> (String, MediaType)
~> MediaType
"image/gif"
    , String
".htm" String -> MediaType -> (String, MediaType)
~> MediaType
"text/html"
    , String
".ico" String -> MediaType -> (String, MediaType)
~> MediaType
"image/vnd.microsoft.icon"
    , String
".ics" String -> MediaType -> (String, MediaType)
~> MediaType
"text/calendar"
    , String
".jar" String -> MediaType -> (String, MediaType)
~> MediaType
"application/java-archive"
    , String
".jpeg" String -> MediaType -> (String, MediaType)
~> MediaType
"image/jpeg"
    , String
".jpg" String -> MediaType -> (String, MediaType)
~> MediaType
"image/jpeg"
    , String
".js" String -> MediaType -> (String, MediaType)
~> MediaType
"text/javascript"
    , String
".json" String -> MediaType -> (String, MediaType)
~> MediaType
"application/json"
    , String
".jsonld" String -> MediaType -> (String, MediaType)
~> MediaType
"application/ld+json"
    , String
".mid" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/midi"
    , String
".midi" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/midi"
    , String
".mjs" String -> MediaType -> (String, MediaType)
~> MediaType
"text/javascript"
    , String
".mp3" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/mpeg"
    , String
".mp4" String -> MediaType -> (String, MediaType)
~> MediaType
"video/mp4"
    , String
".mpeg" String -> MediaType -> (String, MediaType)
~> MediaType
"video/mpeg"
    , String
".mpkg" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.apple.installer+xml"
    , String
".odp" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.oasis.opendocument.presentation"
    , String
".ods" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.oasis.opendocument.spreadsheet"
    , String
".odt" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.oasis.opendocument.text"
    , String
".oga" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/ogg"
    , String
".ogv" String -> MediaType -> (String, MediaType)
~> MediaType
"video/ogg"
    , String
".ogx" String -> MediaType -> (String, MediaType)
~> MediaType
"application/ogg"
    , String
".opus" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/opus"
    , String
".otf" String -> MediaType -> (String, MediaType)
~> MediaType
"font/otf"
    , String
".png" String -> MediaType -> (String, MediaType)
~> MediaType
"image/png"
    , String
".pdf" String -> MediaType -> (String, MediaType)
~> MediaType
"application/pdf"
    , String
".php" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-httpd-php"
    , String
".ppt" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.ms-powerpoint"
    , String
".pptx" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.openxmlformats-officedocument.presentationml.presentation"
    , String
".rar" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.rar"
    , String
".rtf" String -> MediaType -> (String, MediaType)
~> MediaType
"application/rtf"
    , String
".sh" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-sh"
    , String
".svg" String -> MediaType -> (String, MediaType)
~> MediaType
"image/svg+xml"
    , String
".tar" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-tar"
    , String
".tif" String -> MediaType -> (String, MediaType)
~> MediaType
"image/tiff"
    , String
".tiff" String -> MediaType -> (String, MediaType)
~> MediaType
"image/tiff"
    , String
".ts" String -> MediaType -> (String, MediaType)
~> MediaType
"video/mp2t"
    , String
".ttf" String -> MediaType -> (String, MediaType)
~> MediaType
"font/ttf"
    , String
".txt" String -> MediaType -> (String, MediaType)
~> MediaType
"text/plain"
    , String
".vsd" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.visio"
    , String
".wav" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/wav"
    , String
".weba" String -> MediaType -> (String, MediaType)
~> MediaType
"audio/webm"
    , String
".webm" String -> MediaType -> (String, MediaType)
~> MediaType
"video/webm"
    , String
".webp" String -> MediaType -> (String, MediaType)
~> MediaType
"image/webp"
    , String
".woff" String -> MediaType -> (String, MediaType)
~> MediaType
"font/woff"
    , String
".woff2" String -> MediaType -> (String, MediaType)
~> MediaType
"font/woff2"
    , String
".xhtml" String -> MediaType -> (String, MediaType)
~> MediaType
"application/xhtml+xml"
    , String
".xls" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.ms-excel"
    , String
".xlsx" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
    , String
".xml" String -> MediaType -> (String, MediaType)
~> MediaType
"application/xml"
    , String
".xul" String -> MediaType -> (String, MediaType)
~> MediaType
"application/vnd.mozilla.xul+xml"
    , String
".zip" String -> MediaType -> (String, MediaType)
~> MediaType
"application/zip"
    , String
".3gp" String -> MediaType -> (String, MediaType)
~> MediaType
"video/3gpp"
    , String
".3g2" String -> MediaType -> (String, MediaType)
~> MediaType
"video/3gpp2"
    , String
".7z" String -> MediaType -> (String, MediaType)
~> MediaType
"application/x-7z-compressed"
    ]
 where
  (~>) :: String -> MediaType -> (String, MediaType)
  ~> :: String -> MediaType -> (String, MediaType)
(~>) = (,)