Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-30 11:51:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

adds x-eos-hash header to eos.img response

Browse Source
This commit is contained in:
Keagan McClelland
2021-11-23 13:36:00 -07:00
parent adcf7ca3cc
commit e6009e9658
3 changed files with 42 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
package.yaml
View File

@@ -22,6 +22,8 @@ dependencies:
- can-i-haz - can-i-haz
- conduit - conduit
- conduit-extra - conduit-extra
- cryptonite
- cryptonite-conduit
- data-default - data-default
- directory - directory
- errors - errors
@@ -36,6 +38,7 @@ dependencies:
- http-types - http-types
- interpolate - interpolate
- lens - lens
- memory
- monad-logger - monad-logger
- monad-logger-extras - monad-logger-extras
- parallel - parallel

41
src/Handler/Marketplace.hs
View File

@@ -11,6 +11,7 @@ module Handler.Marketplace where
import Startlude hiding ( Any import Startlude hiding ( Any
, Handler , Handler
, ask , ask
, concurrently
, from , from
, on , on
, sortOn , sortOn
@@ -32,6 +33,8 @@ import Control.Monad.Reader.Has ( Has
import Control.Parallel.Strategies ( parMap import Control.Parallel.Strategies ( parMap
, rpar , rpar
) )
import Crypto.Hash ( SHA256 )
import Crypto.Hash.Conduit ( hashFile )
import Data.Aeson ( (.:) import Data.Aeson ( (.:)
, FromJSON(parseJSON) , FromJSON(parseJSON)
, KeyValue((.=)) , KeyValue((.=))
@@ -44,6 +47,9 @@ import Data.Aeson ( (.:)
, withObject , withObject
) )
import qualified Data.Attoparsec.Text as Atto import qualified Data.Attoparsec.Text as Atto
import Data.ByteArray.Encoding ( Base(Base16)
, convertToBase
)
import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as BS
import qualified Data.Conduit.List as CL import qualified Data.Conduit.List as CL
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
@@ -80,6 +86,9 @@ import Database.Marketplace ( filterOsCompatible
, zipVersions , zipVersions
) )
import qualified Database.Persist as P import qualified Database.Persist as P
import Database.Persist ( PersistUniqueRead(getBy)
, insertUnique
)
import Foundation ( Handler import Foundation ( Handler
, RegistryCtx(appSettings) , RegistryCtx(appSettings)
) )
@@ -101,10 +110,12 @@ import Lib.Types.Emver ( (<||)
) )
import Model ( Category(..) import Model ( Category(..)
, EntityField(..) , EntityField(..)
, EosHash(EosHash, eosHashHash)
, Key(PkgRecordKey, unPkgRecordKey) , Key(PkgRecordKey, unPkgRecordKey)
, OsVersion(..) , OsVersion(..)
, PkgCategory , PkgCategory
, PkgRecord(..) , PkgRecord(..)
, Unique(UniqueVersion)
, VersionRecord(..) , VersionRecord(..)
) )
import Network.HTTP.Types ( status400 import Network.HTTP.Types ( status400
@@ -114,7 +125,9 @@ import Protolude.Unsafe ( unsafeFromJust )
import Settings ( AppSettings(registryHostname, resourcesDir) ) import Settings ( AppSettings(registryHostname, resourcesDir) )
import System.Directory ( getFileSize ) import System.Directory ( getFileSize )
import System.FilePath ( (</>) ) import System.FilePath ( (</>) )
import UnliftIO.Async ( mapConcurrently ) import UnliftIO.Async ( concurrently
, mapConcurrently
)
import UnliftIO.Directory ( listDirectory ) import UnliftIO.Directory ( listDirectory )
import Util.Shared ( getVersionSpecFromQuery ) import Util.Shared ( getVersionSpecFromQuery )
import Yesod.Core ( MonadResource import Yesod.Core ( MonadResource
@@ -132,6 +145,7 @@ import Yesod.Core ( MonadResource
, sendResponseStatus , sendResponseStatus
, typeOctet , typeOctet
) )
import Yesod.Persist ( YesodDB )
import Yesod.Persist.Core ( YesodPersist(runDB) ) import Yesod.Persist.Core ( YesodPersist(runDB) )
type URL = Text type URL = Text
@@ -273,13 +287,26 @@ getEosR = do
subdirs <- listDirectory root subdirs <- listDirectory root
let (failures, successes) = partitionEithers $ (Atto.parseOnly parseVersion . T.pack) <$> subdirs let (failures, successes) = partitionEithers $ (Atto.parseOnly parseVersion . T.pack) <$> subdirs
for_ failures $ \f -> $logWarn [i|Emver Parse Failure for EOS: #{f}|] for_ failures $ \f -> $logWarn [i|Emver Parse Failure for EOS: #{f}|]
let res = headMay . sortOn Down . filter (`satisfies` spec) $ successes let mVersion = headMay . sortOn Down . filter (`satisfies` spec) $ successes
case res of case mVersion of
Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|]) Nothing -> sendResponseStatus status404 (NotFoundE [i|EOS version satisfying #{spec}|])
Just r -> do Just version -> do
let imgPath = root </> show r </> "eos.img" let imgPath = root </> show version </> "eos.img"
liftIO (getFileSize imgPath) >>= addHeader "Content-Length" . show (sz, h) <- runDB $ concurrently (liftIO $ getFileSize imgPath) (retrieveHash version imgPath)
addHeader "Content-Length" $ show sz
addHeader "x-eos-hash" h
respondSource typeOctet (sourceFile imgPath .| awaitForever sendChunkBS) respondSource typeOctet (sourceFile imgPath .| awaitForever sendChunkBS)
where
retrieveHash :: Version -> FilePath -> YesodDB RegistryCtx Text
retrieveHash v fp = do
mHash <- getBy (UniqueVersion v)
case mHash of
Just h -> pure . eosHashHash . entityVal $ h
Nothing -> do
h <- hashFile @_ @SHA256 fp
let t = decodeUtf8 $ convertToBase Base16 h
void $ insertUnique (EosHash v t) -- lazily populate
pure t
getVersionLatestR :: Handler VersionLatestRes getVersionLatestR :: Handler VersionLatestRes
getVersionLatestR = do getVersionLatestR = do

5
src/Model.hs
View File

@@ -74,4 +74,9 @@ PkgCategory
categoryId CategoryId categoryId CategoryId
deriving Eq deriving Eq
deriving Show deriving Show
EosHash
version Version
hash Text
UniqueVersion version
|] |]