Move all haskell projects to toplevel

The whole project is an experiment so no need to have another level. It simplifies IDE configuration
input-output-hk · Feb 6, 2024 · 5c06c07 · 5c06c07
1 parent 7ccdc00
commit 5c06c07
Show file tree

Hide file tree

Showing 27 changed files with 92 additions and 73 deletions.
diff --git a/cabal.project b/cabal.project
@@ -1,4 +1,3 @@
--- Custom repository for cardano haskell packages, see CONTRIBUTING.md
 repository cardano-haskell-packages
   url: https://input-output-hk.github.io/cardano-haskell-packages
   secure: True
@@ -10,13 +9,32 @@ repository cardano-haskell-packages
     c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
--- See CONTRIBUTING.md for information about when and how to update these.
+index-state: 2024-01-05T13:49:07Z
 index-state:
-  , hackage.haskell.org 2023-09-14T06:54:18Z
-  , cardano-haskell-packages 2023-09-14T16:16:59Z
+  , hackage.haskell.org      2023-12-15T16:32:49Z
+  , cardano-haskell-packages 2023-12-15T14:50:31Z
 
-packages: .
+packages:
+  random-forks
+  quickcheck-model
+  sketch
 
--- Always show detailed output for tests
 tests: True
-test-show-details: direct
+
+package strict-containers
+  ghc-options: -Wno-noncanonical-monad-instances -Wno-error=noncanonical-monad-instances
+
+package comonad
+  flags: -test-doctests
+
+package cryptonite
+  -- Using RDRAND instead of /dev/urandom as an entropy source for key
+  -- generation is dubious. Set the flag so we use /dev/urandom by default.
+  flags: -support_rdrand
+
+benchmarks: False
+optimization: False
+
+flags: +defer-plugin-errors
+
+write-ghc-environment-files: never
diff --git a/experiments/cabal.project b/experiments/cabal.project
diff --git a/experiments/quickcheck-model/src/Peras/Model.hs b/experiments/quickcheck-model/src/Peras/Model.hs
diff --git a/experiments/random-forks/chain-100.png b/experiments/random-forks/chain-100.png
diff --git a/experiments/random-forks/peers.png b/experiments/random-forks/peers.png
diff --git a/experiments/quickcheck-model/CHANGELOG.md → quickcheck-model/CHANGELOG.md b/experiments/quickcheck-model/CHANGELOG.md → quickcheck-model/CHANGELOG.md
diff --git a/experiments/quickcheck-model/LICENSE → quickcheck-model/LICENSE b/experiments/quickcheck-model/LICENSE → quickcheck-model/LICENSE
diff --git a/...s/quickcheck-model/quickcheck-model.cabal → quickcheck-model/quickcheck-model.cabal b/...s/quickcheck-model/quickcheck-model.cabal → quickcheck-model/quickcheck-model.cabal
@@ -68,7 +68,9 @@ library
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:    base ^>=4.18.1.0
+    build-depends:    base ^>=4.18.1.0,
+                      bytestring,
+                      quickcheck-dynamic
 
     -- Directories containing source files.
     hs-source-dirs:   src
@@ -100,12 +102,13 @@ test-suite quickcheck-model-test
 
     -- Test dependencies.
     build-depends:
-        base ^>=4.18.1.0
-      , quickcheck-model
-      , hspec
-      , QuickCheck
-      , io-sim
-      , si-timers
+                      base ^>=4.18.1.0
+                  , QuickCheck
+                  , hspec
+                  , io-sim
+                  , quickcheck-dynamic
+                  , quickcheck-model
+                  , si-timers
 
     build-tool-depends:
        hspec-discover:hspec-discover
diff --git a/quickcheck-model/src/Peras/Model.hs b/quickcheck-model/src/Peras/Model.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GADTs #-}
+module Peras.Model where
+
+import Test.QuickCheck.StateModel(StateModel(..), Var)
+import GHC.Generics (Generic)
+import Data.ByteString (ByteString)
+
+-- | We model a network of nodes interconnected through a diffusion layer.
+data Network = Network
+ deriving (Show, Generic)
+
+newtype BlockId = BlockId { unBlockId :: ByteString }
+  deriving (Eq, Show)
+
+newtype NodeId = NodeId { unNodeId :: ByteString }
+  deriving (Eq, Show)
+
+newtype Block = Block { blockId :: BlockId }
+ deriving (Eq, Show)
+
+data Chain = Genesis
+ | Chain Block Chain
+  deriving (Eq, Show)
+
+instance StateModel Network where
+
+   data Action Network a where
+     DispatchBlock :: Action Network (Maybe (Var Block ))
+
+     ObserveNode :: NodeId -> Action Network Chain
diff --git a/experiments/quickcheck-model/test/Main.hs → quickcheck-model/test/Main.hs b/experiments/quickcheck-model/test/Main.hs → quickcheck-model/test/Main.hs
diff --git a/experiments/random-forks/.gitignore → random-forks/.gitignore b/experiments/random-forks/.gitignore → random-forks/.gitignore
diff --git a/experiments/random-forks/LICENSE → random-forks/LICENSE b/experiments/random-forks/LICENSE → random-forks/LICENSE
diff --git a/experiments/random-forks/ReadMe.md → random-forks/ReadMe.md b/experiments/random-forks/ReadMe.md → random-forks/ReadMe.md
diff --git a/experiments/random-forks/app/Main.hs → random-forks/app/Main.hs b/experiments/random-forks/app/Main.hs → random-forks/app/Main.hs
diff --git a/experiments/random-forks/flake.lock → random-forks/flake.lock b/experiments/random-forks/flake.lock → random-forks/flake.lock
diff --git a/experiments/random-forks/flake.nix → random-forks/flake.nix b/experiments/random-forks/flake.nix → random-forks/flake.nix
diff --git a/experiments/random-forks/nix/outputs.nix → random-forks/nix/outputs.nix b/experiments/random-forks/nix/outputs.nix → random-forks/nix/outputs.nix
diff --git a/experiments/random-forks/nix/project.nix → random-forks/nix/project.nix b/experiments/random-forks/nix/project.nix → random-forks/nix/project.nix
diff --git a/experiments/random-forks/nix/shell.nix → random-forks/nix/shell.nix b/experiments/random-forks/nix/shell.nix → random-forks/nix/shell.nix
diff --git a/experiments/random-forks/random-forks.cabal → random-forks/random-forks.cabal b/experiments/random-forks/random-forks.cabal → random-forks/random-forks.cabal
diff --git a/...nts/random-forks/src/Peras/RandomForks.hs → random-forks/src/Peras/RandomForks.hs b/...nts/random-forks/src/Peras/RandomForks.hs → random-forks/src/Peras/RandomForks.hs
diff --git a/...ndom-forks/src/Peras/RandomForks/Chain.hs → random-forks/src/Peras/RandomForks/Chain.hs b/...ndom-forks/src/Peras/RandomForks/Chain.hs → random-forks/src/Peras/RandomForks/Chain.hs
@@ -1,4 +1,8 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Peras.RandomForks.Chain (
   Block(..)
@@ -30,30 +34,33 @@ mkBlock
   -> Slot
   -> IO Block
 mkBlock name slot = Block name slot <$> nextRandom
-    
-newtype Chain =
+
+data Chain =
   Chain
   {
-    blocks :: [Block]
+    block :: Block,
+    prev :: Chain
   }
-    deriving (Eq, Ord, Read, Show)
-
-instance Semigroup Chain where
-  Chain x <> Chain y = Chain $ x <> y
+  | Genesis
+  deriving stock (Eq, Ord, Read, Show)
 
-instance Monoid Chain where
-  mempty = Chain mempty
+blocks :: Chain -> [Block]
+blocks = \case
+  Genesis -> []
+  Chain {block, prev} -> block : blocks prev
 
 chainLength
   :: Chain
   -> Int
-chainLength = length . blocks
+chainLength = \case
+  Genesis -> 0
+  Chain{prev} -> 1 + chainLength prev
 
 extendChain
-  :: Chain
-  -> Block
+  :: Block
+  -> Chain
   -> Chain
-extendChain = (. (Chain . pure)) . (<>)
+extendChain block = Chain block
 
 data Message =
   Message

diff --git a/...andom-forks/src/Peras/RandomForks/Peer.hs → random-forks/src/Peras/RandomForks/Peer.hs b/...andom-forks/src/Peras/RandomForks/Peer.hs → random-forks/src/Peras/RandomForks/Peer.hs
@@ -12,7 +12,7 @@ module Peras.RandomForks.Peer (
 
 import Data.List (delete)
 import Data.Maybe (fromMaybe)
-import Peras.RandomForks.Chain (Chain, Message(..), chainLength, extendChain, mkBlock)
+import Peras.RandomForks.Chain (Chain (Genesis), Message(..), chainLength, extendChain, mkBlock)
 import Peras.RandomForks.Protocol (Protocol(..), Parameters(..), isCommitteeMember, isFirstSlotInRound, isSlotLeader)
 import Peras.RandomForks.Types (Currency, PeerName(..), Slot)
 import System.Random (randomRIO)
@@ -56,13 +56,13 @@ randomPeers Parameters{..} protocol =
       upstreams = M.fromListWith (<>) . concatMap (\(name, names) -> (, S.singleton name) <$> S.toList names) $ M.toList downstreams
       randomPeer name =
         do
-          currency <- randomRIO (1, maximumCurrency)       
+          currency <- randomRIO (1, maximumCurrency)
           vrfOutput <- randomRIO (0, 1)
           slotLeader <- isSlotLeader protocol currency
           committeeMember <- isCommitteeMember protocol currency
           let upstream = fromMaybe mempty $ M.lookup name upstreams
               downstream = fromMaybe mempty $ M.lookup name downstreams
-              preferredChain = mempty
+              preferredChain = Genesis
               pendingMessages = mempty
           pure PeerState{..}
     Peers . M.fromList <$> mapM (\name -> (name, ) <$> randomPeer name) peerNames
@@ -83,7 +83,7 @@ nextSlot protocol slot name state@PeerState{..} =
     preferredChainBeforeNow <- (longest !!) <$> randomRIO (0, length longest - 1)
     preferredChain' <-
       if slotLeader'
-        then extendChain preferredChainBeforeNow <$> mkBlock name slot
+        then (`extendChain` preferredChainBeforeNow) <$> mkBlock name slot
         else pure preferredChainBeforeNow
     let
       newMessages =
@@ -105,7 +105,7 @@ nextSlot protocol slot name state@PeerState{..} =
         , preferredChain = preferredChain'
         , pendingMessages = mempty
         }
-    pure (newState, newMessages)    
+    pure (newState, newMessages)
 
 peerGraph
   :: Peers

diff --git a/...m-forks/src/Peras/RandomForks/Protocol.hs → ...m-forks/src/Peras/RandomForks/Protocol.hs b/...m-forks/src/Peras/RandomForks/Protocol.hs → ...m-forks/src/Peras/RandomForks/Protocol.hs
diff --git a/...ndom-forks/src/Peras/RandomForks/Types.hs → random-forks/src/Peras/RandomForks/Types.hs b/...ndom-forks/src/Peras/RandomForks/Types.hs → random-forks/src/Peras/RandomForks/Types.hs
diff --git a/experiments/sketch/Peras.hs → sketch/Peras.hs b/experiments/sketch/Peras.hs → sketch/Peras.hs
diff --git a/experiments/sketch/peras.cabal → sketch/peras.cabal b/experiments/sketch/peras.cabal → sketch/peras.cabal