Skip to content

Commit fadec9f

Browse files
jasagredojasagredo
committed
Improve pull-cddls
1 parent 263b405 commit fadec9f

File tree

3 files changed

+201
-39
lines changed

3 files changed

+201
-39
lines changed

‎cabal.project

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ if impl (ghc >= 9.12)
6161
source-repository-package
6262
type: git
6363
location: https://github.com/IntersectMBO/cardano-ledger
64-
tag: 0540540858ced73be648669182729a59e4d9bb1b
64+
tag: d48965e0dc1a324f432f1ee01bc0cf2d60a8a702
6565
subdir:
6666
eras/allegra/impl
6767
eras/alonzo/impl
@@ -87,3 +87,11 @@ source-repository-package
8787
eras/byron/ledger/executable-spec
8888
eras/byron/ledger/impl
8989
eras/byron/crypto
90+
91+
allow-newer:
92+
ouroboros-consensus:cardano-ledger-core,
93+
ouroboros-consensus-cardano:cardano-ledger-byron,
94+
ouroboros-consensus-cardano:cardano-ledger-conway,
95+
ouroboros-consensus-cardano:cardano-ledger-core,
96+
ouroboros-consensus-cardano:cardano-ledger-shelley,
97+
ouroboros-consensus-protocol:cardano-ledger-core,

‎ouroboros-consensus-cardano/cddl/pull-cddls.hs

Lines changed: 183 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,50 +1,201 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
{-# LANGUAGE CPP #-}
13
-- |
24

35
module Main (main) where
46

7+
import qualified Control.Monad as Monad
58
import qualified Data.ByteString.Lazy as BL
69
import qualified Data.ByteString.Lazy.UTF8 as BL8
10+
import Data.Maybe (isNothing)
11+
import qualified Data.List as L
12+
import Paths_ouroboros_consensus_cardano
13+
import qualified System.Directory as D
14+
import qualified System.Environment as E
15+
import System.Exit (exitFailure)
16+
import qualified System.FilePath as F
17+
import qualified System.Process.ByteString.Lazy as P
18+
import qualified Test.Cardano.Chain.Binary.Cddl as Byron
719
import qualified Test.Cardano.Ledger.Allegra.Binary.Cddl as Allegra
820
import qualified Test.Cardano.Ledger.Alonzo.Binary.Cddl as Alonzo
921
import qualified Test.Cardano.Ledger.Babbage.Binary.Cddl as Babbage
10-
import qualified Paths_cardano_ledger_byron as Byron
1122
import qualified Test.Cardano.Ledger.Conway.Binary.Cddl as Conway
1223
import qualified Test.Cardano.Ledger.Mary.Binary.Cddl as Mary
1324
import qualified Test.Cardano.Ledger.Shelley.Binary.Cddl as Shelley
14-
import qualified Data.List as L
15-
import qualified System.Process.ByteString.Lazy as P
16-
import qualified System.Environment as E
17-
import qualified System.FilePath as F
1825

1926
main :: IO ()
2027
main = do
21-
byron <- forwardize . (:[]) <$> Byron.getDataFileName "cddl-spec/byron.cddl"
22-
shelley <- forwardize <$> Shelley.readShelleyCddlFileNames
23-
allegra <- forwardize <$> Allegra.readAllegraCddlFileNames
24-
mary <- forwardize <$> Mary.readMaryCddlFileNames
25-
alonzo <- forwardize <$> Alonzo.readAlonzoCddlFileNames
26-
babbage <- forwardize <$> Babbage.readBabbageCddlFileNames
27-
conway <- forwardize <$> Conway.readConwayCddlFileNames
28-
29-
let include_path = mconcat $ L.intersperse ":" $ [byron, shelley, allegra, mary, alonzo, babbage, conway]
28+
probeTools
29+
setupEnv
30+
-- For now I just print this.
31+
print =<< getCDDLs
32+
33+
setupEnv :: IO ()
34+
setupEnv = do
35+
byron <- map takePath <$> Byron.readByronCddlFileNames
36+
shelley <- map takePath <$> Shelley.readShelleyCddlFileNames
37+
allegra <- map takePath <$> Allegra.readAllegraCddlFileNames
38+
mary <- map takePath <$> Mary.readMaryCddlFileNames
39+
alonzo <- map takePath <$> Alonzo.readAlonzoCddlFileNames
40+
babbage <- map takePath <$> Babbage.readBabbageCddlFileNames
41+
conway <- map takePath <$> Conway.readConwayCddlFileNames
42+
43+
localDataDir <- takePath <$> getDataDir
44+
let local_paths = map (localDataDir F.</>) [
45+
"cddl"
46+
, "cddl/disk"
47+
, "cddl/disk/snapshot"
48+
, "cddl/node-to-client/localstatequery/byron"
49+
, "cddl/node-to-client/localstatequery/consensus"
50+
, "cddl/node-to-client/localstatequery/shelley"
51+
, "cddl/node-to-client/txmonitor"
52+
]
53+
54+
include_path =
55+
mconcat
56+
$ L.intersperse ":"
57+
$ map (mconcat . L.intersperse ":") [byron, shelley, allegra, mary, alonzo, babbage, conway] <> local_paths
58+
3059
E.setEnv "CDDL_INCLUDE_PATH" (include_path <> ":")
3160

32-
putStrLn . BL8.toString =<< cddlc "ouroboros-consensus-cardano/cddl/disk/block.cddl"
61+
newtype CDDLSpec = CDDLSpec BL.ByteString deriving Show
62+
63+
data CDDLs = CDDLs {
64+
diskBlockCDDL :: CDDLSpec
65+
, diskSnapshotCDDL :: CDDLSpec
66+
67+
, ntnBlockFetchBlockCDDL :: CDDLSpec
68+
, ntnBlockFetchPointCDDL :: CDDLSpec
69+
70+
, ntnChainSyncHeaderCDDL :: CDDLSpec
71+
, ntnChainSyncPointCDDL :: CDDLSpec
72+
, ntnChainSyncTipCDDL :: CDDLSpec
73+
74+
, ntnTxSubmissionTicketNoCDDL :: CDDLSpec
75+
, ntnTxSubmissionTxCDDL :: CDDLSpec
76+
, ntnTxSubmissionTxIdCDDL :: CDDLSpec
77+
78+
, ntcLocalStateQueryQueryCDDL :: CDDLSpec
79+
, ntcLocalStateQueryResultCDDL :: CDDLSpec
80+
81+
, ntcTxMonitorTxCDDL :: CDDLSpec
82+
, ntcTxMonitorTxIdCDDL :: CDDLSpec
83+
, ntcTxMonitorSlotNoCDDL :: CDDLSpec
84+
} deriving Show
85+
86+
getCDDLs :: IO CDDLs
87+
getCDDLs = CDDLs
88+
-- Disk
89+
<$> cddlc "cddl/disk/block.cddl"
90+
<*> cddlc "cddl/disk/snapshot.cddl"
91+
92+
-- Node to node
93+
-- -- BlockFetch
94+
<*> cddlc "cddl/node-to-node/blockfetch/block.cddl"
95+
<*> cddlc "cddl/node-to-node/blockfetch/point.cddl"
96+
97+
-- -- ChainSync
98+
<*> cddlc "cddl/node-to-node/chainsync/header.cddl"
99+
<*> cddlc "cddl/node-to-node/chainsync/point.cddl"
100+
<*> cddlc "cddl/node-to-node/chainsync/tip.cddl"
101+
102+
-- -- TxSubmission2
103+
<*> cddlc "cddl/node-to-node/txsubmission2/ticketno.cddl"
104+
<*> cddlc "cddl/node-to-node/txsubmission2/tx.cddl"
105+
<*> cddlc "cddl/node-to-node/txsubmission2/txid.cddl"
106+
107+
-- Node to client
108+
-- -- LocalStateQuery
109+
<*> cddlc "cddl/node-to-client/localstatequery/query.cddl"
110+
<*> cddlc "cddl/node-to-client/localstatequery/result.cddl"
111+
112+
-- -- TxMonitor
113+
<*> cddlc "cddl/node-to-client/txmonitor/tx.cddl"
114+
<*> cddlc "cddl/node-to-client/txmonitor/txid.cddl"
115+
<*> cddlc "cddl/node-to-client/txmonitor/slotno.cddl"
116+
117+
cddlc :: FilePath -> IO CDDLSpec
118+
cddlc dataFile = do
119+
putStrLn $ "Generating: " <> dataFile
120+
path <- getDataFileName dataFile
121+
(_, cddl, err) <-
122+
#ifdef POSIX
123+
P.readProcessWithExitCode "cddlc" ["-u", "-2", "-t", "cddl", path] mempty
124+
#else
125+
-- we cannot call @cddlc@ directly because it is not an executable in
126+
-- Haskell eyes, but we can call @ruby@ and pass the @cddlc@ script path as
127+
-- an argument
128+
do
129+
prefix <- E.getEnv "MSYSTEM_PREFIX"
130+
P.readProcessWithExitCode "ruby" [prefix F.</> "bin/cddlc", "-u", "-2", "-t", "cddl", path] mempty
131+
#endif
132+
Monad.unless (BL.null err) $ red $ BL8.toString err
133+
return $ CDDLSpec cddl
33134
where
34-
forwardize [x] =
35-
let f = [ if c /= '\\' then c else '/' | c <- F.takeDirectory x ]
36-
in if "C:" `L.isPrefixOf` f
37-
then drop 2 f
38-
else f
39-
forwardize x = error $ "match: " <> show x
40-
41-
42-
-- | A 'CDDL' specifcation for a protocol 'ps'.
43-
--
44-
-- newtype CDDLSpec ps = CDDLSpec BL.ByteString
45-
46-
cddlc :: FilePath -> IO BL.ByteString
47-
cddlc path = do
48-
(_, cddl, err) <- P.readProcessWithExitCode "ruby" ["C:/msys64/clang64/bin/cddlc", "-u", "-2", "-t", "cddl", path] mempty
49-
putStrLn $ BL8.toString err
50-
return cddl
135+
red s = putStrLn $ "\ESC[31m" <> s <> "\ESC[0m"
136+
137+
takePath :: FilePath -> FilePath
138+
takePath x =
139+
#ifdef POSIX
140+
F.takeDirectory x
141+
#else
142+
-- @cddlc@ is not capable of using backlashes
143+
--
144+
-- @cddlc@ mixes @C:@ with the separator in @CDDL_INCLUDE_PATH@, and it
145+
-- doesn't understand @;@ as a separator. It works if we remove @C:@ and we
146+
-- are running in the same drive as the cddl files.
147+
let f = [ if c /= '\\' then c else '/' | c <- F.takeDirectory x ]
148+
in if "C:" `L.isPrefixOf` f
149+
then drop 2 f
150+
else f
151+
#endif
152+
153+
probeTools :: IO ()
154+
probeTools = do
155+
putStrLn "Probing tools:"
156+
#ifdef POSIX
157+
posixProbeTool "cddl" "install the `cddl` ruby gem"
158+
posixProbeTool "cddlc" "install the `cddlc` ruby gem"
159+
where
160+
posixProbeTool :: String -> Sring -> IO ()
161+
posixProbeTool tool suggestion = do
162+
putStr $ "- " <> tool <> " "
163+
exe <- D.findExecutable tool
164+
if isNothing exe
165+
then do
166+
putStrLn "not found!"
167+
putStrLn $ "Please " <> suggestion
168+
exitFailure
169+
else
170+
putStrLn "found"
171+
#else
172+
-- On Windows, the cddl and cddlc files are POSIX scripts and therefore not
173+
-- recognized as executables by @findExecutable@, so we need to do some dirty
174+
-- tricks here. We check that ruby executable exists and then that there are
175+
-- cddl and cddlc files in the binary folder of the MSYS2 installation.
176+
putStr "- ruby "
177+
rubyExe <- D.findExecutable "ruby"
178+
if (isNothing rubyExe)
179+
then do
180+
putStrLn "not found!\nPlease install ruby and the `cddl` and `cddlc` gems"
181+
exitFailure
182+
else
183+
putStrLn "found"
184+
185+
putStr "- cddl "
186+
cddlExe <- D.doesFileExist . (F.</> "bin/cddlc") =<< E.getEnv "MSYSTEM_PREFIX"
187+
if cddlExe
188+
then putStrLn "found"
189+
else do
190+
putStrLn "not found!\nPlease install the `cddl` ruby gem"
191+
exitFailure
192+
193+
putStr "- cddlc "
194+
cddlcExe <- D.doesFileExist . (F.</> "bin/cddlc") =<< E.getEnv "MSYSTEM_PREFIX"
195+
if cddlcExe
196+
then putStrLn "found"
197+
else do
198+
putStrLn "not found!\nPlease install the `cddlc` ruby gem"
199+
exitFailure
200+
pure ()
201+
#endif

‎ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,9 @@ extra-doc-files:
2323
CHANGELOG.md
2424
README.md
2525

26+
data-files:
27+
cddl/**.cddl
28+
2629
source-repository head
2730
type: git
2831
location: https://github.com/IntersectMBO/ouroboros-consensus
@@ -198,7 +201,7 @@ library unstable-byronspec
198201
byron-spec-ledger,
199202
cardano-binary,
200203
cardano-ledger-binary,
201-
cardano-ledger-byron-test,
204+
cardano-ledger-byron:testlib,
202205
cborg >=0.2.2 && <0.3,
203206
containers >=0.5 && <0.8,
204207
mtl,
@@ -235,8 +238,7 @@ library unstable-byron-testlib
235238
cardano-crypto-class,
236239
cardano-crypto-wrapper:{cardano-crypto-wrapper, testlib},
237240
cardano-ledger-binary:{cardano-ledger-binary, testlib},
238-
cardano-ledger-byron,
239-
cardano-ledger-byron-test,
241+
cardano-ledger-byron:{cardano-ledger-byron, testlib},
240242
cardano-ledger-core,
241243
containers,
242244
hedgehog-quickcheck,
@@ -271,8 +273,7 @@ test-suite byron-test
271273
cardano-crypto-class,
272274
cardano-crypto-wrapper,
273275
cardano-ledger-binary,
274-
cardano-ledger-byron,
275-
cardano-ledger-byron-test,
276+
cardano-ledger-byron:{cardano-ledger-byron, testlib},
276277
cardano-ledger-core,
277278
cardano-slotting:testlib,
278279
cborg,
@@ -749,6 +750,7 @@ executable pull-cddls
749750
import: common-exe
750751
hs-source-dirs: cddl
751752
main-is: pull-cddls.hs
753+
other-modules: Paths_ouroboros_consensus_cardano
752754
build-depends:
753755
base,
754756
bytestring,
@@ -759,6 +761,7 @@ executable pull-cddls
759761
cardano-ledger-conway:testlib,
760762
cardano-ledger-mary:testlib,
761763
cardano-ledger-shelley:testlib,
764+
directory,
765+
filepath,
762766
process-extras,
763767
utf8-string,
764-
filepath,

0 commit comments

Comments
 (0)