mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
Feature/api versioning (#106)
* wip * finishes initial refactor * prune unused code * finished massive refactor * remove commented deps * fix import * fix bug
This commit is contained in:
Keagan McClelland
committed by
GitHub
GitHub
parent
bb0488f1dd
commit
dbd73fae7f
@@ -1,180 +1,199 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
|
||||
module Lib.PkgRepository where
|
||||
|
||||
import Conduit ( (.|)
|
||||
, ConduitT
|
||||
, MonadResource
|
||||
, runConduit
|
||||
, runResourceT
|
||||
, sinkFileCautious
|
||||
, sourceFile
|
||||
)
|
||||
import Control.Monad.Logger ( MonadLogger
|
||||
, MonadLoggerIO
|
||||
, logError
|
||||
, logInfo
|
||||
, logWarn
|
||||
)
|
||||
import Control.Monad.Reader.Has ( Has
|
||||
, ask
|
||||
, asks
|
||||
)
|
||||
import Crypto.Hash ( SHA256 )
|
||||
import Crypto.Hash.Conduit ( hashFile )
|
||||
import Data.Aeson ( eitherDecodeFileStrict' )
|
||||
import qualified Data.Attoparsec.Text as Atto
|
||||
import Data.Attoparsec.Text ( parseOnly )
|
||||
import Data.ByteArray.Encoding ( Base(Base16)
|
||||
, convertToBase
|
||||
)
|
||||
import Data.ByteString ( readFile
|
||||
, writeFile
|
||||
)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import qualified Data.Text as T
|
||||
import Data.Time ( getCurrentTime )
|
||||
import Database.Esqueleto.Experimental
|
||||
( ConnectionPool
|
||||
, insertUnique
|
||||
, runSqlPool
|
||||
)
|
||||
import Database.Persist ( (=.)
|
||||
, insertKey
|
||||
, update
|
||||
, upsert
|
||||
)
|
||||
import Database.Persist.Sql ( SqlPersistT
|
||||
, runSqlPoolNoTransaction
|
||||
)
|
||||
import Database.PostgreSQL.Simple ( SqlError(sqlState) )
|
||||
import Lib.Error ( S9Error(NotFoundE) )
|
||||
import qualified Lib.External.AppMgr as AppMgr
|
||||
import Lib.Types.AppIndex ( PackageDependency(..)
|
||||
, PackageManifest(..)
|
||||
, PkgId(..)
|
||||
, packageDependencyVersion
|
||||
, packageManifestDependencies
|
||||
)
|
||||
import Lib.Types.Emver ( Version
|
||||
, VersionRange
|
||||
, parseVersion
|
||||
, satisfies
|
||||
)
|
||||
import Model ( EntityField(EosHashHash, PkgRecordUpdatedAt)
|
||||
, EosHash(EosHash)
|
||||
, Key(PkgRecordKey)
|
||||
, PkgDependency(PkgDependency)
|
||||
, PkgRecord(PkgRecord)
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, (&&)
|
||||
, (.)
|
||||
, (/=)
|
||||
, (<$>)
|
||||
, Bool(..)
|
||||
, ByteString
|
||||
, Down(..)
|
||||
, Either(..)
|
||||
, Eq((==))
|
||||
, Exception
|
||||
, FilePath
|
||||
, IO
|
||||
, Integer
|
||||
, Maybe(..)
|
||||
, MonadIO(liftIO)
|
||||
, MonadReader
|
||||
, Ord(compare)
|
||||
, Show
|
||||
, SomeException(..)
|
||||
, decodeUtf8
|
||||
, filter
|
||||
, find
|
||||
, first
|
||||
, flip
|
||||
, for_
|
||||
, fst
|
||||
, headMay
|
||||
, not
|
||||
, on
|
||||
, partitionEithers
|
||||
, pure
|
||||
, show
|
||||
, snd
|
||||
, sortBy
|
||||
, throwIO
|
||||
, toS
|
||||
, void
|
||||
)
|
||||
import System.FSNotify ( ActionPredicate
|
||||
, Event(..)
|
||||
, eventPath
|
||||
, watchTree
|
||||
, withManager
|
||||
)
|
||||
import System.FilePath ( (<.>)
|
||||
, (</>)
|
||||
, takeBaseName
|
||||
, takeDirectory
|
||||
, takeExtension
|
||||
, takeFileName
|
||||
)
|
||||
import UnliftIO ( MonadUnliftIO
|
||||
, askRunInIO
|
||||
, async
|
||||
, catch
|
||||
, mapConcurrently_
|
||||
, newEmptyMVar
|
||||
, takeMVar
|
||||
, tryPutMVar
|
||||
, wait
|
||||
)
|
||||
import UnliftIO.Concurrent ( forkIO )
|
||||
import UnliftIO.Directory ( doesDirectoryExist
|
||||
, doesPathExist
|
||||
, getFileSize
|
||||
, listDirectory
|
||||
, removeFile
|
||||
, renameFile
|
||||
)
|
||||
import UnliftIO.Exception ( handle )
|
||||
import Yesod.Core.Content ( typeGif
|
||||
, typeJpeg
|
||||
, typePlain
|
||||
, typePng
|
||||
, typeSvg
|
||||
)
|
||||
import Yesod.Core.Types ( ContentType )
|
||||
import Conduit (
|
||||
ConduitT,
|
||||
MonadResource,
|
||||
runConduit,
|
||||
runResourceT,
|
||||
sinkFileCautious,
|
||||
sourceFile,
|
||||
(.|),
|
||||
)
|
||||
import Control.Monad.Logger (
|
||||
MonadLogger,
|
||||
MonadLoggerIO,
|
||||
logError,
|
||||
logInfo,
|
||||
logWarn,
|
||||
)
|
||||
import Control.Monad.Reader.Has (
|
||||
Has,
|
||||
ask,
|
||||
asks,
|
||||
)
|
||||
import Crypto.Hash (SHA256)
|
||||
import Crypto.Hash.Conduit (hashFile)
|
||||
import Data.Aeson (eitherDecodeFileStrict')
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
import Data.Attoparsec.Text qualified as Atto
|
||||
import Data.ByteArray.Encoding (
|
||||
Base (Base16),
|
||||
convertToBase,
|
||||
)
|
||||
import Data.ByteString (
|
||||
readFile,
|
||||
writeFile,
|
||||
)
|
||||
import Data.HashMap.Strict qualified as HM
|
||||
import Data.String.Interpolate.IsString (
|
||||
i,
|
||||
)
|
||||
import Data.Text qualified as T
|
||||
import Data.Time (getCurrentTime)
|
||||
import Database.Esqueleto.Experimental (
|
||||
ConnectionPool,
|
||||
insertUnique,
|
||||
runSqlPool,
|
||||
)
|
||||
import Database.Persist (
|
||||
insertKey,
|
||||
update,
|
||||
upsert,
|
||||
(=.),
|
||||
)
|
||||
import Database.Persist.Sql (
|
||||
SqlPersistT,
|
||||
runSqlPoolNoTransaction,
|
||||
)
|
||||
import Database.PostgreSQL.Simple (SqlError (sqlState))
|
||||
import Lib.Error (S9Error (NotFoundE))
|
||||
import Lib.External.AppMgr qualified as AppMgr
|
||||
import Lib.Types.Core (
|
||||
PkgId (..),
|
||||
)
|
||||
import Lib.Types.Emver (
|
||||
Version,
|
||||
VersionRange,
|
||||
parseVersion,
|
||||
satisfies,
|
||||
)
|
||||
import Lib.Types.Manifest (PackageDependency (..), PackageManifest (..))
|
||||
import Model (
|
||||
EntityField (EosHashHash, PkgRecordUpdatedAt),
|
||||
EosHash (EosHash),
|
||||
Key (PkgRecordKey),
|
||||
PkgDependency (PkgDependency),
|
||||
PkgRecord (PkgRecord),
|
||||
)
|
||||
import Startlude (
|
||||
Bool (..),
|
||||
ByteString,
|
||||
Down (..),
|
||||
Either (..),
|
||||
Eq ((==)),
|
||||
Exception,
|
||||
FilePath,
|
||||
IO,
|
||||
Integer,
|
||||
Maybe (..),
|
||||
MonadIO (liftIO),
|
||||
MonadReader,
|
||||
Ord (compare),
|
||||
Show,
|
||||
SomeException (..),
|
||||
decodeUtf8,
|
||||
filter,
|
||||
find,
|
||||
first,
|
||||
flip,
|
||||
for_,
|
||||
fst,
|
||||
headMay,
|
||||
not,
|
||||
on,
|
||||
partitionEithers,
|
||||
pure,
|
||||
show,
|
||||
snd,
|
||||
sortBy,
|
||||
throwIO,
|
||||
toS,
|
||||
void,
|
||||
($),
|
||||
(&&),
|
||||
(.),
|
||||
(/=),
|
||||
(<$>),
|
||||
)
|
||||
import System.FSNotify (
|
||||
ActionPredicate,
|
||||
Event (..),
|
||||
eventPath,
|
||||
watchTree,
|
||||
withManager,
|
||||
)
|
||||
import System.FilePath (
|
||||
takeBaseName,
|
||||
takeDirectory,
|
||||
takeExtension,
|
||||
takeFileName,
|
||||
(<.>),
|
||||
(</>),
|
||||
)
|
||||
import UnliftIO (
|
||||
MonadUnliftIO,
|
||||
askRunInIO,
|
||||
async,
|
||||
catch,
|
||||
mapConcurrently_,
|
||||
newEmptyMVar,
|
||||
takeMVar,
|
||||
tryPutMVar,
|
||||
wait,
|
||||
)
|
||||
import UnliftIO.Concurrent (forkIO)
|
||||
import UnliftIO.Directory (
|
||||
doesDirectoryExist,
|
||||
doesPathExist,
|
||||
getFileSize,
|
||||
listDirectory,
|
||||
removeFile,
|
||||
renameFile,
|
||||
)
|
||||
import UnliftIO.Exception (handle)
|
||||
import Yesod.Core.Content (
|
||||
typeGif,
|
||||
typeJpeg,
|
||||
typePlain,
|
||||
typePng,
|
||||
typeSvg,
|
||||
)
|
||||
import Yesod.Core.Types (ContentType)
|
||||
|
||||
|
||||
newtype ManifestParseException = ManifestParseException FilePath
|
||||
deriving Show
|
||||
deriving (Show)
|
||||
instance Exception ManifestParseException
|
||||
|
||||
|
||||
data PkgRepo = PkgRepo
|
||||
{ pkgRepoFileRoot :: !FilePath
|
||||
{ pkgRepoFileRoot :: !FilePath
|
||||
, pkgRepoAppMgrBin :: !FilePath
|
||||
}
|
||||
|
||||
|
||||
newtype EosRepo = EosRepo
|
||||
{ eosRepoFileRoot :: FilePath
|
||||
}
|
||||
|
||||
|
||||
getPackages :: (MonadIO m, MonadReader r m, Has PkgRepo r) => m [PkgId]
|
||||
getPackages = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
root <- asks pkgRepoFileRoot
|
||||
paths <- listDirectory root
|
||||
pure $ PkgId . toS <$> paths
|
||||
|
||||
|
||||
getVersionsFor :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> m [Version]
|
||||
getVersionsFor pkg = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
@@ -188,52 +207,66 @@ getVersionsFor pkg = do
|
||||
pure successes
|
||||
else pure []
|
||||
|
||||
|
||||
getViableVersions :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> VersionRange -> m [Version]
|
||||
getViableVersions pkg spec = filter (`satisfies` spec) <$> getVersionsFor pkg
|
||||
|
||||
getBestVersion :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m)
|
||||
=> PkgId
|
||||
-> VersionRange
|
||||
-> Bool
|
||||
-> m (Maybe Version)
|
||||
|
||||
getBestVersion ::
|
||||
(MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) =>
|
||||
PkgId ->
|
||||
VersionRange ->
|
||||
Bool ->
|
||||
m (Maybe Version)
|
||||
getBestVersion pkg spec preferMin = headMay . sortBy comparator <$> getViableVersions pkg spec
|
||||
where comparator = if preferMin then compare else compare `on` Down
|
||||
where
|
||||
comparator = if preferMin then compare else compare `on` Down
|
||||
|
||||
|
||||
loadPkgDependencies :: MonadUnliftIO m => ConnectionPool -> PackageManifest -> m ()
|
||||
loadPkgDependencies appConnPool manifest = do
|
||||
let pkgId = packageManifestId manifest
|
||||
let pkgId = packageManifestId manifest
|
||||
let pkgVersion = packageManifestVersion manifest
|
||||
let deps = packageManifestDependencies manifest
|
||||
let deps = packageManifestDependencies manifest
|
||||
time <- liftIO getCurrentTime
|
||||
_ <- runWith appConnPool $ insertKey (PkgRecordKey pkgId) (PkgRecord time Nothing) `catch` \(e :: SqlError) ->
|
||||
-- 23505 is "already exists"
|
||||
if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e
|
||||
_ <-
|
||||
runWith appConnPool $
|
||||
insertKey (PkgRecordKey pkgId) (PkgRecord time Nothing) `catch` \(e :: SqlError) ->
|
||||
-- 23505 is "already exists"
|
||||
if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e
|
||||
let deps' = first PkgRecordKey <$> HM.toList deps
|
||||
for_
|
||||
deps'
|
||||
(\d -> flip runSqlPool appConnPool $ do
|
||||
_ <- runWith appConnPool $ insertKey (fst d) (PkgRecord time Nothing) `catch` \(e :: SqlError) ->
|
||||
-- 23505 is "already exists"
|
||||
if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e
|
||||
insertUnique
|
||||
$ PkgDependency time (PkgRecordKey pkgId) pkgVersion (fst d) (packageDependencyVersion . snd $ d)
|
||||
( \d -> flip runSqlPool appConnPool $ do
|
||||
_ <-
|
||||
runWith appConnPool $
|
||||
insertKey (fst d) (PkgRecord time Nothing) `catch` \(e :: SqlError) ->
|
||||
-- 23505 is "already exists"
|
||||
if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e
|
||||
insertUnique $
|
||||
PkgDependency time (PkgRecordKey pkgId) pkgVersion (fst d) (packageDependencyVersion . snd $ d)
|
||||
)
|
||||
where
|
||||
runWith :: MonadUnliftIO m => ConnectionPool -> SqlPersistT m a -> m a
|
||||
runWith pool action = runSqlPoolNoTransaction action pool Nothing
|
||||
|
||||
|
||||
-- extract all package assets into their own respective files
|
||||
extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> FilePath -> m ()
|
||||
extractPkg pool fp = handle @_ @SomeException cleanup $ do
|
||||
$logInfo [i|Extracting package: #{fp}|]
|
||||
PkgRepo { pkgRepoAppMgrBin = appmgr } <- ask
|
||||
PkgRepo{pkgRepoAppMgrBin = appmgr} <- ask
|
||||
let pkgRoot = takeDirectory fp
|
||||
manifestTask <- async $ runResourceT $ AppMgr.sourceManifest appmgr fp $ sinkIt (pkgRoot </> "manifest.json")
|
||||
pkgHashTask <- async $ AppMgr.getPackageHash appmgr fp
|
||||
instructionsTask <- async $ runResourceT $ AppMgr.sourceInstructions appmgr fp $ sinkIt
|
||||
(pkgRoot </> "instructions.md")
|
||||
manifestTask <- async $ runResourceT $ AppMgr.sourceManifest appmgr fp $ sinkIt (pkgRoot </> "manifest.json")
|
||||
pkgHashTask <- async $ AppMgr.getPackageHash appmgr fp
|
||||
instructionsTask <-
|
||||
async $
|
||||
runResourceT $
|
||||
AppMgr.sourceInstructions appmgr fp $
|
||||
sinkIt
|
||||
(pkgRoot </> "instructions.md")
|
||||
licenseTask <- async $ runResourceT $ AppMgr.sourceLicense appmgr fp $ sinkIt (pkgRoot </> "license.md")
|
||||
iconTask <- async $ runResourceT $ AppMgr.sourceIcon appmgr fp $ sinkIt (pkgRoot </> "icon.tmp")
|
||||
iconTask <- async $ runResourceT $ AppMgr.sourceIcon appmgr fp $ sinkIt (pkgRoot </> "icon.tmp")
|
||||
wait manifestTask
|
||||
eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot </> "manifest.json"))
|
||||
case eManifest of
|
||||
@@ -242,11 +275,12 @@ extractPkg pool fp = handle @_ @SomeException cleanup $ do
|
||||
liftIO . throwIO $ ManifestParseException (pkgRoot </> "manifest.json")
|
||||
Right manifest -> do
|
||||
wait iconTask
|
||||
let iconDest = "icon" <.> case packageManifestIcon manifest of
|
||||
Nothing -> "png"
|
||||
Just x -> case takeExtension (T.unpack x) of
|
||||
"" -> "png"
|
||||
other -> other
|
||||
let iconDest =
|
||||
"icon" <.> case packageManifestIcon manifest of
|
||||
Nothing -> "png"
|
||||
Just x -> case takeExtension (T.unpack x) of
|
||||
"" -> "png"
|
||||
other -> other
|
||||
loadPkgDependencies pool manifest
|
||||
liftIO $ renameFile (pkgRoot </> "icon.tmp") (pkgRoot </> iconDest)
|
||||
hash <- wait pkgHashTask
|
||||
@@ -263,97 +297,112 @@ extractPkg pool fp = handle @_ @SomeException cleanup $ do
|
||||
mapConcurrently_ (removeFile . (pkgRoot </>)) toRemove
|
||||
throwIO e
|
||||
|
||||
|
||||
watchEosRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has EosRepo r, MonadLoggerIO m) => ConnectionPool -> m (IO Bool)
|
||||
watchEosRepoRoot pool = do
|
||||
$logInfo "Starting FSNotify Watch Manager: EOS"
|
||||
root <- asks eosRepoFileRoot
|
||||
root <- asks eosRepoFileRoot
|
||||
runInIO <- askRunInIO
|
||||
box <- newEmptyMVar @_ @()
|
||||
_ <- forkIO $ liftIO $ withManager $ \watchManager -> do
|
||||
stop <- watchTree watchManager root shouldIndex $ \evt -> do
|
||||
let os = eventPath evt
|
||||
void . forkIO $ runInIO $ do
|
||||
indexOs pool os
|
||||
takeMVar box
|
||||
stop
|
||||
box <- newEmptyMVar @_ @()
|
||||
_ <- forkIO $
|
||||
liftIO $
|
||||
withManager $ \watchManager -> do
|
||||
stop <- watchTree watchManager root shouldIndex $ \evt -> do
|
||||
let os = eventPath evt
|
||||
void . forkIO $
|
||||
runInIO $ do
|
||||
indexOs pool os
|
||||
takeMVar box
|
||||
stop
|
||||
pure $ tryPutMVar box ()
|
||||
where
|
||||
shouldIndex :: ActionPredicate
|
||||
shouldIndex (Added path _ isDir) = not isDir && takeExtension path == ".img"
|
||||
shouldIndex (Added path _ isDir) = not isDir && takeExtension path == ".img"
|
||||
shouldIndex (Modified path _ isDir) = not isDir && takeExtension path == ".img"
|
||||
shouldIndex _ = False
|
||||
shouldIndex _ = False
|
||||
indexOs :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionPool -> FilePath -> m ()
|
||||
indexOs pool path = do
|
||||
hash <- hashFile @_ @SHA256 path
|
||||
let hashText = decodeUtf8 $ convertToBase Base16 hash
|
||||
let vText = takeFileName (takeDirectory path)
|
||||
let vText = takeFileName (takeDirectory path)
|
||||
let eVersion = parseOnly parseVersion . T.pack $ vText
|
||||
case eVersion of
|
||||
Left e -> $logError [i|Invalid Version Number (#{vText}): #{e}|]
|
||||
Right version ->
|
||||
void $ flip runSqlPool pool $ upsert (EosHash version hashText) [EosHashHash =. hashText]
|
||||
|
||||
|
||||
getManifestLocation :: (MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m FilePath
|
||||
getManifestLocation pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
pure $ root </> show pkg </> show version </> "manifest.json"
|
||||
|
||||
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
|
||||
getManifest ::
|
||||
(MonadResource m, MonadReader r m, Has PkgRepo r) =>
|
||||
PkgId ->
|
||||
Version ->
|
||||
m (Integer, ConduitT () ByteString m ())
|
||||
getManifest pkg version = do
|
||||
manifestPath <- getManifestLocation pkg version
|
||||
n <- getFileSize manifestPath
|
||||
n <- getFileSize manifestPath
|
||||
pure (n, sourceFile manifestPath)
|
||||
|
||||
getInstructions :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
|
||||
getInstructions ::
|
||||
(MonadResource m, MonadReader r m, Has PkgRepo r) =>
|
||||
PkgId ->
|
||||
Version ->
|
||||
m (Integer, ConduitT () ByteString m ())
|
||||
getInstructions pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let instructionsPath = root </> show pkg </> show version </> "instructions.md"
|
||||
n <- getFileSize instructionsPath
|
||||
pure (n, sourceFile instructionsPath)
|
||||
|
||||
getLicense :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
|
||||
getLicense ::
|
||||
(MonadResource m, MonadReader r m, Has PkgRepo r) =>
|
||||
PkgId ->
|
||||
Version ->
|
||||
m (Integer, ConduitT () ByteString m ())
|
||||
getLicense pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let licensePath = root </> show pkg </> show version </> "license.md"
|
||||
n <- getFileSize licensePath
|
||||
pure (n, sourceFile licensePath)
|
||||
|
||||
getIcon :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (ContentType, Integer, ConduitT () ByteString m ())
|
||||
|
||||
getIcon ::
|
||||
(MonadResource m, MonadReader r m, Has PkgRepo r) =>
|
||||
PkgId ->
|
||||
Version ->
|
||||
m (ContentType, Integer, ConduitT () ByteString m ())
|
||||
getIcon pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let pkgRoot = root </> show pkg </> show version
|
||||
mIconFile <- find ((== "icon") . takeBaseName) <$> listDirectory pkgRoot
|
||||
case mIconFile of
|
||||
Nothing -> throwIO $ NotFoundE [i|#{pkg}: Icon|]
|
||||
Just x -> do
|
||||
Just x -> do
|
||||
let ct = case takeExtension x of
|
||||
".png" -> typePng
|
||||
".jpg" -> typeJpeg
|
||||
".png" -> typePng
|
||||
".jpg" -> typeJpeg
|
||||
".jpeg" -> typeJpeg
|
||||
".svg" -> typeSvg
|
||||
".gif" -> typeGif
|
||||
_ -> typePlain
|
||||
".svg" -> typeSvg
|
||||
".gif" -> typeGif
|
||||
_ -> typePlain
|
||||
n <- getFileSize (pkgRoot </> x)
|
||||
pure (ct, n, sourceFile (pkgRoot </> x))
|
||||
|
||||
|
||||
getHash :: (MonadIO m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m ByteString
|
||||
getHash pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let hashPath = root </> show pkg </> show version </> "hash.bin"
|
||||
liftIO $ readFile hashPath
|
||||
|
||||
|
||||
getPackage :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m (Maybe FilePath)
|
||||
getPackage pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
|
||||
Reference in New Issue
Block a user