ms2k/nuthatch
SHA256
Watch
0
Code Releases Activity

Replace raw HTTP dispatch with typed Servant API

Browse source
This commit is contained in:
ms2k 2026-07-18 13:17:40 +09:00
commit 435d4fea4c
1 changed files with 1625 additions and 445 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/Nuthatch/Paths.hs
View file

@ -10,33 +10,11 @@ import Crypto.Hash (Digest, SHA256, hash)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import Data.Char (isControl)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Normalize as TN
import Nuthatch.Types
validateRelativePath :: Text -> Either Text RelativePath
validateRelativePath raw = do
if T.null raw
then Left "path must not be empty"
else if T.head raw == '/' || T.last raw == '/'
then Left "path must not begin or end with a separator"
else if TN.normalize TN.NFC raw /= raw
then Left "path must be NFC-normalized"
else do
let segments = T.splitOn "/" raw
mapM_ validateSegment segments
pure (RelativePath raw)
where
validateSegment seg
| T.null seg = Left "empty path segment"
| seg == "." || seg == ".." = Left "path segment may not be . or .."
| T.any (== '\\') seg = Left "backslash is not allowed"
| T.any isControl seg = Left "control characters are not allowed"
| otherwise = Right ()
buildObjectKey :: Root -> UserId -> RelativePath -> ObjectKey
buildObjectKey root uid (RelativePath path) =
ObjectKey $ case root of