summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders
diff options
context:
space:
mode:
authorJulien Dessaux2023-07-03 21:29:15 +0200
committerJulien Dessaux2023-07-03 21:29:15 +0200
commitb3d57cb6adf1e3f6a8ba7cf1c1553b6fd4acb578 (patch)
tree8f596ee49ad84f320d5950fe5690bee335f930be /haskell/src/SpaceTraders
parentBootstrapped my haskell client (diff)
downloadspacetraders-b3d57cb6adf1e3f6a8ba7cf1c1553b6fd4acb578.tar.gz
spacetraders-b3d57cb6adf1e3f6a8ba7cf1c1553b6fd4acb578.tar.bz2
spacetraders-b3d57cb6adf1e3f6a8ba7cf1c1553b6fd4acb578.zip
[haskell] Implemented contract
Diffstat (limited to '')
-rw-r--r--haskell/src/SpaceTraders/APIClient/Agent.hs10
-rw-r--r--haskell/src/SpaceTraders/Database/Agents.hs1
-rw-r--r--haskell/src/SpaceTraders/Database/Contracts.hs13
-rw-r--r--haskell/src/SpaceTraders/Model/Contract.hs60
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)