review style of ChainProducer modules + add license header

cardano-wallet.cabal

@@ -158,5 +158,4 @@ test-suite unit
       Cardano.Wallet.BlockSyncerSpec
       Cardano.Wallet.MnemonicSpec
       Cardano.Wallet.PrimitiveSpec
-      Cardano.Wallet.SlottingOrphans
       Cardano.Wallet.SlottingSpec

src/Cardano/ChainProducer.hs

@@ -1,3 +1,7 @@
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+
 module Cardano.ChainProducer
     ( MonadChainProducer (..)
     , ErrGetNextBlocks (..)
@@ -8,20 +12,22 @@ import Prelude
 import Cardano.Wallet.Primitive
     ( Block )
 import Cardano.Wallet.Slotting
-    ( SlotCount, SlotId )
+    ( SlotId )
 import Control.Exception
     ( Exception )
 import Control.Monad.Except
     ( ExceptT )
+import Numeric.Natural
+    ( Natural )
 
 class MonadChainProducer m where
     -- | Get some blocks from the chain producer.
     --
     -- This may retrieve less than the requested number of blocks.
     -- It might return no blocks at all.
     nextBlocks
-        :: SlotCount -- ^ Number of blocks to retrieve
-        -> SlotId    -- ^ Starting point
+        :: Natural -- ^ Number of blocks to retrieve
+        -> SlotId -- ^ Starting point
         -> ExceptT ErrGetNextBlocks m [Block]
 
 -- | The things that can go wrong when retrieving blocks.

src/Cardano/ChainProducer/RustHttpBridge.hs

@@ -6,21 +6,15 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+
 module Cardano.ChainProducer.RustHttpBridge
     ( RustBackend
     , runRustBackend
     ) where
 
-import Control.Monad.Except
-    ( ExceptT (..), mapExceptT, runExceptT )
-import Control.Monad.IO.Class
-    ( MonadIO, liftIO )
-import Control.Monad.Reader
-    ( MonadReader, ReaderT (..), ask, lift )
-import Data.Bifunctor
-    ( first )
-import Data.Maybe
-    ( fromMaybe )
 import Prelude
 
 import Cardano.ChainProducer
@@ -32,17 +26,33 @@ import Cardano.Wallet.Primitive
 import Cardano.Wallet.Slotting
     ( EpochIndex
     , LocalSlotIndex (..)
-    , SlotCount
     , SlotId (..)
     , addSlots
     , slotNext
     , slotsPerEpoch
     )
-
-newtype RustBackend a = RustBackend {
-    runRB :: ReaderT (NetworkLayer IO) IO a
-    } deriving (Monad, Applicative, Functor,
-                MonadReader (NetworkLayer IO), MonadIO)
+import Control.Monad.Except
+    ( ExceptT (..), mapExceptT, runExceptT )
+import Control.Monad.IO.Class
+    ( MonadIO, liftIO )
+import Control.Monad.Reader
+    ( MonadReader, ReaderT (..), ask, lift )
+import Data.Bifunctor
+    ( first )
+import Data.Maybe
+    ( fromMaybe )
+import Numeric.Natural
+    ( Natural )
+
+newtype RustBackend a = RustBackend
+    { runRB :: ReaderT (NetworkLayer IO) IO a
+    } deriving
+        ( Monad
+        , Applicative
+        , Functor
+        , MonadReader (NetworkLayer IO)
+        , MonadIO
+        )
 
 runRustBackend :: NetworkLayer IO -> RustBackend a -> IO a
 runRustBackend network action = runReaderT (runRB action) network
@@ -59,7 +69,7 @@ instance MonadChainProducer RustBackend where
 -- 2. Fetching the tip block and working backwards is not ideal.
 -- We will keep it for now, and it can be improved later.
 rbNextBlocks
-    :: SlotCount -- ^ Number of blocks to retrieve
+    :: Natural -- ^ Number of blocks to retrieve
     -> SlotId    -- ^ Starting point
     -> ExceptT ErrGetNextBlocks RustBackend [Block]
 rbNextBlocks numBlocks start = do
@@ -68,30 +78,29 @@ rbNextBlocks numBlocks start = do
     epochBlocks <- blocksFromPacks net tip
     lastBlocks <- unstableBlocks net tipHash tip epochBlocks
     pure (epochBlocks ++ lastBlocks)
+  where
+    end = addSlots numBlocks start
 
-    where
-        end = addSlots numBlocks start
-
-        -- Grab blocks from epoch pack files
-        blocksFromPacks network tip = do
-            let epochs = epochRange numBlocks start tip
-            epochBlocks <- runNetworkLayer (getEpochs network epochs)
-            pure $ filter (blockIsBetween start end) (concat epochBlocks)
+    -- Grab blocks from epoch pack files
+    blocksFromPacks network tip = do
+        let epochs = epochRange numBlocks start tip
+        epochBlocks <- runNetworkLayer (getEpochs network epochs)
+        pure $ filter (blockIsBetween start end) (concat epochBlocks)
 
-        -- The next slot after the last block.
-        slotAfter [] = Nothing
-        slotAfter bs = Just . slotNext . headerSlot . header . last $ bs
+    -- The next slot after the last block.
+    slotAfter [] = Nothing
+    slotAfter bs = Just . slotNext . headerSlot . header . last $ bs
 
-        -- Grab the remaining blocks which aren't packed in epoch files,
-        -- starting from the tip.
-        unstableBlocks network tipHash tip epochBlocks = do
-            let start' = fromMaybe start (slotAfter epochBlocks)
+    -- Grab the remaining blocks which aren't packed in epoch files,
+    -- starting from the tip.
+    unstableBlocks network tipHash tip epochBlocks = do
+        let start' = fromMaybe start (slotAfter epochBlocks)
 
-            lastBlocks <- if end > start' && start' <= tip
-                then runNetworkLayer $ fetchBlocksFromTip network start' tipHash
-                else pure []
+        lastBlocks <- if end > start' && start' <= tip
+            then runNetworkLayer $ fetchBlocksFromTip network start' tipHash
+            else pure []
 
-            pure $ filter (blockIsBefore end) lastBlocks
+        pure $ filter (blockIsBefore end) lastBlocks
 
 -- | Fetch epoch blocks until one fails.
 getEpochs
@@ -108,22 +117,24 @@ fetchBlocksFromTip
     -> SlotId
     -> Hash "BlockHeader"
     -> ExceptT NetworkLayerError m [Block]
-fetchBlocksFromTip network start tipHash = reverse <$> workBackwards tipHash
-    where
-        workBackwards headerHash = do
-            block <- getBlock network headerHash
-            if blockIsAfter start block
-                then do
-                    blocks <- workBackwards $ prevBlockHash $ header block
-                    pure (block:blocks)
-                else pure [block]
+fetchBlocksFromTip network start tipHash =
+    reverse <$> workBackwards tipHash
+  where
+    workBackwards headerHash = do
+        block <- getBlock network headerHash
+        if blockIsAfter start block then do
+            blocks <- workBackwards $ prevBlockHash $ header block
+            pure (block:blocks)
+        else
+            pure [block]
 
 runNetworkLayer
     :: ExceptT NetworkLayerError IO a
     -> ExceptT ErrGetNextBlocks RustBackend a
-runNetworkLayer = mapExceptT (fmap handle . liftIO)
-    where
-        handle = first (GetNextBlocksError . show)
+runNetworkLayer =
+    mapExceptT (fmap handle . liftIO)
+  where
+    handle = first (GetNextBlocksError . show)
 
 -- * Utility functions for monadic loops
 
@@ -156,7 +167,7 @@ headerSlot bh = SlotId
 -- point. It takes into account the latest block available, and that the most
 -- recent epoch is never available in a pack file.
 epochRange
-    :: SlotCount
+    :: Natural
         -- ^ Number of slots
     -> SlotId
         -- ^ Start point

src/Cardano/ChainProducer/RustHttpBridge/Api.hs

@@ -1,7 +1,11 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeOperators #-}
 
--- | An API specification for the Cardano HTTP Bridge.
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+--
+-- An API specification for the Cardano HTTP Bridge.
 module Cardano.ChainProducer.RustHttpBridge.Api
     ( Api
     , api
@@ -57,37 +61,33 @@ type GetTipBlockHeader
     :> Get '[ComputeHash Blake2b_256 CBOR] (WithHash Blake2b_256 BlockHeader)
 
 -- | Represents a block.
---
 newtype Block = Block
-  { getBlock :: Primitive.Block
-  } deriving Eq
+    { getBlock :: Primitive.Block
+    } deriving Eq
 
 instance FromCBOR Block where
-  fromCBOR = Block <$> decodeBlock
+    fromCBOR = Block <$> decodeBlock
 
 -- | Represents a block header.
---
 newtype BlockHeader = BlockHeader
-  { getBlockHeader :: Primitive.BlockHeader
-  } deriving Eq
+    { getBlockHeader :: Primitive.BlockHeader
+    } deriving Eq
 
 instance FromCBOR BlockHeader where
-  fromCBOR = BlockHeader <$> decodeBlockHeader
+    fromCBOR = BlockHeader <$> decodeBlockHeader
 
 -- | Represents a unique epoch.
---
 newtype EpochIndex = EpochIndex
-  { getEpochIndex :: Slotting.EpochIndex
-  } deriving (Eq, Show)
+    { getEpochIndex :: Slotting.EpochIndex
+    } deriving (Eq, Show)
 
 instance ToHttpApiData (EpochIndex) where
     toUrlPiece = toUrlPiece . Slotting.getEpochIndex . getEpochIndex
 
 -- | Represents the name of a Cardano network.
---
 newtype NetworkName = NetworkName
-  { getNetworkName :: Text
-  } deriving (Eq, Show)
+    { getNetworkName :: Text
+    } deriving (Eq, Show)
 
 instance ToHttpApiData NetworkName where
     toUrlPiece = getNetworkName

src/Cardano/ChainProducer/RustHttpBridge/Client.hs

@@ -2,7 +2,11 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes #-}
 
--- | An API client for the Cardano HTTP Bridge.
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+--
+-- An API client for the Cardano HTTP Bridge.
 module Cardano.ChainProducer.RustHttpBridge.Client
     ( mkNetworkLayer
     ) where
@@ -49,25 +53,26 @@ getBlockByHash
     :<|> getTipBlockHeader
     = client api
 
+-- | Construct a new network layer
 mkNetworkLayer :: Manager -> BaseUrl -> NetworkName -> NetworkLayer IO
 mkNetworkLayer mgr baseUrl network = NetworkLayer
     { getBlock = \hash -> do
-            hash' <- hashToApi' hash
-            run (Api.getBlock <$> getBlockByHash network hash')
-    , getEpoch = \ep -> run (map Api.getBlock
-                             <$> getEpochById network (Api.EpochIndex ep))
+        hash' <- hashToApi' hash
+        run (Api.getBlock <$> getBlockByHash network hash')
+    , getEpoch = \ep -> run (map Api.getBlock <$>
+        getEpochById network (Api.EpochIndex ep))
     , getNetworkTip = run (blockHeaderHash <$> getTipBlockHeader network)
     }
-    where
-        run query = ExceptT $ (first convertError) <$> runClientM query env
-        env = mkClientEnv mgr baseUrl
-        convertError = NetworkLayerError . show
+  where
+    run query = ExceptT $ (first convertError) <$> runClientM query env
+    env = mkClientEnv mgr baseUrl
+    convertError = NetworkLayerError . show
 
 blockHeaderHash
     :: WithHash algorithm BlockHeader
     -> (Primitive.Hash "BlockHeader", Primitive.BlockHeader)
-blockHeaderHash (WithHash h (Api.BlockHeader bh))
-    = (Primitive.Hash (convert h), bh)
+blockHeaderHash (WithHash h (Api.BlockHeader bh)) =
+    (Primitive.Hash (convert h), bh)
 
 hashToApi :: HashAlgorithm a => Primitive.Hash h -> Maybe (Hash a b)
 hashToApi (Primitive.Hash h) = Hash <$> digestFromByteString h

src/Cardano/ChainProducer/RustHttpBridge/NetworkLayer.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE DataKinds #-}
 
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+--
+-- Representation of a network layer
+
 module Cardano.ChainProducer.RustHttpBridge.NetworkLayer
     ( NetworkLayer (..)
     , NetworkLayerError(..)

src/Cardano/Wallet/Slotting.hs

@@ -2,11 +2,14 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+
 module Cardano.Wallet.Slotting
     ( SlotId (..)
     , EpochIndex (..)
     , LocalSlotIndex (..)
-    , SlotCount
     , slotsPerEpoch
     , addSlots
     , slotDiff
@@ -44,10 +47,8 @@ data SlotId = SlotId
   , slotNumber :: !LocalSlotIndex
   } deriving stock (Show, Eq, Ord, Generic)
 
-type SlotCount = Natural
-
 -- | Hard-coded for the time being
-slotsPerEpoch :: SlotCount
+slotsPerEpoch :: Natural
 slotsPerEpoch = 21600
 
 instance Bounded LocalSlotIndex where
@@ -56,7 +57,7 @@ instance Bounded LocalSlotIndex where
 
 -- | Add a number of slots to an (Epoch, LocalSlotIndex) pair, where the number
 -- of slots can be greater than one epoch.
-addSlots :: SlotCount -> SlotId -> SlotId
+addSlots :: Natural -> SlotId -> SlotId
 addSlots n (SlotId (EpochIndex e) (LocalSlotIndex sl))
     = SlotId (EpochIndex (e + fromIntegral e'))
         (LocalSlotIndex (fromIntegral sl'))
@@ -71,7 +72,7 @@ slotDiff s1 s2 = flatten s1 - flatten s2
     where flatten = fromIntegral . flattenSlotId
 
 -- | Convert SlotId into number of slots since genesis.
-flattenSlotId :: SlotId -> SlotCount
+flattenSlotId :: SlotId -> Natural
 flattenSlotId (SlotId (EpochIndex e) (LocalSlotIndex sl))
     = fromIntegral e * slotsPerEpoch + fromIntegral sl