3 Commits
Author SHA1 Message Date
paul ab667742da Bump version to 0.4 2023-03-24 12:53:38 +01:00
paul 647b5c2ad1 Rename /bytes to /utf8 2023-03-17 02:22:13 +01:00
paul 57173d14dd Limit number of returned codepoints 2023-03-17 02:19:15 +01:00
4 changed files with 21 additions and 11 deletions
+18 -8
View File
@@ -61,17 +61,17 @@ app :: Application
app = serve (Proxy :: Proxy API) server app = serve (Proxy :: Proxy API) server
type API = type API =
"bytes" :> Capture "bytes" Text :> Get '[PlainText, HTML] BytesModel "utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model
:<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
:<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel :<|> "text" :> Capture "text" Text :> Get '[HTML] TextModel
server :: Server API server :: Server API
server = server =
bytesR :<|> codepointsR :<|> textR utf8R :<|> codepointsR :<|> textR
where where
bytesR bytesP = do utf8R bytesP = do
bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400 bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
pure $ BytesModel $ Decode.decodeUtf8 bytes pure $ mkUtf8Model bytes
codepointsR codepointsP = do codepointsR codepointsP = do
codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400 codepoints' <- Parsers.parseCodepoints codepointsP `orThrow` const err400
@@ -82,11 +82,14 @@ server =
-- /bytes/<bytes> -- /bytes/<bytes>
newtype BytesModel = BytesModel newtype Utf8Model = Utf8Model
{ codepoints :: [([Word8], Either String Char)] { codepoints :: [([Word8], Either String Char)]
} }
instance MimeRender PlainText BytesModel where mkUtf8Model :: [Word8] -> Utf8Model
mkUtf8Model = Utf8Model . Decode.decodeUtf8
instance MimeRender PlainText Utf8Model where
mimeRender _ model = renderText $ mimeRender _ model = renderText $
Table.render " " $ concat Table.render " " $ concat
[ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes [ [ [ Table.cl $ Text.pack $ unwords $ map showByteHex bytes
@@ -107,7 +110,7 @@ instance MimeRender PlainText BytesModel where
| (bytes, eiC) <- model.codepoints | (bytes, eiC) <- model.codepoints
] ]
instance MimeRender HTML BytesModel where instance MimeRender HTML Utf8Model where
mimeRender _ model = renderHtml $ documentWithBody $ do mimeRender _ model = renderHtml $ documentWithBody $ do
H.table $ for_ model.codepoints $ \(bytes, eiC) -> do H.table $ for_ model.codepoints $ \(bytes, eiC) -> do
H.tr $ do H.tr $ do
@@ -128,7 +131,14 @@ newtype CodepointsModel = CodepointsModel
} }
mkCodepointsModel :: [(Word, Word)] -> CodepointsModel mkCodepointsModel :: [(Word, Word)] -> CodepointsModel
mkCodepointsModel = CodepointsModel . map go . concatMap (uncurry enumFromTo) mkCodepointsModel =
CodepointsModel
-- Limit number of returned codepoints. Otherwise it's
-- too easy to provoke massive response bodies with requests like
-- /codepoints/0-99999999
. take 100000
. map go
. concatMap (uncurry enumFromTo)
where where
go codepoint = (codepoint, toChar codepoint) go codepoint = (codepoint, toChar codepoint)
+1 -1
View File
@@ -1,7 +1,7 @@
# Adapted from new-template.hsfiles # Adapted from new-template.hsfiles
name: utoy name: utoy
version: 0.3 version: 0.4
git: "https://git.pbrinkmeier.de/paul/utoy" git: "https://git.pbrinkmeier.de/paul/utoy"
license: MIT license: MIT
author: "Paul Brinkmeier" author: "Paul Brinkmeier"
+1 -1
View File
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: utoy name: utoy
version: 0.3 version: 0.4
author: Paul Brinkmeier author: Paul Brinkmeier
maintainer: hallo@pbrinkmeier.de maintainer: hallo@pbrinkmeier.de
copyright: 2023 Paul Brinkmeier copyright: 2023 Paul Brinkmeier
+1 -1
View File
@@ -8,7 +8,7 @@ let
utoy = utoy =
{ mkDerivation }: { mkDerivation }:
mkDerivation { mkDerivation {
version = "0.3"; version = "0.4";
pname = "utoy"; pname = "utoy";
license = pkgs.lib.licenses.mit; license = pkgs.lib.licenses.mit;
src = src =