aboutsummaryrefslogtreecommitdiff
path: root/servant
diff options
context:
space:
mode:
Diffstat (limited to 'servant')
-rw-r--r--servant/LICENSE27
-rw-r--r--servant/Setup.hs2
-rw-r--r--servant/api/Thermoprint/Api.hs35
-rw-r--r--servant/servant.cabal55
-rw-r--r--servant/servant.nix22
-rw-r--r--servant/src/Main.hs158
-rw-r--r--servant/src/PrintOut.hs14
7 files changed, 0 insertions, 313 deletions
diff --git a/servant/LICENSE b/servant/LICENSE
deleted file mode 100644
index 4ad71e2..0000000
--- a/servant/LICENSE
+++ /dev/null
@@ -1,27 +0,0 @@
1Statement of Purpose
2
3The laws of most jurisdictions throughout the world automatically confer exclusive Copyright and Related Rights (defined below) upon the creator and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work").
4
5Certain owners wish to permanently relinquish those rights to a Work for the purpose of contributing to a commons of creative, cultural and scientific works ("Commons") that the public can reliably and without fear of later claims of infringement build upon, modify, incorporate in other works, reuse and redistribute as freely as possible in any form whatsoever and for any purposes, including without limitation commercial purposes. These owners may contribute to the Commons to promote the ideal of a free culture and the further production of creative, cultural and scientific works, or to gain reputation or greater distribution for their Work in part through the use and efforts of others.
6
7For these and/or other purposes and motivations, and without any expectation of additional consideration or compensation, the person associating CC0 with a Work (the "Affirmer"), to the extent that he or she is an owner of Copyright and Related Rights in the Work, voluntarily elects to apply CC0 to the Work and publicly distribute the Work under its terms, with knowledge of his or her Copyright and Related Rights in the Work and the meaning and intended legal effect of CC0 on those rights.
8
91. Copyright and Related Rights. A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and Related Rights"). Copyright and Related Rights include, but are not limited to, the following:
10
11the right to reproduce, adapt, distribute, perform, display, communicate, and translate a Work;
12moral rights retained by the original author(s) and/or performer(s);
13publicity and privacy rights pertaining to a person's image or likeness depicted in a Work;
14rights protecting against unfair competition in regards to a Work, subject to the limitations in paragraph 4(a), below;
15rights protecting the extraction, dissemination, use and reuse of data in a Work;
16database rights (such as those arising under Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, and under any national implementation thereof, including any amended or successor version of such directive); and
17other similar, equivalent or corresponding rights throughout the world based on applicable law or treaty, and any national implementations thereof.
182. Waiver. To the greatest extent permitted by, but not in contravention of, applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and unconditionally waives, abandons, and surrenders all of Affirmer's Copyright and Related Rights and associated claims and causes of action, whether now known or unknown (including existing as well as future claims and causes of action), in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each member of the public at large and to the detriment of Affirmer's heirs and successors, fully intending that such Waiver shall not be subject to revocation, rescission, cancellation, termination, or any other legal or equitable action to disrupt the quiet enjoyment of the Work by the public as contemplated by Affirmer's express Statement of Purpose.
19
203. Public License Fallback. Should any part of the Waiver for any reason be judged legally invalid or ineffective under applicable law, then the Waiver shall be preserved to the maximum extent permitted taking into account Affirmer's express Statement of Purpose. In addition, to the extent the Waiver is so judged Affirmer hereby grants to each affected person a royalty-free, non transferable, non sublicensable, non exclusive, irrevocable and unconditional license to exercise Affirmer's Copyright and Related Rights in the Work (i) in all territories worldwide, (ii) for the maximum duration provided by applicable law or treaty (including future time extensions), (iii) in any current or future medium and for any number of copies, and (iv) for any purpose whatsoever, including without limitation commercial, advertising or promotional purposes (the "License"). The License shall be deemed effective as of the date CC0 was applied by Affirmer to the Work. Should any part of the License for any reason be judged legally invalid or ineffective under applicable law, such partial invalidity or ineffectiveness shall not invalidate the remainder of the License, and in such case Affirmer hereby affirms that he or she will not (i) exercise any of his or her remaining Copyright and Related Rights in the Work or (ii) assert any associated claims and causes of action with respect to the Work, in either case contrary to Affirmer's express Statement of Purpose.
21
224. Limitations and Disclaimers.
23
24No trademark or patent rights held by Affirmer are waived, abandoned, surrendered, licensed or otherwise affected by this document.
25Affirmer offers the Work as-is and makes no representations or warranties of any kind concerning the Work, express, implied, statutory or otherwise, including without limitation warranties of title, merchantability, fitness for a particular purpose, non infringement, or the absence of latent or other defects, accuracy, or the present or absence of errors, whether or not discoverable, all to the greatest extent permissible under applicable law.
26Affirmer disclaims responsibility for clearing rights of other persons that may apply to the Work or any use thereof, including without limitation any person's Copyright and Related Rights in the Work. Further, Affirmer disclaims responsibility for obtaining any necessary consents, permissions or other rights required for any use of the Work.
27Affirmer understands and acknowledges that Creative Commons is not a party to this document and has no duty or obligation with respect to this CC0 or use of the Work. \ No newline at end of file
diff --git a/servant/Setup.hs b/servant/Setup.hs
deleted file mode 100644
index 9a994af..0000000
--- a/servant/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
1import Distribution.Simple
2main = defaultMain
diff --git a/servant/api/Thermoprint/Api.hs b/servant/api/Thermoprint/Api.hs
deleted file mode 100644
index f3318c4..0000000
--- a/servant/api/Thermoprint/Api.hs
+++ /dev/null
@@ -1,35 +0,0 @@
1{-# LANGUAGE DataKinds, TypeOperators, DeriveGeneric #-}
2
3module Thermoprint.Api
4 ( ThermoprintApi
5 ) where
6
7import Thermoprint
8import Data.Aeson
9import Servant.API
10import qualified Data.Text.Lazy as Text
11import qualified Data.ByteString.Lazy.Char8 as ByteString
12import Data.ByteString.Lazy.Char8 (ByteString)
13import GHC.Generics
14
15import Control.Monad
16
17import Data.Int (Int64)
18
19instance ToJSON ByteString where
20 toJSON = toJSON . Text.pack . ByteString.unpack
21instance FromJSON ByteString where
22 parseJSON value = (ByteString.pack . Text.unpack) `liftM` parseJSON value
23
24instance ToJSON c => ToJSON (Inline c)
25instance FromJSON c => FromJSON (Inline c)
26
27instance ToJSON c => ToJSON (Block c)
28instance FromJSON c => FromJSON (Block c)
29
30type ThermoprintApi = "print" :> Capture "printerId" Integer :> ReqBody '[JSON] (Block String) :> Post '[JSON] ()
31 :<|> "drafts" :> Get '[JSON] [(Int64, String)]
32 :<|> "drafts" :> ReqBody '[JSON] (String, Block String) :> Put '[JSON] Int64
33 :<|> "drafts" :> Capture "draftId" Int64 :> Get '[JSON] (String, Block String)
34 :<|> "drafts" :> Capture "draftId" Int64 :> ReqBody '[JSON] (String, Block String) :> Put '[JSON] ()
35 :<|> "drafts" :> Capture "draftId" Int64 :> Delete '[JSON] ()
diff --git a/servant/servant.cabal b/servant/servant.cabal
deleted file mode 100644
index dce4490..0000000
--- a/servant/servant.cabal
+++ /dev/null
@@ -1,55 +0,0 @@
1-- Initial thermoprint.cabal generated by cabal init. For further
2-- documentation, see http://haskell.org/cabal/users-guide/
3
4name: thermoprint-servant
5version: 0.0.0
6synopsis: Server for interfacing to cheap thermoprinters
7-- description:
8homepage: git://git.yggdrasil.li/thermoprint
9license: PublicDomain
10license-file: LICENSE
11author: Gregor Kleen
12maintainer: aethoago@141.li
13-- copyright:
14category: Web
15build-type: Simple
16-- extra-source-files:
17cabal-version: >=1.10
18
19library
20 exposed-modules: Thermoprint.Api
21 hs-source-dirs: api
22 default-language: Haskell2010
23 other-extensions: DataKinds
24 , TypeOperators
25 , DeriveGeneric
26 build-depends: base >=4.8 && <4.9
27 , thermoprint
28 , aeson >=0.9.0 && <0.10
29 , servant >=0.4.4 && <0.5
30 , text >=1.2.1 && <4.5
31 , bytestring >=0.10.6 && <0.11
32
33executable thermoprint
34 main-is: Main.hs
35 hs-source-dirs: src
36 default-language: Haskell2010
37 -- other-modules:
38 other-extensions: RecordWildCards
39 , OverloadedStrings
40 build-depends: base >=4.8 && <4.9
41 , thermoprint
42 , thermoprint-servant
43 , aeson >=0.9.0 && <0.10
44 , wai >=3.0.3 && <3.1
45 , servant-server >=0.4.4 && <0.5
46 , warp >=3.1.3 && <3.2
47 , text >=1.2.1 && <1.3
48 , bytestring >=0.10.6 && <0.11
49 , either >=4.4.1 && <4.5
50 , optparse-applicative >=0.11.0 && <0.12
51 , transformers >=0.4.2 && <0.5
52 , persistent >=2.2 && <3
53 , persistent-template >=2.1 && <3
54 , persistent-sqlite >=2.2 && <3
55 , monad-logger >=0.3.13 && <1 \ No newline at end of file
diff --git a/servant/servant.nix b/servant/servant.nix
deleted file mode 100644
index 5ea8d59..0000000
--- a/servant/servant.nix
+++ /dev/null
@@ -1,22 +0,0 @@
1{ mkDerivation
2, stdenv
3, base
4, thermoprint
5, aeson, wai, servant-server, warp, optparse-applicative, persistent
6, persistent-template, persistent-sqlite, monad-logger
7}:
8
9mkDerivation {
10 pname = "thermoprint-servant";
11 version = "0.0.0";
12 src = ./.;
13 isLibrary = true;
14 isExecutable = true;
15 executableHaskellDepends = [
16 base thermoprint aeson wai servant-server warp optparse-applicative
17 persistent persistent-template persistent-sqlite monad-logger
18 ];
19 homepage = "git://git.yggdrasil.li/thermoprint";
20 description = "Server for interfacing to cheap thermoprinters";
21 license = stdenv.lib.licenses.publicDomain;
22}
diff --git a/servant/src/Main.hs b/servant/src/Main.hs
deleted file mode 100644
index 0aa9eeb..0000000
--- a/servant/src/Main.hs
+++ /dev/null
@@ -1,158 +0,0 @@
1{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
2{-# LANGUAGE EmptyDataDecls #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE QuasiQuotes #-}
8{-# LANGUAGE TemplateHaskell #-}
9{-# LANGUAGE TypeFamilies #-}
10
11import Thermoprint
12import Thermoprint.Api
13import PrintOut
14
15import qualified Data.Text.Lazy as TL
16import qualified Data.ByteString.Lazy.Char8 as LBS
17import qualified Data.ByteString.Lazy.Char8 as Lazy (ByteString)
18import qualified Data.Text as T (pack)
19import Data.ByteString (ByteString)
20import qualified Data.ByteString as BS
21
22import Data.Aeson
23import Network.Wai
24import Network.Wai.Handler.Warp
25import Servant
26import GHC.Generics
27
28import Control.Monad
29import Control.Monad.Trans.Class
30import Control.Monad.IO.Class
31import Control.Monad.Trans.Either
32
33import Control.Monad.Logger
34
35import Options.Applicative
36
37import System.IO hiding (print)
38
39import Database.Persist
40import Database.Persist.Sqlite
41import Database.Persist.TH
42
43import Data.Int (Int64)
44
45import Prelude hiding (print)
46
47share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
48Draft
49 title String
50 content PrintOut
51 deriving Show
52|]
53
54
55print :: Options -> Integer -> Block String -> EitherT ServantErr IO ()
56print Options{..} printerNo printOut = do
57 printerPath <- case genericIndex printers printerNo of
58 Just path -> return path
59 Nothing -> left $ err404 { errBody = "printerId out of bounds" }
60 liftIO $ withFile printerPath WriteMode doPrint
61 where
62 doPrint handle = do
63 hSetBuffering handle NoBuffering
64 LBS.hPut handle $ render' printOut
65 genericIndex :: Integral i => [a] -> i -> Maybe a
66 genericIndex (x:_) 0 = Just x
67 genericIndex (_:xs) n
68 | n > 0 = genericIndex xs (n - 1)
69 | otherwise = Nothing
70 genericIndex _ _ = Nothing
71
72withPool = flip runSqlPool
73
74queryDrafts :: Options -> ConnectionPool -> EitherT ServantErr IO [(Int64, String)]
75queryDrafts Options{..} cPool = withPool cPool $ do
76 drafts <- selectList [] []
77 return $ map deSQLify drafts
78 where
79 deSQLify :: Entity Draft -> (Int64, String)
80 deSQLify (Entity k (Draft title _)) = (fromSqlKey k, title)
81
82getDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO (String, Block String)
83getDraft Options{..} cPool draftId = withPool cPool $ do
84 draft <- get $ toSqlKey draftId
85 case draft of
86 Nothing -> lift $ left $ err404 { errBody = "no such draftId" }
87 Just (Draft title content) -> return (title, content)
88
89writeDraft :: Options -> ConnectionPool -> Int64 -> (String, Block String) -> EitherT ServantErr IO ()
90writeDraft Options{..} cPool draftId (draftName, draft) = withPool cPool $ repsert (toSqlKey draftId) (Draft draftName draft)
91
92addDraft :: Options -> ConnectionPool -> (String, Block String) -> EitherT ServantErr IO Int64
93addDraft Options{..} cPool (draftName, draft) = withPool cPool $ (fromSqlKey <$> insert (Draft draftName draft))
94
95delDraft :: Options -> ConnectionPool -> Int64 -> EitherT ServantErr IO ()
96delDraft Options{..} cPool draftId = withPool cPool $ delete (toSqlKey draftId :: Key Draft)
97
98data Options = Options
99 { port :: Int
100 , connStr :: String
101 , connNmbr :: Int
102 , printers :: [FilePath]
103 }
104
105server :: Options -> ConnectionPool -> Server ThermoprintApi
106server opts cPool = print opts
107 :<|> queryDrafts opts cPool
108 :<|> addDraft opts cPool
109 :<|> getDraft opts cPool
110 :<|> writeDraft opts cPool
111 :<|> delDraft opts cPool
112
113options :: Parser Options
114options = Options
115 <$> option auto (
116 long "port"
117 <> short 'p'
118 <> metavar "PORT"
119 <> help "The port we'll run the server on"
120 <> value 8080
121 <> showDefault
122 )
123 <*> strOption (
124 long "database"
125 <> short 'd'
126 <> metavar "STRING"
127 <> help "The sqlite connection string to use (can inlude some options)"
128 <> value "./storage.sqlite"
129 <> showDefault
130 )
131 <*> option auto (
132 long "database-connections"
133 <> metavar "INT"
134 <> help "The number of parallel sqlite connections to maintain"
135 <> value 2
136 <> showDefault
137 )
138 <*> some (strArgument (
139 metavar "PATH [...]"
140 <> help "Path to one of the printers to use"
141 ))
142
143thermoprintApi :: Proxy ThermoprintApi
144thermoprintApi = Proxy
145
146main :: IO ()
147main = do
148 execParser opts >>= runNoLoggingT . main'
149 where
150 opts = info (helper <*> options) (
151 fullDesc
152 <> header "thermoprint-servant - A REST server for interacting with a cheap thermoprinter"
153 )
154 main' args@(Options{..}) = withSqlitePool (T.pack connStr) connNmbr $ main''
155 where
156 main'' cPool = do
157 runSqlPool (runMigration migrateAll) cPool
158 liftIO $ run port $ serve thermoprintApi (server args cPool)
diff --git a/servant/src/PrintOut.hs b/servant/src/PrintOut.hs
deleted file mode 100644
index 5f95a22..0000000
--- a/servant/src/PrintOut.hs
+++ /dev/null
@@ -1,14 +0,0 @@
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4module PrintOut
5 ( PrintOut
6 ) where
7
8import Thermoprint
9import Thermoprint.Api
10import Database.Persist.TH
11
12type PrintOut = Block String
13
14derivePersistFieldJSON "PrintOut"
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 01:45:08 +0000