Skip to content

Commit cc4ab92

Browse files
sevanspowellsevanspowell
authored
Merge pull request #28 from input-output-hk/feature/ADP-895-fix-desync
Fix metadata desynchronization
2 parents 9b967e8 + c8d7bbc commit cc4ab92

File tree

17 files changed

+760
-2
lines changed

17 files changed

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

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

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

‎metadata-sync/src/Main.hs‎

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

0 commit comments

Comments
 (0)