diff --git a/package.yaml b/package.yaml index 88fa27f50..b6333b893 100644 --- a/package.yaml +++ b/package.yaml @@ -20,7 +20,6 @@ dependencies: - iso8601-time == 0.1.* - mtl - network - - singletons - stm - time == 1.9.* - unliftio-core diff --git a/src/ConnStore.hs b/src/ConnStore.hs index f8cfa3fd7..b180fadd5 100644 --- a/src/ConnStore.hs +++ b/src/ConnStore.hs @@ -5,7 +5,6 @@ module ConnStore where -import Data.Singletons import Transmission data Connection = Connection @@ -20,7 +19,7 @@ data ConnStatus = ConnActive | ConnOff class MonadConnStore s m where addConn :: s -> m (RecipientId, SenderId) -> RecipientKey -> m (Either ErrorType Connection) - getConn :: s -> Sing (a :: Party) -> ConnId -> m (Either ErrorType Connection) + getConn :: s -> SParty (a :: Party) -> ConnId -> m (Either ErrorType Connection) secureConn :: s -> RecipientId -> SenderKey -> m (Either ErrorType ()) suspendConn :: s -> RecipientId -> m (Either ErrorType ()) deleteConn :: s -> RecipientId -> m (Either ErrorType ()) diff --git a/src/ConnStore/STM.hs b/src/ConnStore/STM.hs index 5328c5ca7..e87988965 100644 --- a/src/ConnStore/STM.hs +++ b/src/ConnStore/STM.hs @@ -16,7 +16,6 @@ import ConnStore import Control.Monad.IO.Unlift import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Singletons import Transmission import UnliftIO.STM @@ -53,7 +52,7 @@ instance MonadUnliftIO m => MonadConnStore STMConnStore m where } return $ Just c - getConn :: STMConnStore -> Sing (p :: Party) -> ConnId -> m (Either ErrorType Connection) + getConn :: STMConnStore -> SParty (p :: Party) -> ConnId -> m (Either ErrorType Connection) getConn store SRecipient rId = atomically $ do cs <- readTVar store return $ getRcpConn cs rId diff --git a/src/Server.hs b/src/Server.hs index 13d832778..6af048122 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -20,7 +20,6 @@ import Crypto.Random import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.Map.Strict as M -import Data.Singletons import Data.Time.Clock import Env.STM import MsgStore @@ -87,7 +86,7 @@ verifyTransmission signature connId cmd = do Cmd SRecipient _ -> withConnection SRecipient $ verifySignature . recipientKey Cmd SSender (SEND _) -> withConnection SSender $ verifySend . senderKey where - withConnection :: Sing (p :: Party) -> (Connection -> m Cmd) -> m Cmd + withConnection :: SParty (p :: Party) -> (Connection -> m Cmd) -> m Cmd withConnection party f = do store <- asks connStore conn <- getConn store party connId diff --git a/src/Transmission.hs b/src/Transmission.hs index 6be1860fa..45f75495c 100644 --- a/src/Transmission.hs +++ b/src/Transmission.hs @@ -1,12 +1,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} @@ -17,19 +15,22 @@ import Data.ByteString.Base64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Char (ord) -import Data.Singletons.TH +import Data.Kind import Data.Time.Clock import Data.Time.ISO8601 -$( singletons - [d| - 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 Party = Broker | Recipient | Sender + deriving (Show) data Cmd where - Cmd :: Sing a -> Command a -> Cmd + Cmd :: SParty a -> Command a -> Cmd deriving instance Show Cmd