42 lines
1.3 KiB
Haskell
42 lines
1.3 KiB
Haskell
|
module Nuthatch.Paths
|
||
|
|
( validateRelativePath
|
||
|
|
, buildObjectKey
|
||
|
|
, listCacheAncestorPrefixes
|
||
|
|
, encodeUserId
|
||
|
|
, basename
|
||
|
|
) where
|
||
|
|
|
||
|
|
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.Text (Text)
|
||
|
|
import qualified Data.Text as T
|
||
|
|
import qualified Data.Text.Encoding as TE
|
||
|
|
import Nuthatch.Types
|
||
|
|
|
||
|
|
buildObjectKey :: Root -> UserId -> RelativePath -> ObjectKey
|
||
|
|
buildObjectKey root uid (RelativePath path) =
|
||
|
|
ObjectKey $ case root of
|
||
|
|
Personal -> "users/" <> unUserId uid <> "/" <> path
|
||
|
|
Shared -> "shared/" <> path
|
||
|
|
|
||
|
|
listCacheAncestorPrefixes :: RelativePath -> [Text]
|
||
|
|
listCacheAncestorPrefixes (RelativePath path) =
|
||
|
|
let segs = filter (not . T.null) (T.splitOn "/" path)
|
||
|
|
in case segs of
|
||
|
|
[] -> [""]
|
||
|
|
_ -> "" : init (scanl1 (\a b -> a <> "/" <> b) segs)
|
||
|
|
|
||
|
|
encodeUserId :: Text -> Text -> UserId
|
||
|
|
encodeUserId iss sub =
|
||
|
|
let material = TE.encodeUtf8 (iss <> "\0" <> sub)
|
||
|
|
digest = hash material :: Digest SHA256
|
||
|
|
hex = B16.encode (BS.pack (BA.unpack digest))
|
||
|
|
in UserId (TE.decodeUtf8 hex)
|
||
|
|
|
||
|
|
basename :: RelativePath -> Text
|
||
|
|
basename (RelativePath path) =
|
||
|
|
case reverse (T.splitOn "/" path) of
|
||
|
|
(x : _) -> x
|
||
|
|
[] -> path
|