[CDEC-424] Reunite orphan Bi instances in lib (cardano-sl) (#3207)

infra/src/Pos/Infra/Communication/Types/Protocol.hs

@@ -51,6 +51,7 @@ import           Control.Exception (throwIO)
 import           Data.Aeson (FromJSON (..), ToJSON (..), Value)
 import           Data.Aeson.Types (Parser)
 import qualified Data.ByteString.Base64 as B64 (decode, encode)
+import qualified Data.ByteString.Lazy as LBS
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Text.Buildable as B
 import qualified Data.Text.Encoding as Text (decodeUtf8, encodeUtf8)
@@ -63,13 +64,16 @@ import           Node.Message.Class (Message (..), MessageCode)
 import           Serokell.Util.Base16 (base16F)
 import           Serokell.Util.Text (listJson, mapJson)
 
-import           Pos.Binary.Class (Bi)
+import           Pos.Binary.Class (Bi (..), Cons (..), Field (..),
+                     decodeKnownCborDataItem, decodeUnknownCborDataItem,
+                     deriveSimpleBi, encodeKnownCborDataItem, encodeListLen,
+                     encodeUnknownCborDataItem, enforceSize)
 import           Pos.Binary.Limit (Limit (..))
 import           Pos.Core.Update (BlockVersion)
 import           Pos.Infra.Communication.BiP (BiP)
 import           Pos.Infra.Network.Types (MsgType (..), NodeId (..),
                      NodeType (..), Origin (..))
-import           Pos.Util.Util (toAesonError)
+import           Pos.Util.Util (cborError, toAesonError)
 
 type PackingType = BiP
 type PeerData = VerInfo
@@ -186,6 +190,19 @@ data HandlerSpec
     | UnknownHandler Word8 ByteString
     deriving (Show, Generic, Eq)
 
+instance Bi HandlerSpec where
+    encode input = case input of
+        ConvHandler mname        ->
+            encodeListLen 2 <> encode (0 :: Word8) <> encodeKnownCborDataItem mname
+        UnknownHandler word8 bs  ->
+            encodeListLen 2 <> encode word8 <> encodeUnknownCborDataItem (LBS.fromStrict bs)
+    decode = do
+        enforceSize "HandlerSpec" 2
+        tag <- decode @Word8
+        case tag of
+            0 -> ConvHandler        <$> decodeKnownCborDataItem
+            _ -> UnknownHandler tag <$> decodeUnknownCborDataItem
+
 convH :: (Message snd, Message rcv) => Proxy snd -> Proxy rcv -> (MessageCode, HandlerSpec)
 convH pSnd pReply = (messageCode pSnd, ConvHandler $ messageCode pReply)
 
@@ -214,6 +231,14 @@ data VerInfo = VerInfo
     , vIOutHandlers  :: HandlerSpecs
     } deriving (Eq, Generic, Show)
 
+deriveSimpleBi ''VerInfo [
+    Cons 'VerInfo [
+        Field [| vIMagic        :: Int32        |],
+        Field [| vIBlockVersion :: BlockVersion |],
+        Field [| vIInHandlers   :: HandlerSpecs |],
+        Field [| vIOutHandlers  :: HandlerSpecs |]
+    ]]
+
 instance Buildable VerInfo where
     build VerInfo {..} = bprint ("VerInfo { magic="%hex%", blockVersion="
                                 %build%", inSpecs="%mapJson%", outSpecs="
@@ -330,10 +355,28 @@ instance Monoid MkListeners where
 data MsgSubscribe = MsgSubscribe | MsgSubscribeKeepAlive
     deriving (Generic, Show, Eq)
 
+instance Bi MsgSubscribe where
+    encode = \case
+        MsgSubscribe          -> encode (42 :: Word8)
+        MsgSubscribeKeepAlive -> encode (43 :: Word8)
+    decode = decode @Word8 >>= \case
+        42 -> pure MsgSubscribe
+        43 -> pure MsgSubscribeKeepAlive
+        n  -> cborError $ "MsgSubscribe wrong byte: " <> show n
+
 -- | Old version of MsgSubscribe.
 data MsgSubscribe1 = MsgSubscribe1
     deriving (Generic, Show, Eq)
 
+-- deriveSimpleBi is not happy with constructors without arguments
+-- "fake" deriving as per `MempoolMsg`.
+-- TODO: Shall we encode this as `CBOR` TkNull?
+instance Bi MsgSubscribe1 where
+    encode MsgSubscribe1 = encode (42 :: Word8)
+    decode = decode @Word8 >>= \case
+        42 -> pure MsgSubscribe1
+        n  -> cborError $ "MsgSubscribe1 wrong byte:" <> show n
+
 mlMsgSubscribe :: Limit MsgSubscribe
 mlMsgSubscribe = 0
 

infra/src/Pos/Infra/Diffusion/Subscription/Common.hs

@@ -1,7 +1,7 @@
--- | Common definitions for peer discovery and subscription workers.
-
 {-# LANGUAGE ScopedTypeVariables #-}
 
+-- | Common definitions for peer discovery and subscription workers.
+
 module Pos.Infra.Diffusion.Subscription.Common
     ( SubscriptionMessageConstraints
     , SubscriptionTerminationReason (..)
@@ -36,7 +36,6 @@ import           Node.Message.Class (Message)
 import           System.Clock (Clock (Monotonic), TimeSpec, getTime, toNanoSecs)
 import           System.Wlog (Severity (..))
 
-import           Pos.Binary.Class (Bi)
 import           Pos.Infra.Communication.Listener (listenerConv)
 import           Pos.Infra.Communication.Protocol (Conversation (..),
                      ConversationActions (..), ListenerSpec, MkListeners,
@@ -211,8 +210,6 @@ networkSubscribeTo' logTrace oq bucket nodeType peersVar keepalive subStates sen
 type SubscriptionMessageConstraints =
     ( Message MsgSubscribe
     , Message MsgSubscribe1
-    , Bi MsgSubscribe
-    , Bi MsgSubscribe1
     , Message Void
     )
 

lib/src/Pos/Binary/Communication.hs

@@ -1,7 +1,5 @@
 {-# LANGUAGE BinaryLiterals #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 -- | Communication-related serialization -- messages mostly.
 
 module Pos.Binary.Communication
@@ -14,20 +12,11 @@ import           Universum
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 
-import           Pos.Binary.Class (Bi (..), Cons (..), Field (..),
-                     decodeKnownCborDataItem, decodeUnknownCborDataItem,
-                     deriveSimpleBi, encodeKnownCborDataItem, encodeListLen,
-                     encodeUnknownCborDataItem, enforceSize, serialize,
-                     serialize')
+import           Pos.Binary.Class (serialize, serialize')
 import           Pos.Block.BHelpers ()
 import           Pos.Block.Network (MsgBlock (..), MsgSerializedBlock (..),
                      MsgStreamBlock (..))
-import           Pos.Core (BlockVersion)
 import           Pos.DB.Class (Serialized (..))
-import           Pos.Infra.Communication.Types.Protocol (HandlerSpec (..),
-                     HandlerSpecs, MsgSubscribe (..), MsgSubscribe1 (..),
-                     VerInfo (..))
-import           Pos.Util.Util (cborError)
 
 -- TODO: move into each component
 
@@ -50,46 +39,3 @@ serializeMsgSerializedBlock (MsgNoSerializedBlock t) = serialize' (MsgNoBlock t)
 serializeMsgStreamBlock :: MsgSerializedBlock -> LBS.ByteString
 serializeMsgStreamBlock (MsgSerializedBlock b)   = "\x82\x0" <> LBS.fromStrict (unSerialized b)
 serializeMsgStreamBlock (MsgNoSerializedBlock t) = serialize (MsgStreamNoBlock t)
-
--- deriveSimpleBi is not happy with constructors without arguments
--- "fake" deriving as per `MempoolMsg`.
--- TODO: Shall we encode this as `CBOR` TkNull?
-instance Bi MsgSubscribe1 where
-    encode MsgSubscribe1 = encode (42 :: Word8)
-    decode = decode @Word8 >>= \case
-        42 -> pure MsgSubscribe1
-        n  -> cborError $ "MsgSubscribe1 wrong byte:" <> show n
-
-instance Bi MsgSubscribe where
-    encode = \case
-        MsgSubscribe          -> encode (42 :: Word8)
-        MsgSubscribeKeepAlive -> encode (43 :: Word8)
-    decode = decode @Word8 >>= \case
-        42 -> pure MsgSubscribe
-        43 -> pure MsgSubscribeKeepAlive
-        n  -> cborError $ "MsgSubscribe wrong byte: " <> show n
-
-----------------------------------------------------------------------------
--- Protocol version info and related
-----------------------------------------------------------------------------
-
-instance Bi HandlerSpec where
-    encode input = case input of
-        ConvHandler mname        ->
-            encodeListLen 2 <> encode (0 :: Word8) <> encodeKnownCborDataItem mname
-        UnknownHandler word8 bs  ->
-            encodeListLen 2 <> encode word8 <> encodeUnknownCborDataItem (LBS.fromStrict bs)
-    decode = do
-        enforceSize "HandlerSpec" 2
-        tag <- decode @Word8
-        case tag of
-          0 -> ConvHandler        <$> decodeKnownCborDataItem
-          _ -> UnknownHandler tag <$> decodeUnknownCborDataItem
-
-deriveSimpleBi ''VerInfo [
-    Cons 'VerInfo [
-        Field [| vIMagic        :: Int32        |],
-        Field [| vIBlockVersion :: BlockVersion |],
-        Field [| vIInHandlers   :: HandlerSpecs |],
-        Field [| vIOutHandlers  :: HandlerSpecs |]
-    ]]