Skip to content

Commit c62e7ea

Browse files
sevanspowellsevanspowell
committed
Use file-based store instead of Postgres DB
- Store metadata in the file system instead of a Postgres DB. PR #24 demonstrates that a large user of memory is the Postgres store, specifically building the query for large batch-style requrests. This could be investigated further, but a quick fix is simply to use a file-based store. There is no need to build a query, and files can be looked up quickly using their filename.
1 parent a1cf50c commit c62e7ea

File tree

15 files changed

+520
-74
lines changed

15 files changed

+520
-74
lines changed

‎cabal-nix.project

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ packages:
22
./metadata-lib
33
./metadata-server
44
./metadata-store-postgres
5+
./metadata-store-file
56
./metadata-webhook
67
./metadata-validator-github
78
./token-metadata-creator

‎cabal.project

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ packages:
55
./metadata-server
66
./metadata-webhook
77
./metadata-store-postgres
8+
./metadata-store-file
89
./metadata-validator-github
910
./token-metadata-creator
1011

‎metadata-lib/src/Test/Cardano/Metadata/Generators.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -75,7 +75,7 @@ complexType =
7575
<*> Gen.map (Range.linear 0 20) ((,) <$> key <*> val)
7676

7777
complexKey :: MonadGen m => m ComplexKey
78-
complexKey = unSubject <$> subject
78+
complexKey = Gen.text (Range.linear 1 255) Gen.alphaNum
7979

8080
complexKeyVals :: MonadGen m => m [(ComplexKey, ComplexType)]
8181
complexKeyVals = Gen.list (Range.linear 0 20) ((,) <$> complexKey <*> complexType)

‎metadata-server/metadata-server.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ executable metadata-server
1919
, lens
2020
, lens-aeson
2121
, metadata-lib
22-
, metadata-store-postgres
22+
, metadata-store-file
2323
, monad-logger
2424
, mtl
2525
, persistent-postgresql

‎metadata-server/src/Config.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ module Config where
22

33
import Options.Applicative
44

5-
import Cardano.Metadata.Store.Postgres.Config
5+
import Cardano.Metadata.Store.File.Config
66
( Opts, parseOpts )
77

88
opts :: ParserInfo Opts

‎metadata-server/src/Main.hs

Lines changed: 8 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -21,25 +21,19 @@ import qualified Options.Applicative as Opt
2121

2222
import Cardano.Metadata.Server
2323
( webApp )
24-
import qualified Cardano.Metadata.Store.Postgres as Store
25-
import Cardano.Metadata.Store.Postgres.Config
26-
( Opts (..), pgConnectionString )
24+
import qualified Cardano.Metadata.Store.File as Store
25+
import Cardano.Metadata.Store.File.Config
26+
( Opts (..) )
2727
import Config
2828
( opts )
2929

3030
main :: IO ()
3131
main = do
32-
options@(Opts { optDbConnections = numDbConns
33-
, optDbMetadataTableName = tableName
32+
options@(Opts { optMetadataLocation = folder
3433
, optServerPort = port
3534
}) <- Opt.execParser opts
3635

37-
let pgConnString = pgConnectionString options
38-
putStrLn $ "Connecting to database using connection string: " <> BC.unpack pgConnString
39-
runStdoutLoggingT $
40-
Postgresql.withPostgresqlPool pgConnString numDbConns $ \pool -> liftIO $ do
41-
putStrLn $ "Initializing table '" <> tableName <> "'."
42-
intf <- Store.postgresStore pool (T.pack tableName)
43-
44-
putStrLn $ "Metadata server is starting on port " <> show port <> "."
45-
liftIO $ Warp.run port (webApp intf)
36+
putStrLn $ "Using file store at: " <> folder
37+
intf <- Store.fileStore folder
38+
putStrLn $ "Metadata server is starting on port " <> show port <> "."
39+
liftIO $ Warp.run port (webApp intf)

‎metadata-store-file/metadata-store-file.cabal

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
cabal-version: >=1.10
2+
name: metadata-store-file
3+
version: 0.1.0.0
4+
author: Samuel Evans-Powell
5+
maintainer: mail@sevanspowell.net
6+
build-type: Simple
7+
extra-source-files: CHANGELOG
8+
9+
library
10+
hs-source-dirs: src
11+
12+
exposed-modules: Cardano.Metadata.Store.File
13+
Cardano.Metadata.Store.File.Config
14+
15+
build-depends: aeson
16+
, base
17+
, bytestring
18+
, casing
19+
, containers
20+
, directory
21+
, esqueleto
22+
, github-webhooks
23+
, lens
24+
, lens-aeson
25+
, metadata-lib
26+
, monad-logger
27+
, mtl
28+
, filepath
29+
, cardano-prelude
30+
, optparse-applicative
31+
, persistent
32+
, persistent-postgresql
33+
, persistent-template
34+
, resource-pool
35+
, safe-exceptions
36+
, scientific
37+
, servant
38+
, servant-server
39+
, text
40+
, unordered-containers
41+
, wai
42+
, warp
43+
44+
ghc-options: -Wall
45+
-Wincomplete-record-updates
46+
-Wincomplete-uni-patterns
47+
-Wincomplete-patterns
48+
-Wredundant-constraints
49+
-Wpartial-fields
50+
-Wcompat
51+
-rtsopts
52+
53+
test-suite integration-tests
54+
hs-source-dirs: test
55+
main-is: Main.hs
56+
type: exitcode-stdio-1.0
57+
58+
build-depends: base >=4.12 && <5
59+
, HUnit
60+
, QuickCheck
61+
, aeson
62+
, aeson-pretty
63+
, base
64+
, bytestring
65+
, casing
66+
, containers
67+
, directory
68+
, esqueleto
69+
, github-webhooks
70+
, hedgehog
71+
, hspec
72+
, http-client
73+
, lens
74+
, lens-aeson
75+
, metadata-lib
76+
, metadata-store-file
77+
, monad-logger
78+
, persistent-postgresql
79+
, mtl
80+
, raw-strings-qq
81+
, resource-pool
82+
, safe-exceptions
83+
, scientific
84+
, servant
85+
, servant-client
86+
, servant-server
87+
, smallcheck
88+
, tagged
89+
, tasty
90+
, tasty-hedgehog
91+
, tasty-hspec
92+
, tasty-hunit
93+
, tasty-quickcheck
94+
, text
95+
, unordered-containers
96+
, wai
97+
, warp
98+
99+
ghc-options: -Wall
100+
-Wincomplete-record-updates
101+
-Wincomplete-uni-patterns
102+
-Wincomplete-patterns
103+
-Wredundant-constraints
104+
-Wpartial-fields
105+
-Wcompat

‎metadata-store-file/src/Cardano/Metadata/Store/File.hs

Lines changed: 178 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,178 @@
1+
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE GADTs #-}
5+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+
{-# LANGUAGE IncoherentInstances #-}
7+
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE QuasiQuotes #-}
10+
{-# LANGUAGE RecordWildCards #-}
11+
{-# LANGUAGE ScopedTypeVariables #-}
12+
{-# LANGUAGE TemplateHaskell #-}
13+
{-# LANGUAGE TupleSections #-}
14+
{-# LANGUAGE TypeFamilies #-}
15+
16+
module Cardano.Metadata.Store.File
17+
( read
18+
, write
19+
, update
20+
, delete
21+
, empty
22+
, toList
23+
, init
24+
, fileStore
25+
) where
26+
27+
import Cardano.Metadata.Store.Types
28+
import Control.Exception.Safe
29+
import Control.Monad.Reader
30+
import Data.Aeson
31+
( FromJSON, FromJSONKey, ToJSON, ToJSONKey )
32+
import qualified Data.Aeson as Aeson
33+
import qualified Data.Aeson.Encoding.Internal as Aeson
34+
import qualified Data.Aeson.Types as Aeson
35+
import qualified Data.ByteString.Lazy.Char8 as BSLC8
36+
import Data.Coerce
37+
( coerce )
38+
import qualified Data.Map.Strict as M
39+
import Data.Maybe
40+
( catMaybes, fromMaybe )
41+
import Data.Pool
42+
import Data.Text
43+
( Text )
44+
import Data.Text
45+
( Text )
46+
import qualified Data.Text as T
47+
import qualified Data.Text.Lazy as TL
48+
import qualified Data.Text.Lazy.Encoding as TLE
49+
import Data.Traversable
50+
( for )
51+
import Database.Persist hiding
52+
( delete, update )
53+
import Database.Persist.Sql
54+
( ConnectionPool, Single (Single), SqlBackend )
55+
import qualified Database.Persist.Sql as Sql
56+
import Prelude hiding
57+
( init, read )
58+
import System.Directory
59+
import System.FilePath.Posix
60+
( takeFileName )
61+
62+
data PostgresKeyValueException = UniqueKeyConstraintViolated
63+
| FailedToDecodeJSONValue String Text
64+
deriving (Eq, Show, Exception)
65+
66+
data KeyValue k v = KeyValue { _kvFolder :: FilePath }
67+
68+
init
69+
:: FilePath
70+
-- ^ Folder containing metadata entries
71+
-> IO (KeyValue k v)
72+
-- ^ Resulting key-value store
73+
init = pure . KeyValue
74+
75+
fileStore
76+
:: ( ToJSONKey k
77+
, ToJSON v
78+
, FromJSONKey k
79+
, FromJSON v
80+
)
81+
=> FilePath
82+
-- ^ Folder containing metadata entries
83+
-> IO (StoreInterface k v)
84+
fileStore folder = do
85+
let kvs = KeyValue folder
86+
pure $ StoreInterface (\k -> read k kvs)
87+
(\ks -> readBatch ks kvs)
88+
(\k v -> write k v kvs)
89+
(\k -> delete k kvs)
90+
(\f k -> update f k kvs)
91+
(toList kvs)
92+
(empty kvs)
93+
94+
-- | Ensure file path is within folder.
95+
safeFilePath :: ToJSONKey k => KeyValue k v -> k -> FilePath
96+
safeFilePath (KeyValue folder) k =
97+
let
98+
-- Disallow user to enter a sub-directory or a parent directory by
99+
-- limiting the requested path to a file name. I.e. "../x.txt" and
100+
-- "inner/x.txt" are normalised to "x.txt" to restrict the user
101+
-- from looking outside the specified folder.
102+
raw :: FilePath
103+
raw = takeFileName . T.unpack $ toJSONKeyText k
104+
in
105+
folder <> "/" <> raw
106+
107+
withFileIfExists :: ToJSONKey k => KeyValue k v -> k -> (FilePath -> IO r) -> IO (Maybe r)
108+
withFileIfExists kvs k f = do
109+
let safe = safeFilePath kvs k
110+
exists <- doesFileExist safe
111+
if exists
112+
then do
113+
r <- f safe
114+
pure $ Just r
115+
else pure Nothing
116+
117+
read :: (ToJSONKey k, FromJSON v) => k -> KeyValue k v -> IO (Maybe v)
118+
read k kvs = do
119+
withFileIfExists kvs k $ \safe ->
120+
Aeson.eitherDecodeFileStrict' safe
121+
>>= (\v -> handleJSONDecodeError "Y" v)
122+
123+
readBatch :: (ToJSONKey k, FromJSON v) => [k] -> KeyValue k v -> IO [v]
124+
readBatch [] _kvs = pure []
125+
readBatch ks kvs = fmap catMaybes $ forM ks (\k -> read k kvs)
126+
127+
write :: (ToJSONKey k, ToJSON v) => k -> v -> KeyValue k v -> IO ()
128+
write k v kvs =
129+
let
130+
safe = safeFilePath kvs k
131+
in
132+
Aeson.encodeFile safe v
133+
134+
delete :: ToJSONKey k => k -> KeyValue k v -> IO ()
135+
delete k kvs =
136+
fromMaybe () <$> withFileIfExists kvs k removeFile
137+
138+
update :: (ToJSONKey k, ToJSON v, FromJSON v) => (v -> Maybe v) -> k -> KeyValue k v -> IO ()
139+
update fv k kvs = do
140+
mv <- read k kvs
141+
case mv of
142+
Nothing -> pure ()
143+
Just v -> case fv v of
144+
Nothing -> delete k kvs
145+
Just newValue -> write k newValue kvs
146+
147+
toList :: (ToJSONKey k, FromJSONKey k, FromJSON v) => KeyValue k v -> IO [(k, v)]
148+
toList kvs@(KeyValue folder) = do
149+
ks <- fmap (fmap T.pack) $ listDirectory folder
150+
forM ks $ \kText -> do
151+
k <- handleJSONDecodeError "X" $ decodeJSONKey kText
152+
mV <- read k kvs
153+
pure $ maybe (error $ "Unable to find file with name '" <> (T.unpack $ toJSONKeyText k) <> "'") (k,) mV
154+
155+
empty :: (FromJSONKey k, ToJSONKey k) => KeyValue k v -> IO ()
156+
empty kvs@(KeyValue folder) = do
157+
ks <- fmap (fmap T.pack) $ listDirectory folder
158+
void . forM ks $ \kText -> do
159+
k <- handleJSONDecodeError undefined $ decodeJSONKey kText
160+
delete k kvs
161+
162+
handleJSONDecodeError :: Text -> Either String a -> IO a
163+
handleJSONDecodeError t = either (\err -> throw $ FailedToDecodeJSONValue err t) pure
164+
165+
toJSONKeyText :: ToJSONKey k => k -> Text
166+
toJSONKeyText k =
167+
case Aeson.toJSONKey of
168+
Aeson.ToJSONKeyText f _ -> f k
169+
Aeson.ToJSONKeyValue _ f -> TL.toStrict $ TLE.decodeUtf8 $ Aeson.encodingToLazyByteString $ f k
170+
171+
decodeJSONKey :: FromJSONKey k => Text -> Either String k
172+
decodeJSONKey t = case Aeson.fromJSONKey of
173+
Aeson.FromJSONKeyCoerce -> pure $ coerce t
174+
Aeson.FromJSONKeyText f -> pure $ f t
175+
Aeson.FromJSONKeyTextParser p -> Aeson.parseEither p t
176+
Aeson.FromJSONKeyValue pv -> do
177+
(v :: Aeson.Value) <- Aeson.eitherDecode (TLE.encodeUtf8 . TL.fromStrict $ t)
178+
Aeson.parseEither pv v

‎metadata-store-file/src/Cardano/Metadata/Store/File/Config.hs

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
module Cardano.Metadata.Store.File.Config where
2+
3+
import qualified Data.ByteString.Char8 as BC
4+
import Database.Persist.Postgresql
5+
( ConnectionString )
6+
import qualified Network.Wai.Handler.Warp as Warp
7+
import Options.Applicative
8+
9+
data Opts = Opts
10+
{ optMetadataLocation :: FilePath
11+
, optServerPort :: Warp.Port
12+
}
13+
deriving (Eq, Show)
14+
15+
parseOpts :: Parser Opts
16+
parseOpts = Opts
17+
<$> strOption (long "folder" <> metavar "FOLDER" <> help "Folder containing the metadata entries")
18+
<*> option auto (short 'p' <> long "port" <> metavar "PORT" <> showDefault <> value 8080 <> help "Port to run the metadata web server on")

0 commit comments

Comments
 (0)