diff --git a/src/Transmission.hs b/src/Transmission.hs index 45f75495c..672cd9a46 100644 --- a/src/Transmission.hs +++ b/src/Transmission.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -19,16 +18,16 @@ import Data.Kind import Data.Time.Clock import Data.Time.ISO8601 -data SParty :: Party -> Type where - SBroker :: SParty 'Broker - SRecipient :: SParty 'Recipient - SSender :: SParty 'Sender - -deriving instance Show (SParty a) - data Party = Broker | Recipient | Sender deriving (Show) +data SParty :: Party -> Type where + SBroker :: SParty Broker + SRecipient :: SParty Recipient + SSender :: SParty Sender + +deriving instance Show (SParty a) + data Cmd where Cmd :: SParty a -> Command a -> Cmd diff --git a/src/Transport.hs b/src/Transport.hs index 427b3bc59..3ecf1c3c3 100644 --- a/src/Transport.hs +++ b/src/Transport.hs @@ -62,11 +62,14 @@ startTCPClient host port = liftIO . withSocketsDo $ resolve >>= open runTCPClient :: MonadUnliftIO m => HostName -> ServiceName -> (Handle -> m a) -> m a runTCPClient host port = E.bracket (startTCPClient host port) IO.hClose +smpNewlineMode :: NewlineMode +smpNewlineMode = NewlineMode {inputNL = CRLF, outputNL = CRLF} + getSocketHandle :: MonadIO m => Socket -> m Handle getSocketHandle conn = liftIO $ do h <- socketToHandle conn ReadWriteMode hSetBinaryMode h True - hSetNewlineMode h universalNewlineMode + hSetNewlineMode h smpNewlineMode hSetBuffering h LineBuffering return h