diff options
Diffstat (limited to 'haskell/src/SpaceTraders')
-rw-r--r-- | haskell/src/SpaceTraders/APIClient/Agent.hs | 10 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Database/Agents.hs | 1 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Database/Contracts.hs | 13 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Model/Contract.hs | 60 |
4 files changed, 79 insertions, 5 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Agent.hs b/haskell/src/SpaceTraders/APIClient/Agent.hs index 997d1e5..6728baf 100644 --- a/haskell/src/SpaceTraders/APIClient/Agent.hs +++ b/haskell/src/SpaceTraders/APIClient/Agent.hs @@ -15,16 +15,18 @@ import Network.HTTP.Simple import SpaceTraders.APIClient.Client import SpaceTraders.Model.Agent +import SpaceTraders.Model.Contract myAgent :: T.Text -> IO (Either APIError Agent) myAgent t = send $ setRequestPath "/v2/my/agent" $ tokenReq t -data RegisterRequest = RegisterRequest { symbol :: T.Text - , faction :: T.Text +data RegisterRequest = RegisterRequest { faction :: T.Text + , symbol :: T.Text } deriving (ToJSON, Generic, Show) -data RegisterMessage = RegisterMessage { token :: T.Text - , agent :: Agent +data RegisterMessage = RegisterMessage { agent :: Agent + , contract :: Contract + , token :: T.Text } deriving (FromJSON, Generic, Show) register :: T.Text -> T.Text -> IO (Either APIError RegisterMessage) diff --git a/haskell/src/SpaceTraders/Database/Agents.hs b/haskell/src/SpaceTraders/Database/Agents.hs index 5be7389..48cd65b 100644 --- a/haskell/src/SpaceTraders/Database/Agents.hs +++ b/haskell/src/SpaceTraders/Database/Agents.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} module SpaceTraders.Database.Agents ( setAgent diff --git a/haskell/src/SpaceTraders/Database/Contracts.hs b/haskell/src/SpaceTraders/Database/Contracts.hs new file mode 100644 index 0000000..1ef5d6d --- /dev/null +++ b/haskell/src/SpaceTraders/Database/Contracts.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Database.Contracts + ( addContract + ) where + +import Data.Aeson +import qualified Database.SQLite.Simple as S + +import SpaceTraders.Model.Contract + +addContract :: S.Connection -> Contract -> IO () +addContract conn contract = S.execute conn "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract)) diff --git a/haskell/src/SpaceTraders/Model/Contract.hs b/haskell/src/SpaceTraders/Model/Contract.hs new file mode 100644 index 0000000..fd7a70b --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Contract.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Contract + ( Contract(..) + , Delivery(..) + , Payment(..) + , Terms(..) + ) where + +import Control.Monad +import Data.Aeson +import Data.Time +import GHC.Generics +import qualified Data.Text as T + +data Contract = Contract { accepted :: Bool + , contractId :: T.Text + , contractType :: T.Text + , expiration :: UTCTime + , deadlineToAccept :: UTCTime + , factionSymbol :: T.Text + , fulfilled :: Bool + , terms :: Terms + } deriving (Generic, Show) +instance FromJSON Contract where + parseJSON (Object o) = Contract <$> o .: "accepted" + <*> o .: "id" + <*> o .: "type" + <*> o .: "expiration" + <*> o .: "deadlineToAccept" + <*> o .: "factionSymbol" + <*> o .: "fulfilled" + <*> o .: "terms" + parseJSON _ = mzero +instance ToJSON Contract where + toEncoding (Contract a i ty e d fa fu te) = pairs ( "accepted" .= a + <> "id" .= i + <> "type" .= ty + <> "expiration" .= e + <> "deadlineToAccept" .= d + <> "factionSymbol" .= fa + <> "fulfilled" .= fu + <> "terms" .= te ) + +data Delivery = Delivery { destinationSymbol :: T.Text + , tradeSymbol :: T.Text + , unitsFulfilled :: Int + , unitsRequired :: Int + } deriving (FromJSON, Generic, Show, ToJSON) + +data Payment = Payment { onAccepted :: Int + , onFulfilled :: Int + } deriving (FromJSON, Generic, Show, ToJSON) + +data Terms = Terms { deadline :: UTCTime + , deliver :: [Delivery] + , payment :: Payment + } deriving (FromJSON, Generic, Show, ToJSON) |