Skip to content

Commit 80ab948

Browse files
sevanspowellsevanspowell
committed
Fix issues with desync between metadata-server and GitHub repository
- Adds a script that queries the GH repository and sets the state of metadata database to match. - Add NixOS service. - Add integration tests that check that the write part of the script writes correctly, and doesn't touch the database at all if an exception occurs.
1 parent a0d773d commit 80ab948

File tree

15 files changed

+709
-2
lines changed

15 files changed

+709
-2
lines changed

‎cabal-nix.project‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,5 +5,6 @@ packages:
55
./metadata-webhook
66
./metadata-validator-github
77
./token-metadata-creator
8+
./metadata-sync
89
tests: True
910
benchmarks: True

‎cabal.project‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ packages:
77
./metadata-store-postgres
88
./metadata-validator-github
99
./token-metadata-creator
10+
./metadata-sync
1011

1112
package metadata-lib
1213
tests: True
@@ -26,6 +27,9 @@ package metadata-validator-github
2627
package token-metadata-creator
2728
tests: True
2829

30+
package metadata-sync
31+
tests: True
32+
2933
-- ---------------------------------------------------------
3034
-- Disable all tests belonging to dependencies
3135

‎default.nix‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ let
9292
inherit (project.hsPkgs.metadata-server.identifier) version;
9393
inherit (project.hsPkgs.metadata-server.components.exes) metadata-server;
9494
inherit (project.hsPkgs.metadata-webhook.components.exes) metadata-webhook;
95+
inherit (project.hsPkgs.metadata-sync.components.exes) metadata-sync;
9596
inherit (project.hsPkgs.metadata-validator-github.components.exes) metadata-validator-github;
9697
inherit (project.hsPkgs.token-metadata-creator.components.exes) token-metadata-creator;
9798
inherit (project) metadata-validator-github-tarball token-metadata-creator-tarball;

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -246,12 +246,12 @@ validationMetadata' = do
246246
validationMetadataSignedWith skey subj
247247

248248
propertyName :: MonadGen m => m PropertyName
249-
propertyName = PropertyName <$> Gen.text (Range.linear 1 64) Gen.unicodeAll
249+
propertyName = PropertyName <$> Gen.text (Range.linear 1 64) Gen.unicode
250250

251251
propertyValue :: MonadGen m => m Aeson.Value
252252
propertyValue =
253253
Gen.recursive Gen.choice
254-
[ Aeson.String <$> Gen.text (Range.linear 1 64) Gen.unicodeAll
254+
[ Aeson.String <$> Gen.text (Range.linear 1 64) Gen.unicode
255255
, Aeson.Number <$> fromIntegral <$> Gen.word8 Range.constantBounded
256256
, Aeson.Bool <$> Gen.bool
257257
, pure $ Aeson.Null

‎metadata-sync/metadata-sync.cabal‎

Lines changed: 140 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,140 @@
1+
cabal-version: >=1.10
2+
name: metadata-sync
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.Sync
13+
Cardano.Metadata.Sync.Config
14+
15+
build-depends: aeson
16+
, base
17+
, bytestring
18+
, casing
19+
, containers
20+
, directory
21+
, filepath
22+
, postgresql-simple
23+
, lens
24+
, lens-aeson
25+
, metadata-lib
26+
, monad-logger
27+
, mtl
28+
, optparse-applicative
29+
, persistent
30+
, persistent-postgresql
31+
, persistent-template
32+
, resource-pool
33+
, safe-exceptions
34+
, scientific
35+
, servant
36+
, servant-server
37+
, temporary
38+
, text
39+
, time
40+
, turtle
41+
, unordered-containers
42+
, wai
43+
, warp
44+
45+
ghc-options: -Wall
46+
-Wincomplete-record-updates
47+
-Wincomplete-uni-patterns
48+
-Wincomplete-patterns
49+
-Wredundant-constraints
50+
-Wpartial-fields
51+
-Wcompat
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+
, hedgehog
69+
, hspec
70+
, http-client
71+
, lens
72+
, lens-aeson
73+
, metadata-lib
74+
, metadata-sync
75+
, monad-logger
76+
, postgresql-simple
77+
, mtl
78+
, raw-strings-qq
79+
, resource-pool
80+
, safe-exceptions
81+
, scientific
82+
, servant
83+
, servant-client
84+
, servant-server
85+
, smallcheck
86+
, tagged
87+
, tasty
88+
, tasty-hedgehog
89+
, tasty-hspec
90+
, tasty-hunit
91+
, tasty-quickcheck
92+
, text
93+
, unordered-containers
94+
, wai
95+
, warp
96+
97+
ghc-options: -Wall
98+
-Wincomplete-record-updates
99+
-Wincomplete-uni-patterns
100+
-Wincomplete-patterns
101+
-Wredundant-constraints
102+
-Wpartial-fields
103+
-Wcompat
104+
105+
executable metadata-sync
106+
hs-source-dirs: src
107+
main-is: Main.hs
108+
build-depends: base
109+
, aeson
110+
, bytestring
111+
, containers
112+
, directory
113+
, filepath
114+
, lens
115+
, metadata-lib
116+
, metadata-sync
117+
, monad-logger
118+
, mtl
119+
, optparse-applicative
120+
, persistent
121+
, postgresql-simple
122+
, resource-pool
123+
, safe-exceptions
124+
, scientific
125+
, servant
126+
, temporary
127+
, text
128+
, time
129+
, turtle
130+
, warp
131+
132+
ghc-options: -Wall
133+
-Wcompat
134+
-fwarn-redundant-constraints
135+
-fwarn-incomplete-patterns
136+
-fwarn-unused-imports
137+
-Wincomplete-record-updates
138+
-Wincomplete-uni-patterns
139+
-Wno-unsafe
140+
-threaded

‎metadata-sync/src/Cardano/Metadata/Sync.hs‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Cardano.Metadata.Sync where
4+
5+
import qualified Data.Aeson as Aeson
6+
import Data.Text (Text)
7+
import qualified Data.Text as T
8+
import qualified Turtle.Prelude as Turtle
9+
import System.Directory (listDirectory)
10+
import System.FilePath.Posix (takeBaseName)
11+
import Data.String (fromString)
12+
import System.IO.Temp (withSystemTempDirectory)
13+
import Database.PostgreSQL.Simple (withTransaction, execute, executeMany, Connection)
14+
import Database.PostgreSQL.Simple.Types (Identifier(..), Only(..), In(..))
15+
import Data.Traversable (forM)
16+
import Data.Functor (void)
17+
18+
import Cardano.Metadata.Sync.Config (withConnectionFromPool)
19+
import Cardano.Metadata.Types.Common (Subject(..))
20+
21+
-- | View the current state of the registry (source-of-truth).
22+
view :: Text -> Text -> IO [(Subject, Aeson.Value)]
23+
view gitURL gitSubFolder = do
24+
withSystemTempDirectory "metadata-sync" $ \dir -> do
25+
26+
gitURL `cloneTo` dir
27+
28+
let dataDir = dir <> "/" <> T.unpack gitSubFolder
29+
ks <- listDirectory dataDir
30+
flip foldMap ks $ \k -> do
31+
mV <- Aeson.decodeFileStrict' (dataDir <> "/" <> k)
32+
case mV of
33+
Nothing -> pure []
34+
Just v -> pure [(Subject $ T.pack $ takeBaseName k, v)]
35+
36+
where
37+
emptyDirectory dir = Turtle.procs "rm" ["-r", T.pack dir <> "/*"] mempty
38+
cloneTo gitUrl dir = Turtle.procs "git" ["clone", gitUrl, T.pack dir] mempty
39+
40+
-- | Write out a new state to our local copy of the registry.
41+
write :: Connection -> Text -> [(Subject, Aeson.Value)] -> IO ()
42+
write conn tableName kvs =
43+
withTransaction conn $ do
44+
let table = Identifier tableName
45+
46+
void $ execute conn "TRUNCATE ?" (Only table)
47+
48+
let dat = fmap (\(Subject k, v) -> (k, v)) kvs
49+
50+
void $ executeMany conn ("INSERT INTO " <> fromString (T.unpack tableName) <> " VALUES (?,?)") dat

‎metadata-sync/src/Cardano/Metadata/Sync/Config.hs‎

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Cardano.Metadata.Sync.Config where
4+
5+
import Data.Text (Text)
6+
import qualified Data.Text as T
7+
import qualified Data.Text.Encoding as TE
8+
import Options.Applicative (Parser, ParserInfo)
9+
import qualified Options.Applicative as Opt
10+
import Options.Applicative (strOption, long, metavar, help, showDefault, value, option, auto, info, fullDesc, progDesc, header)
11+
import Data.Pool (Pool, createPool, destroyAllResources)
12+
import Database.PostgreSQL.Simple (Connection)
13+
import Data.Time.Clock (NominalDiffTime)
14+
import qualified Database.PostgreSQL.Simple as Sql
15+
import qualified Data.Pool as Pool
16+
import qualified Data.ByteString.Char8 as BC
17+
import Control.Exception (bracket)
18+
19+
data Opts = Opts
20+
{ optDbName :: Text
21+
, optDbUser :: Text
22+
, optDbHost :: FilePath
23+
, optDbMetadataTableName :: Text
24+
, optDbConnections :: Int
25+
, optGitURL :: Text
26+
, optGitSubFolder :: Text
27+
}
28+
deriving (Eq, Show)
29+
30+
parseOpts :: Parser Opts
31+
parseOpts = Opts
32+
<$> strOption (long "db" <> metavar "DB_NAME" <> help "Name of the database to store and read metadata from")
33+
<*> strOption (long "db-user" <> metavar "DB_USER" <> help "User to connect to metadata database with")
34+
<*> strOption (long "db-host" <> metavar "DB_HOST" <> showDefault <> value "/run/postgresql" <> help "Host for the metadata database connection")
35+
<*> strOption (long "db-table" <> metavar "DB_TABLE" <> showDefault <> value "metadata" <> help "Table in the database to store metadata")
36+
<*> option auto (long "db-conns" <> metavar "INT" <> showDefault <> value 1 <> help "Number of connections to open to the database")
37+
<*> strOption (long "git-url" <> metavar "GIT_URL" <> help "URL of the metadata registry git repository")
38+
<*> strOption (long "git-metadata-folder" <> metavar "GIT_METADATA_FOLDER" <> help "Sub-folder of the git repository containing the metadata")
39+
40+
opts :: ParserInfo Opts
41+
opts =
42+
info
43+
parseOpts
44+
( fullDesc
45+
<> progDesc "Sync up a metadata database with a GitHub repository"
46+
<> header "metadata-sync - a tool to keep the metadata storage layer and the GitHub repository in sync"
47+
)
48+
49+
pgConnectionString :: Opts -> BC.ByteString
50+
pgConnectionString (Opts { optDbName = dbName, optDbUser = dbUser, optDbHost = dbHost }) =
51+
TE.encodeUtf8 $ "host=" <> T.pack dbHost <> " dbname=" <> dbName <> " user=" <> dbUser
52+
53+
mkConnectionPool
54+
:: BC.ByteString
55+
-- ^ Libpq connection string
56+
-> Int
57+
-- ^ Maximum number of postgresql connections to allow
58+
-> IO (Pool Connection)
59+
mkConnectionPool connectionStr numConns =
60+
createPool
61+
(Sql.connectPostgreSQL connectionStr)
62+
Sql.close
63+
1 -- Number of sub-pools
64+
(10 :: NominalDiffTime) -- Amount of time for which an unused connection is kept open
65+
numConns
66+
67+
withConnectionPool
68+
:: BC.ByteString
69+
-- ^ Libpq connection string
70+
-> Int
71+
-- ^ Maximum number of postgresql connections to allow
72+
-> (Pool Connection -> IO r)
73+
-> IO r
74+
withConnectionPool connectionInfo numConns f = bracket
75+
(mkConnectionPool connectionInfo numConns)
76+
destroyAllResources
77+
f
78+
79+
withConnectionFromPool :: Pool Connection -> (Connection -> IO b) -> IO b
80+
withConnectionFromPool pool action = Pool.withResource pool $ action

‎metadata-sync/src/Main.hs‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
module Main where
2+
3+
import Control.Monad.IO.Class
4+
( liftIO )
5+
import qualified Data.ByteString.Char8 as BC
6+
import qualified Data.Text as T
7+
import qualified Network.Wai.Handler.Warp as Warp
8+
import qualified Options.Applicative as Opt
9+
import Control.Exception (bracket)
10+
import Database.PostgreSQL.Simple (Connection, connectPostgreSQL, close)
11+
import Data.Pool (Pool, createPool, destroyAllResources)
12+
import Data.Time.Clock (NominalDiffTime)
13+
14+
import qualified Cardano.Metadata.Sync as Sync
15+
import Cardano.Metadata.Sync.Config
16+
( Opts (..), pgConnectionString, parseOpts, withConnectionPool, withConnectionFromPool, opts)
17+
18+
main :: IO ()
19+
main = do
20+
options@(Opts { optDbConnections = numDbConns
21+
, optDbMetadataTableName = tableName
22+
, optGitURL = gitURL
23+
, optGitSubFolder = gitSubFolder
24+
}) <- Opt.execParser opts
25+
26+
let pgConnString = pgConnectionString options
27+
putStrLn $ "Connecting to database using connection string: " <> BC.unpack pgConnString
28+
withConnectionPool pgConnString numDbConns $ \pool -> do
29+
withConnectionFromPool pool $ \conn -> do
30+
putStrLn $ "Reading registry state from '" <> T.unpack gitURL <> "'."
31+
state <- Sync.view gitURL gitSubFolder
32+
33+
putStrLn $ "Syncing to table '" <> T.unpack tableName <> "'."
34+
Sync.write conn tableName state

0 commit comments

Comments
 (0)