diff --git a/content/Haskell/Code Snippets/Monoid.md b/content/Haskell/Code Snippets/Monoid.md index e60924a..289490e 100644 --- a/content/Haskell/Code Snippets/Monoid.md +++ b/content/Haskell/Code Snippets/Monoid.md @@ -2,7 +2,7 @@ Stellen wir uns vor, dass wir eine Funktion schreiben, die einen String bekommt (mehrere Lines mit ACSII-Text) und dieses Wort-für-Wort rückwärts ausgeben soll. Das ist ein einfacher Einzeiler: -~~~ { .haskell .numberLines } +~~~ { .haskell } module Main where import System.Environment (getArgs) diff --git a/content/Haskell/Lenses.md b/content/Haskell/Lenses.md index c172684..c9b91ad 100644 --- a/content/Haskell/Lenses.md +++ b/content/Haskell/Lenses.md @@ -8,7 +8,7 @@ Syntax nehmen. ### Beispiel -~~~ { .haskell .numberLines } +~~~ { .haskell } data Person = P { name :: String , addr :: Address , salary :: Int } @@ -38,7 +38,7 @@ Probleme mit diesem Code: ### Was wir gern hätten -~~~ { .haskell .numberLines } +~~~ { .haskell } data Person = P { name :: String , addr :: Address , salary :: Int } @@ -57,7 +57,7 @@ composeL :: Lens' s1 s2 -> Lens s2 a -> Lens' s1 a Mit diesen Dingen (wenn wir sie hätten) könnte man dann -~~~ { .haskell .numberLines } +~~~ { .haskell } data Person = P { name :: String , addr :: Address , salary :: Int } @@ -75,7 +75,7 @@ machen und wäre fertig. ### Getter/Setter als Lens-Methoden -~~~ { .haskell .numberLines } +~~~ { .haskell } data LensR s a = L { viewR :: s -> a , setR :: a -> s -> s } @@ -91,14 +91,14 @@ composeL (L v1 u1) (L v2 u2) Auslesen traversiert die Datenstruktur, dann wird die Funktion angewendet und zum setzen wird die Datenstruktur erneut traversiert: -~~~ { .haskell .numberLines } +~~~ { .haskell } over :: LensR s a -> (a -> a) -> s -> s over ln f s = setR l (f (viewR l s)) s ~~~~~~~~~~~~~~~~~~ - Lösung: modify-funktion hinzufügen -~~~ { .haskell .numberLines } +~~~ { .haskell } data LensR s a = L { viewR :: s -> a , setR :: a -> s -> s @@ -113,7 +113,7 @@ Neues Problem: Für jeden Spezialfall muss die Lens erweitert werden. Man kann alle Monaden abstrahieren. Functor reicht schon: -~~~ { .haskell .numberLines } +~~~ { .haskell } data LensR s a = L { viewR :: s -> a , setR :: a -> s -> s @@ -144,7 +144,7 @@ anders aussehen. ## Benutzen einer Lens als Setter -~~~ { .haskell .numberLines } +~~~ { .haskell } set :: Lens' s a -> (a -> s -> s) set ln a s = --...umm... --:t ln => (a -> f a) -> s -> f s @@ -154,7 +154,7 @@ set ln a s = --...umm... Wir können für f einfach die "Identity"-Monade nehmen, die wir nachher wegcasten können. -~~~ { .haskell .numberLines } +~~~ { .haskell } newtype Identity a = Identity a -- Id :: a -> Identity a @@ -167,7 +167,7 @@ instance Functor Identity where somit ist set einfach nur -~~~ { .haskell .numberLines } +~~~ { .haskell } set :: Lens' s a -> (a -> s -> s) set ln x s = runIdentity (ls set_fld s) @@ -197,7 +197,7 @@ over ln f = runIdentity . ln (Identity . f) ## Benutzen einer Lens als Getter -~~~ { .haskell .numberLines } +~~~ { .haskell } view :: Lens' s a -> (s -> a) view ln s = --...umm... --:t ln => (a -> f a) -> s -> f s @@ -208,7 +208,7 @@ view ln s = --...umm... Auch hier gibt es einen netten Funktor. Wir packen das "a" einfach in das "f" und werfen das "s" am Ende weg. -~~~ { .haskell .numberLines } +~~~ { .haskell } newtype Const v a = Const v getConst :: Const v a -> v @@ -221,7 +221,7 @@ instance Functor (Const v) where somit ergibt sich -~~~ { .haskell .numberLines } +~~~ { .haskell } view :: Lens' s a -> (s -> a) view ln s = getConst (ln Const s) @@ -246,7 +246,7 @@ type Lens' s a = forall f. Functor f Für unser Personen-Beispiel vom Anfang: -~~~ { .haskell .numberLines } +~~~ { .haskell } data Person = P { _name :: String, _salary :: Int } name :: Lens' Person String @@ -270,7 +270,7 @@ name elt_fn (P n s) ## Wie funktioniert das intern? -~~~ { .haskell .numberLines } +~~~ { .haskell } view name (P {_name="Fred", _salary=100}) -- inline view-function = getConst (name Const (P {_name="Fred", _salary=100}) @@ -312,7 +312,7 @@ Somit ist Lens-Composition einfach nur Function-Composition (.). Der Code um die Lenses zu bauen ist für records immer Identisch: -~~~ { .haskell .numberLines } +~~~ { .haskell } data Person = P { _name :: String, _salary :: Int } name :: Lens' Person String @@ -321,7 +321,7 @@ name elt_fn (P n s) = (\n' -> P n' s) <$> (elt_fn n) Daher kann man einfach -~~~ { .haskell .numberLines } +~~~ { .haskell } import Control.Lens.TH data Person = P { _name :: String, _salary :: Int } @@ -336,7 +336,7 @@ Will man das aber haben, muss man selbst in den Control.Lens.TH-Code schauen. ## Lenses für den Beispielcode -~~~ { .haskell .numberLines } +~~~ { .haskell } import Control.Lens.TH data Person = P { _name :: String @@ -355,7 +355,7 @@ setPostcode pc p = set (addr . postcode) pc p ## Shortcuts mit "Line-Noise" -~~~ { .haskell .numberLines } +~~~ { .haskell } -- ... setPostcode :: String -> Person -> Person @@ -375,7 +375,7 @@ Listenkonvertierungen, -traversierungen, ...) Man kann mit Lenses sogar Felder emulieren, die gar nicht da sind. Angenommen folgender Code: -~~~ { .haskell .numberLines } +~~~ { .haskell } data Temp = T { _fahrenheit :: Float } $(makeLenses ''Temp) @@ -399,7 +399,7 @@ Minuten oder 37 Stunden ist) Das ganze kann man auch parametrisieren und auf Non-Record-Strukturen anwenden. Beispielhaft an einer Map verdeutlicht: -~~~ { .haskell .numberLines } +~~~ { .haskell } -- from Data.Lens.At at :: Ord k => k -> Lens' (Map k v) (Maybe v) @@ -425,7 +425,7 @@ at k mb_fn m - Bitfields auf Strukturen die Bits haben (Ints, ...) in Data.Bits.Lens - Web-scraper in Package hexpat-lens - ~~~ { .haskell .numberLines } + ~~~ { .haskell } p ^.. _HTML' . to allNodes . traverse . named "a" . traverse . ix "href" @@ -441,7 +441,7 @@ at k mb_fn m Bisher hatten wir Lenses nur auf Funktoren F. Die nächstmächtigere Klasse ist Applicative. -~~~ { .haskell .numberLines } +~~~ { .haskell } type Traversal' s a = forall f. Applicative f => (a -> f a) -> (s -> f s) ~~~~~~~~~~~~~~~~~~ @@ -452,7 +452,7 @@ etwas anderes ändern. Statt eines einzelnen Focus erhalten wir viele Foci. Was ist ein Applicative überhaupt? Eine schwächere Monade (nur 1x Anwendung und kein Bind - dafür kann man die beliebig oft hintereinanderhängen). -~~~ { .haskell .numberLines } +~~~ { .haskell } class Functor f => Applicative f where pure :: a -> f a (<*>) :: f (a -> b) -> f a -> f b @@ -464,7 +464,7 @@ mf <*> mx = do { f <- mf; x <- mx; return (f x) } Recap: Was macht eine Lens: -~~~ { .haskell .numberLines } +~~~ { .haskell } data Adress = A { _road :: String , _city :: String , _postcode :: String } @@ -476,7 +476,7 @@ road elt_fn (A r c p) = (\r' -> A r' c p) <$> (elt_fn r) Wenn man nun road & city gleichzeitig bearbeiten will: -~~~ { .haskell .numberLines } +~~~ { .haskell } addr_strs :: Traversal' Address String addr_strs elt_fn (A r c p) = ... (\r' c' -> A r' c' p) .. (elt_fn r) .. (elt_fn c) .. @@ -487,7 +487,7 @@ fmap kann nur 1 Loch stopfen, aber nicht mit n Löchern umgehen. Applicative mit <*> kann das. Somit gibt sich -~~~ { .haskell .numberLines } +~~~ { .haskell } addr_strs :: Traversal' Address String addr_strs elt_fn (A r c p) = pure (\r' c' -> A r' c' p) <*> (elt_fn r) <*> (elt_fn c) @@ -551,7 +551,7 @@ Die modify-Funktion over ist auch Lens alleine definiert 39 newtypes, 34 data-types und 194 Typsynonyme... Ausschnitt -~~~ { .haskell .numberLines } +~~~ { .haskell } -- traverseOf :: Functor f => Iso s t a b -> (a -> f b) -> s -> f t -- traverseOf :: Functor f => Lens s t a b -> (a -> f b) -> s -> f t -- traverseOf :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t diff --git a/content/Haskell/Webapp-Example.md b/content/Haskell/Webapp-Example.md new file mode 100644 index 0000000..085f557 --- /dev/null +++ b/content/Haskell/Webapp-Example.md @@ -0,0 +1,311 @@ +# Webapp-Development in Haskell + +Step-by-Step-Anleitung, wie man ein neues Projekt mit einer bereits erprobten +Pipeline erstellt. + +## Definition der API + +Erster Schritt ist immer ein wünsch-dir-was bei der Api-Defenition. + +Die meisten Services haben offensichtliche Anforderungen (Schnittstellen nach +draußen, Schnittstellen intern, ...). Diese kann man immer sehr gut in einem +`Request -> Response`-Model erfassen. + +Diese Definition läuft über openapi-v3 und kann z.b. mit Echtzeit-Vorschau im +http://editor.swagger.io/ erspielen. Per Default ist der noch auf openapi-v2 +(aka swagger), kann aber auch v3. + +Nach der Definition, was man am Ende haben möchte, muss man sich entscheiden, in +welcher Sprache man weiter entwickelt. Ich empfehle aus verschiedenen Gründen +primär 2 Sprachen: Python-Microservices (weil die ML-Libraries sehr gut sind, +allerdings Änderungen meist schwer sind und der Code wenig robust - meist nur 1 +API-Endpunkt pro service) und Haskell (stabilität, performace, leicht zu ändern, +gut anzupassen). + +Im folgenden wird (aus offensichtlichen Gründen) nur auf das Haskell-Projekt eingegangen. + +## Startprojekt in Haskell + +### Erstellen eines neuen Projektes + +Zunächst erstellen wir in normales Haskell-Projekt ohne funktionalität & firlefanz: + +```bash +stack new myservice +``` + +Dies erstellt ein neues Verzeichnis und das generelle scaffolding. +Nach einer kurzen anpassung der stack.yaml (resolver auf unserer setzen; +aktuell: lts-17.4) fügen wir am Ende der Datei + +```yaml +allow-newer: true +ghc-options: + "$locals": -fwrite-ide-info +``` + +ein. +Anschließend organisieren™ wir uns noch eine gute `.gitignore` und initialisieren +das git mittels `git init; git add .; git commit -m "initial scaffold"` + +### Generierung der API + +Da die API immer wieder neu generiert werden kann (und sollte!) liegt sich in +einem unterverzeichnis des Haputprojektes. + +Initial ist es das einfachste ein leeres temporäres Verzeichnis woanders zu +erstellen, die `api-doc.yml` hinein kopieren und folgendes ausführen: + +```bash +openapi-generator generate -g haskell -o . -i api-doc.yml +``` + +Dieses erstellt einem dann eine komplette library inkl. Datentypen. +Wichtig: Der Name in der api-doc sollte vom Namen des Services (oben myservice) +abweichen - entweder in Casing oder im Namen direkt. Suffixe wie API schneidet +der Generator hier leider ab. +(Wieso das ganze? Es entstehen nachher 2 libraries, foo & fooAPI. Da der +generator das API abschneidet endet man mit foo & foo und der compiler meckert, +dass er nicht weiss, welche lib gemeint ist). + +danach: wie gewohnt `git init; git add .; git commit -m "initial"`. Auf dem +Server der Wahl (github, gitea, gitlab, ...) nun ein Repository erstellen (am +Besten: myserviceAPI - alles auf API endend ist autogeneriert!) und den +Anweisungen nach ein remote hinzufügen & pushen. + +#### Wieder zurück im Haskell-Service + +In unserem eigentlichen Service müssen wir nun die API einbinden. +Dazu erstellen wir ein Verzeichnis `libs` (konvention) und machen ein `git +submodule add libs/myserviceAPI` + +Git hat nun die API in das submodul gepackt und wir können das oben erstellte +temporäre verzeichnis wieder löschen. + +Anschließend müssen wir stack noch erklären, dass wir die API da nun liegen +haben und passen wieder die stack.yaml an, indem wir das Verzeichnis unter +packages hinzufügen. + +```yaml +packages: +- . +- libs/myserviceAPI # << +``` + +nun können wir in der `package.yaml` (oder `myservice.cabal`, falls kein hpack +verwendet wird) unter den dependencies unsere api hinzufügen (name wie die +cabal-datei in libs/myserviceAPI). + +### Einbinden anderer Microservices + +Funktioniert komplett analog zu dem vorgehen oben (ohne das generieren natürlich +:grin:). +`stack.yaml` editieren und zu den packages hinzufügen: + +```yaml +packages: +- . +- libs/myserviceAPI +- libs/myCoolMLServiceAPI +``` + +in der `package.yaml` (oder der cabal) die dependencies hinzufügen und schon +haben wir die Features zur Verfügung und können gegen diese Services reden. + +### Entfernen von anderen Technologien/Microservices + +In git ist das entfernen von Submodules etwas frickelig, daher hier ein +copy&paste der +[GitHub-Antwort](https://gist.github.com/myusuf3/7f645819ded92bda6677): + +```bash +## Remove the submodule entry from .git/config +git submodule deinit -f path/to/submodule + +## Remove the submodule directory from the superproject's .git/modules directory +rm-rf .git/modules/path/to/submodule + +## Remove the entry in .gitmodules and remove the submodule directory located at path/to/submodule +git rm-f path/to/submodule +``` + +Falls das nicht klappt, gibt es alternative Vorschläge unter dem Link oben. + +### Woher weiss ich, was wo liegt? Dokumentation? Halloo?? + +Keine Panik. Ein `stack haddock --open` hilft da. Das generiert die +Dokumentation für alle in der `package.yaml` (oder cabal-file) eingetragenen +dependencies inkl. aller upstream-dependencies. Man bekommt also eine komplette +lokale Dokumentation von allem. Geöffnet wird dann die Paket-Startseite inkl. +der direkten dependencies: + +Es gibt 2 wichtige Pfade im Browser: + +- ...../all/index.html - hier sind alle Pakete aufgeführt +- ...../index.html - hier sind nur die direkten dependencies aufgeführt. + +Wenn man einen lokalen Webserver startet kann man mittels "s" auch die +interaktive Suche öffnen (Suche nach Typen, Funktionen, Signaturen, etc.). In +Bash mit python3 geht das z.b. einfach über: + +```bash +cd $(stack path --local-doc-root) +python3 -m SimpleHTTPServer 8000 +firefox "http://localhost:8000" +``` + +### Implementation des Services und Start + +#### Loader/Bootstrapper + +Generelles Vorgehen: + +- in app/Main.hs: + Hier ist quasi immer nur eine Zeile drin: `main = myServiceMain` + + Grund: Applications tauchen nicht im Haddock auf. Also haben wir ein + "src"-Modul, welches hier nur geladen & ausgeführt wird. +- in src/MyService.hs: + `myServiceMain :: IO ()` definieren + +Für die Main kann man prinzipiell eine Main andere Services copy/pasten. Im +folgenden eine Annotierte main-Funktion - zu den einzelnen Vorraussetzungen +kommen wir im Anschluss. + +![[Main.hs#]] + +#### Weitere Instanzen und Definitionen, die der Generator (noch) nicht macht + +In der `Myservice.Types` werden ein paar hilfreiche Typen und Typinstanzen +definiert. Im Folgenden geht es dabei um Dinge für: + +- Envy + - Laden von \$ENV_VAR in Datentypen + - Definitionen für Default-Settings +- ServerConfig + - Definition der Server-Konfiguration & Benennung der Environment-Variablen +- ExtraTypes + - ggf. Paketweite extra-Typen, die der Generator nicht macht, weil sie nicht + aus der API kommen (z.B. cache) +- Out/BSON-Instanzen + - Der API-Generator generiert nur wenige Instanzen automatisch (z.B. Aeson), + daher werden hier die fehlenden definiert. + - BSON: Kommunakation mit MongoDB + - Out: pretty-printing im Log + +![[MyService_Types.hs#]] + +#### Was noch zu tun ist + +Den Service implementieren. Einfach ein neues Modul aufmachen (z.B. +`MyService.Handler` oder +`MyService.DieserEndpunktbereich`/`MyService.JenerEndpunktbereich`) und dort die +Funktion implementieren, die man in der `Main.hs` benutzt hat. +In dem Handler habt ihr dann keinen Stress mehr mit validierung, networking, +logging, etc. pp. weil alles in der Main abgehandelt wurde und ihr nur noch den +"Happy-Case" implementieren müsst. +Beispiel für unseren Handler oben: + +```haskell +myApiEndpointV1Post :: MonadIO m => ServerConfig -> (ClientEnv,ClientEnv) -> TQueue BS.ByteString -> ([LogItem] -> IO ()) -> Request -> m Response +myApiEndpointV1Post sc calls amqPost log req = do + liftIO . log $ [Info $ "recieved "<>pretty req] -- input-logging + liftIO . atomically . writeTQueue . LBS.toStrict $ "{\"hey Kibana, i recieved:\"" <> A.encode (pretty req) <> "}" -- log in activeMQ/Kibana + + + --- .... gaaaanz viel komplizierter code um die Response zu erhalten ;) + let ret = Response 1337 Nothing -- dummy-response ;) + -- gegeben wir haben eine gültige mongodb-pipe; + -- mehr logik will ich in die Beispiele nicht packen. + -- Man kann die z.b. als weiteren Wert in einer TMVar (damit man sie ändern & updaten kann) an die Funktion übergeben. + liftIO . access pipe master "DatabaseName" $ do + ifM (auth (myServiceMongoUsername sc) (myServiceMongoPassword sc)) (return ()) (liftIO . printLog . pure . Error $ "MongoDB: Login failed.") + save "DatabaseCollection" ["_id" =: 1337, "entry" =: ret] -- selbe id wie oben ;) + return ret +``` + +Diese dummy-Antwort führt auf, wie gut man die ganzen Sachen mischen kann. + +- Logging in die Dateien/stdout nach config +- Logging von Statistiken in Kibana +- Speichern der Antwort in der MongoDB +- Generieren einer Serverantwort und ausliefern dieser über die Schnittstelle + +#### Tipps & Tricks + +##### Dateien, die statisch ausgeliefert werden sollen + +Hierzu erstellt man ein Verzeichnis `static/` (konvention; ist im generator so +generiert, dass das ausgeliefert wird). Packt man hier z.b. eine `index.html` +rein, erscheint die, wenn man den Service ansurft. + +##### Wie bekomme ich diese fancy Preview hin? + +Der Editor, der ganz am Anfang zum Einsatz gekommen ist, braucht nur die +`api-doc.yml` um diese Ansicht zu erzeugen. Daher empfielt sich hier ein +angepasster Fork davon indem die Pfade in der index.html korrigiert sind. Am +einfachsten (und von den meisten services so benutzt): In meiner Implementation +liegt dann nach dem starten auf http://localhost:PORT/ui/ und kann direkt dort +getestet werden. + +##### Wie sorge ich für bessere Warnungen, damit der Compiler meine Bugs fängt? + +```bash +stack build --file-watch --ghc-options '-freverse-errors -W -Wall -Wcompat' --interleaved-output +``` + +Was tut das? + +- `--file-watch`: automatisches (minimales) kompilieren bei dateiänderungen +- `--ghc-options` + - `-freverse-errors`: Fehlermeldungen in umgekehrter Reihenfolge (Erster + Fehler ganz unten; wenig scrollen ) + - `-W`: Warnungen an + - `-Wall`: Alle sinnvollen Warnungen an (im gegensatz zu `-Weverything`, was + WIRKLICH alles ist ) + - `-Wcompat`: Warnungen für Sachen, die in der nächsten Compilerversion kaputt + brechen werden & vermieden werden sollten +- `--interleaved-output`: stack-log direkt ausgeben & nicht in dateien schreiben + und die dann am ende zusammen cat\'en. + +Um pro Datei Warnungen auszuschalten (z.B. weil man ganz sicher weiss, was man +tut -.-): `{-# OPTIONS_GHC -Wno-whatsoever #-}` als Pragma in die Datei. + +**Idealerweise sollte das Projekt keine Warnungen erzeugen.** + +### Deployment + +Als Beispiel sei hier ein einfaches Docker-Build mit Jenkins-CI gezeigt, weil +ich das aus Gründen rumliegen hatte. Kann man analog in fast alle anderen CI +übrsetzen. + +#### Docker + +Die angehängten Scripte gehen von einer Standard-Einrichtung aus (statische +sachen in static, 2-3 händische Anpassungen auf das eigene Projekt nach +auspacken). Nachher liegt dann auch unter static/version die gebaute +Versionsnummer & kann abgerufen werden. In der Dockerfile.release und der +Jenkinsfile müssen noch anpassungen gemacht werden. Konkret: + +- in der Dockerfile.release: alle `<<>>`-Stellen sinnvoll befüllen +- in der Jenkinsfile die defs für "servicename" und "servicebinary" ausfüllen. + Binary ist das, was bei stack exec aufgerufen wird; name ist der Image-Name + für das docker-repository. + +#### Jenkins + +Änderungen die dann noch gemacht werden müssen: + +- git-repository url anpassen +- Environment-Vars anpasses ($BRANCH = test & live haben keine zusatzdinger im + docker-image-repository; ansonsten hat das image $BRANCH im namen) + +Wenn das durchgebaut ist, liegt im test/live-repository ein docker-image namens `servicename:version`. + +### OMG! Ich muss meine API ändern. Was mache ich nun? + +1. api-doc.yml bearbeiten, wie gewünscht +2. mittels generator die Api & submodule neu generieren +3. ggf. custom Änderungen übernehmen (:Gitdiffsplit hilft) +4. Alle Compilerfehler + Warnungen in der eigentlichen Applikation fixen +5. If it comipilez, ship it! (Besser nicht :grin:) diff --git a/content/Haskell/Webapp-Example/Main.hs.md b/content/Haskell/Webapp-Example/Main.hs.md new file mode 100644 index 0000000..0ce93ed --- /dev/null +++ b/content/Haskell/Webapp-Example/Main.hs.md @@ -0,0 +1,188 @@ +# Webapp-Example: Main.hs + +Wie man das verwendet, siehe #[[Webapp-Example]]. + +```haskell +{-# OPTIONS_GHC -Wno-name-shadowing #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +module MyService where + +-- generische imports aus den dependencies/base, nicht in der prelude +import Codec.MIME.Type +import Configuration.Dotenv as Dotenv +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.Async +import Control.Concurrent.STM +import Control.Monad +import Control.Monad.Catch +import Control.Monad.Except +import Conversion +import Conversion.Text () +import Data.Binary.Builder +import Data.String (IsString (..)) +import Data.Time +import Data.Time.Clock +import Data.Time.Format +import Data.Default +import Network.HostName +import Network.HTTP.Client as HTTP hiding + (withConnection) +import Network.HTTP.Types (Status, statusCode) +import Network.Mom.Stompl.Client.Queue +import Network.Wai (Middleware) +import Network.Wai.Logger +import Network.Wai.Middleware.Cors +import Network.Wai.Middleware.RequestLogger (OutputFormat (..), + logStdout, + mkRequestLogger, + outputFormat) +import Servant.Client (mkClientEnv, + parseBaseUrl) +import System.Directory +import System.Envy +import System.IO +import System.Log.FastLogger +import Text.PrettyPrint.GenericPretty + +-- generische imports, aber qualified, weil es sonst zu name-clashes kommt + +import qualified Data.ByteString as BS +-- import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as LBS +import qualified Network.HTTP.Client.TLS as UseDefaultHTTPSSettings (tlsManagerSettings) +import qualified Network.Mom.Stompl.Client.Queue as AMQ +import qualified Network.Wai as WAI + +-- Handler für den MyServiceBackend-Typen und Imports aus den Libraries +import MyService.Handler as H -- handler der H.myApiEndpointV1Post implementiert +import MyService.Types -- weitere Type (s. nächste box) +import MyServiceGen.API as MS -- aus der generierten library + + +myServicemain :: IO () +myServicemain = do + -- .env-Datei ins Prozess-Environment laden, falls noch nicht von außen gesetzt + void $ loadFile $ Dotenv.Config [".env"] [] False + -- Config holen (defaults + overrides aus dem Environment) + sc@ServerConfig{..} <- decodeWithDefaults defConfig + -- Backend-Setup + -- legt sowas wie Proxy-Server fest und wo man wie dran kommt. Benötigt für das Sprechen mit anderen Microservices + let defaultHTTPSSettings = UseDefaultHTTPSSettings.tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro $ 1000 * 1000 * myserviceMaxTimeout } + createBackend url proxy = do + manager <- newManager . managerSetProxy proxy + $ defaultHTTPSSettings + url' <- parseBaseUrl url + return (mkClientEnv manager url') + internalProxy = case myserviceInternalProxyUrl of + "" -> noProxy + url -> useProxy $ HTTP.Proxy (fromString url) myserviceInternalProxyPort + -- externalProxy = case myserviceExternalProxyUrl of + -- "" -> noProxy + -- url -> useProxy $ HTTP.Proxy (fromString url) myserviceExternalProxyPort + + -- Definieren & Erzeugen der Funktionen um die anderen Services anzusprechen. + calls <- (,) + <$> createBackend myserviceAUri internalProxy + <*> createBackend myserviceBUri internalProxy + + -- Logging-Setup + hSetBuffering stdout LineBuffering + hSetBuffering stderr LineBuffering + + + -- Infos holen, brauchen wir später + myName <- getHostName + today <- formatTime defaultTimeLocale "%F" . utctDay <$> getCurrentTime + + + -- activeMQ-Transaktional-Queue zum schreiben nachher vorbereiten + amqPost <- newTQueueIO + + + -- bracket a b c == erst a machen, ergebnis an c als variablen übergeben. Schmeisst c ne exception/wird gekillt/..., werden die variablen an b übergeben. + bracket + -- logfiles öffnen + (LogFiles <$> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".info") AppendMode + <*> openFile (if myserviceDebug then "/logs/myservice-"<>myName<>"-"<>today<>".debug" else "/dev/null") AppendMode + <*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".error") AppendMode + <*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".timings") AppendMode + ) + -- und bei exception/beendigung schlißen.h + (\(LogFiles a b c d) -> mapM_ hClose [a,b,c,d]) + $ \logfiles -> do + + + -- logschreibe-funktionen aliasen; log ist hier abstrakt, iolog spezialisiert auf io. + let log = printLogFiles logfiles :: MonadIO m => [LogItem] -> m () + iolog = printLogFilesIO logfiles :: [LogItem] -> IO () + + + -- H.myApiEndpointV1Post ist ein Handler (alle Handler werden mit alias H importiert) und in einer eigenen Datei + -- Per Default bekommen Handler sowas wie die server-config, die Funktionen um mit anderen Services zu reden, die AMQ-Queue um ins Kibana zu loggen und eine Datei-Logging-Funktion + -- Man kann aber noch viel mehr machen - z.b. gecachte Daten übergeben, eine Talk-Instanz, etc. pp. + server = MyServiceBackend{ myApiEndpointV1Post = H.myApiEndpointV1Post sc calls amqPost log + } + config = MS.Config $ "http://" ++ myserviceHost ++ ":" ++ show myservicePort ++ "/" + iolog . pure . Info $ "Using Server configuration:" + iolog . pure . Info $ pretty sc { myserviceActivemqPassword = "******" -- Do NOT log the password ;) + , myserviceMongoPassword = "******" + } + -- alle Services starten (Hintergrund-Aktionen wie z.b. einen MongoDB-Dumper, einen Talk-Server oder wie hier die ActiveMQ + void $ forkIO $ keepActiveMQConnected sc iolog amqPost + -- logging-Framework erzeugen + loggingMW <- loggingMiddleware + -- server starten + if myserviceDebug + then runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]})) . loggingMW . logStdout) server + else runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]}))) server + + +-- Sollte bald in die Library hs-stomp ausgelagert werden +-- ist ein Beispiel für einen ActiveMQ-Dumper +keepActiveMQConnected :: ServerConfig -> ([LogItem] -> IO ()) -> TQueue BS.ByteString -> IO () +keepActiveMQConnected sc@ServerConfig{..} printLog var = do + res <- handle (\(e :: SomeException) -> do + printLog . pure . Error $ "Exception in AMQ-Thread: "<>show e + return $ Right () + ) $ AMQ.try $ do -- catches all AMQ-Exception that we can handle. All others bubble up. + printLog . pure . Info $ "AMQ: connecting..." + withConnection myserviceActivemqHost myserviceActivemqPort [ OAuth myserviceActivemqUsername myserviceActivemqPassword + , OTmo (30*1000) {- 30 sec timeout -} + ] + [] $ \c -> do + let oconv = return + printLog . pure . Info $ "AMQ: connected" + withWriter c "Chaos-Logger for Kibana" "chaos.logs" [] [] oconv $ \writer -> do + printLog . pure . Info $ "AMQ: queue created" + let postfun = writeQ writer (Type (Application "json") []) [] + void $ race + (forever $ atomically (readTQueue var) >>= postfun) + (threadDelay (600*1000*1000)) -- wait 10 Minutes + -- close writer + -- close connection + -- get outside of all try/handle/...-constructions befor recursing. + case res of + Left ex -> do + printLog . pure . Error $ "AMQ: "<>show ex + keepActiveMQConnected sc printLog var + Right _ -> keepActiveMQConnected sc printLog var + + +-- Beispiel für eine Custom-Logging-Middleware. +-- Hier werden z.B. alle 4xx-Status-Codes inkl. Payload ins stdout-Log geschrieben. +-- Nützlich, wenn die Kollegen ihre Requests nicht ordentlich schreiben können und der Server das Format zurecht mit einem BadRequest ablehnt ;) +loggingMiddleware :: IO Middleware +loggingMiddleware = liftIO $ mkRequestLogger $ def { outputFormat = CustomOutputFormatWithDetails out } + where + out :: ZonedDate -> WAI.Request -> Status -> Maybe Integer -> NominalDiffTime -> [BS.ByteString] -> Builder -> LogStr + out _ r status _ _ payload _ + | statusCode status < 300 = "" + | statusCode status > 399 && statusCode status < 500 = "Error code "<>toLogStr (statusCode status) <>" sent. Request-Payload was: "<> mconcat (toLogStr <$> payload) <> "\n" + | otherwise = toLogStr (show r) <> "\n" + +``` diff --git a/content/Haskell/Webapp-Example/MyService_Types.hs.md b/content/Haskell/Webapp-Example/MyService_Types.hs.md new file mode 100644 index 0000000..ef56fc7 --- /dev/null +++ b/content/Haskell/Webapp-Example/MyService_Types.hs.md @@ -0,0 +1,83 @@ +# Webapp-Example: MyService/Types.hs + +Anleitung siehe #[[Webapp-Example]]. + +```haskell +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +module MyService.Types where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text +import Data.Time.Clock +import GHC.Generics +import System.Envy +import Text.PrettyPrint (text) +import Text.PrettyPrint.GenericPretty + +-- Out hat hierfür keine Instanzen, daher kurz eine einfach Definition. +instance Out Text where + doc = text . unpack + docPrec i a = text $ showsPrec i a "" + +instance Out UTCTime where + doc = text . show + docPrec i a = text $ showsPrec i a "" + +-- Der ServerConfig-Typ. Wird mit den defaults unten initialisiert, dann mit den Variablen aus der .env-Datei überschrieben und zum Schluss können Serveradmins diese via $MYSERVICE_FOO nochmal überschreiben. +data ServerConfig = ServerConfig + { myserviceHost :: String -- ^ Environment: $MYSERVICE_HOST + , myservicePort :: Int -- ^ Environment: $MYSERVICE_PORT + , myserviceMaxTimeout :: Int -- ^ Environment: $MYSERVICE_MAX_TIMEOUT + , myserviceInternalProxyUrl :: String -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_URL + , myserviceInternalProxyPort :: Int -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_PORT + , myserviceExternalProxyUrl :: String -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_URL + , myserviceExternalProxyPort :: Int -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_PORT + , myserviceActivemqHost :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_HOST + , myserviceActivemqPort :: Int -- ^ Environment: $MYSERVICE_ACTIVEMQ_PORT + , myserviceActivemqUsername :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_USERNAME + , myserviceActivemqPassword :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_PASSWORD + , myserviceMongoUsername :: String -- ^ Environment: $MYSERVICE_MONGO_USERNAME + , myserviceMongoPassword :: String -- ^ Environment: $MYSERVICE_MONGO_PASSWORD + , myserviceDebug :: Bool -- ^ Environment: $MYSERVICE_DEBUG + } deriving (Show, Eq, Generic) + +-- Default-Konfigurations-Instanz für diesen Service. +instance DefConfig ServerConfig where + defConfig = ServerConfig "0.0.0.0" 8080 20 + "" + "" + "" + 0 + "" + 0 + "" + 0 + "" + "" + "" + "" + False + +-- Kann auch aus dem ENV gefüllt werden +instance FromEnv ServerConfig +-- Und hübsch ausgegeben werden. +instance Out ServerConfig + + +instance Out Response +instance FromBSON Repsonse -- FromBSON-Instanz geht immer davon aus, dass alle keys da sind (ggf. mit null bei Nothing). +``` diff --git a/content/Haskell/Webapp_Development.md b/content/Haskell/Webapp_Development.md deleted file mode 100644 index 9318b1b..0000000 --- a/content/Haskell/Webapp_Development.md +++ /dev/null @@ -1,503 +0,0 @@ -# Webapp-Development in Haskell - -Step-by-Step-Anleitung, wie man ein neues Projekt mit einer bereits erprobten Pipeline erstellt. - -## Definition der API - -Erster Schritt ist immer ein wünsch-dir-was bei der Api-Defenition. - -Die meisten Services haben offensichtliche Anforderungen (Schnittstellen nach draußen, Schnittstellen intern, ...). Diese kann man immer sehr gut in einem `Request -> Response`-Model erfassen. - -Diese Definition läuft über openapi-v3 und kann z.b. mit Echtzeit-Vorschau im http://editor.swagger.io/ erspielen. Per Default ist der noch auf openapi-v2 (aka swagger), kann aber auch v3. - -Nach der Definition, was man am Ende haben möchte, muss man sich entscheiden, in welcher Sprache man weiter entwickelt. Ich empfehle aus verschiedenen Gründen primär 2 Sprachen: Python-Microservices (weil die ML-Libraries sehr gut sind, allerdings Änderungen meist schwer sind und der Code wenig robust - meist nur 1 API-Endpunkt pro service) und Haskell (stabilität, performace, leicht zu ändern, gut anzupassen). - -Im folgenden wird (aus offensichtlichen Gründen) nur auf das Haskell-Projekt eingegangen. - -## Startprojekt in Haskell - -### Erstellen eines neuen Projektes - -zunächst erstellen wir in normales Haskell-Projekt ohne funktionalität & firlefanz: - -```bash -stack new myservice -``` - -Dies erstellt ein neues Verzeichnis und das generelle scaffolding. -Nach einer kurzen anpassung der stack.yaml (resolver auf unserer setzen; aktuell: lts-17.4) fügen wir am Ende der Datei - -```yaml -allow-newer: true -ghc-options: - "$locals": -fwrite-ide-info -``` - -ein. -Anschließend organisieren wir uns noch eine gute `.gitignore` und initialisieren das git mittels `git init; git add .; git commit -m "initial scaffold"` - -### Generierung der API - -Da die API immer wieder neu generiert werden kann (und sollte!) liegt sich in einem unterverzeichnis des Haputprojektes. - -Initial ist es das einfachste ein leeres temporäres Verzeichnis woanders zu erstellen, die `api-doc.yml` hinein kopieren und folgendes ausführen: - -```bash -openapi-generator generate -g haskell -o . -i api-doc.yml -``` - -Dieses erstellt einem dann eine komplette library inkl. Datentypen. -Wichtig: Der Name in der api-doc sollte vom Namen des Services (oben myservice) abweichen - entweder in Casing oder im Namen direkt. Suffixe wie API schneidet der Generator hier leider ab. -(Wieso das ganze? Es entstehen nachher 2 libraries, foo & fooAPI. Da der generator das API abschneidet endet man mit foo & foo und der compiler meckert, dass er nicht weiss, welche lib gemeint ist). - -danach: wie gewohnt `git init; git add .; git commit -m "initial"`. Auf dem Server der Wahl (github, gitea, gitlab, ...) nun ein Repository erstellen (am Besten: myserviceAPI - alles auf API endend ist autogeneriert!) und den Anweisungen nach ein remote hinzufügen & pushen. - -#### Wieder zurück im Haskell-Service - -In unserem eigentlichen Service müssen wir nun die API einbinden. -Dazu erstellen wir ein Verzeichnis `libs` (konvention) und machen ein `git submodule add libs/myserviceAPI` - -Git hat nun die API in das submodul gepackt und wir können das oben erstellte temporäre verzeichnis wieder löschen. - -Anschließend müssen wir stack noch erklären, dass wir die API da nun liegen haben und passen wieder die stack.yaml an, indem wir das Verzeichnis unter packages hinzufügen. - -```yaml -packages: -- . -- libs/myserviceAPI # << -``` -nun können wir in der `package.yaml` (oder `myservice.cabal`, falls kein hpack verwendet wird) unter den dependencies unsere api hinzufügen (name wie die cabal-datei in libs/myserviceAPI). - -### Einbinden anderer Microservices - -Funktioniert komplett analog zu dem vorgehen oben (ohne das generieren natürlich ;) ). -`stack.yaml` editieren und zu den packages hinzufügen: - -```yaml -packages: -- . -- libs/myserviceAPI -- libs/myCoolMLServiceAPI -``` - -in der `package.yaml` (oder der cabal) die dependencies hinzufügen und schon haben wir die Features zur Verfügung und können gegen diese Services reden. - -### Entfernen von anderen Technologien/Microservices - -In git ist das entfernen von Submodules etwas frickelig, daher hier ein copy&paste der [GitHub-Antwort](https://gist.github.com/myusuf3/7f645819ded92bda6677): - -```bash -## Remove the submodule entry from .git/config -git submodule deinit -f path/to/submodule - -## Remove the submodule directory from the superproject's .git/modules directory -rm-rf .git/modules/path/to/submodule - -## Remove the entry in .gitmodules and remove the submodule directory located at path/to/submodule -git rm-f path/to/submodule -``` - -Falls das nicht klappt, gibt es alternative Vorschläge unter dem Link oben. - -### Woher weiss ich, was wo liegt? Dokumentation? Halloo?? - -Keine Panik. Ein `stack haddock --open` hilft da. Das generiert die Dokumentation für alle in der `package.yaml` (oder cabal-file) eingetragenen dependencies inkl. aller upstream-dependencies. Man bekommt also eine komplette lokale Dokumentation von allem. Geöffnet wird dann die Paket-Startseite inkl. der direkten dependencies: - -Es gibt 2 wichtige Pfade im Browser: - -- ...../all/index.html - hier sind alle Pakete aufgeführt -- ...../index.html - hier sind nur die direkten dependencies aufgeführt. - -Wenn man einen lokalen Webserver startet kann man mittels "s" auch die interaktive Suche öffnen (Suche nach Typen, Funktionen, Signaturen, etc.). In Bash mit python3 geht das z.b. einfach über: - -```bash -cd $(stack path --local-doc-root) -python3 -m SimpleHTTPServer 8000 -firefox "http://localhost:8000" -``` - -### Implementation des Services und Start - -#### Loader/Bootstrapper - -Generelles Vorgehen: -- in app/Main.hs: - Hier ist quasi immer nur eine Zeile drin: `main = myServiceMain` - - Grund: Applications tauchen nicht im Haddock auf. Also haben wir ein "src"-Modul, welches hier nur geladen & ausgeführt wird. -- in src/MyService.hs: - `myServiceMain :: IO ()` definieren - -Für die Main kann man prinzipiell eine Main andere Services copy/pasten. Im folgenden eine Annotierte main-Funktion - zu den einzelnen Vorraussetzungen kommen wir im Anschluss. - -```haskell -{-# OPTIONS_GHC -Wno-name-shadowing #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -module MyService where - --- generische imports aus den dependencies/base, nicht in der prelude -import Codec.MIME.Type -import Configuration.Dotenv as Dotenv -import Control.Concurrent (forkIO, threadDelay) -import Control.Concurrent.Async -import Control.Concurrent.STM -import Control.Monad -import Control.Monad.Catch -import Control.Monad.Except -import Conversion -import Conversion.Text () -import Data.Binary.Builder -import Data.String (IsString (..)) -import Data.Time -import Data.Time.Clock -import Data.Time.Format -import Data.Default -import Network.HostName -import Network.HTTP.Client as HTTP hiding - (withConnection) -import Network.HTTP.Types (Status, statusCode) -import Network.Mom.Stompl.Client.Queue -import Network.Wai (Middleware) -import Network.Wai.Logger -import Network.Wai.Middleware.Cors -import Network.Wai.Middleware.RequestLogger (OutputFormat (..), - logStdout, - mkRequestLogger, - outputFormat) -import Servant.Client (mkClientEnv, - parseBaseUrl) -import System.Directory -import System.Envy -import System.IO -import System.Log.FastLogger -import Text.PrettyPrint.GenericPretty - --- generische imports, aber qualified, weil es sonst zu name-clashes kommt - -import qualified Data.ByteString as BS --- import qualified Data.ByteString.Char8 as BS8 -import qualified Data.ByteString.Lazy as LBS -import qualified Network.HTTP.Client.TLS as UseDefaultHTTPSSettings (tlsManagerSettings) -import qualified Network.Mom.Stompl.Client.Queue as AMQ -import qualified Network.Wai as WAI - --- Handler für den MyServiceBackend-Typen und Imports aus den Libraries -import MyService.Handler as H -- handler der H.myApiEndpointV1Post implementiert -import MyService.Types -- weitere Type (s. nächste box) -import MyServiceGen.API as MS -- aus der generierten library - - -myServicemain :: IO () -myServicemain = do - -- .env-Datei ins Prozess-Environment laden, falls noch nicht von außen gesetzt - void $ loadFile $ Dotenv.Config [".env"] [] False - -- Config holen (defaults + overrides aus dem Environment) - sc@ServerConfig{..} <- decodeWithDefaults defConfig - -- Backend-Setup - -- legt sowas wie Proxy-Server fest und wo man wie dran kommt. Benötigt für das Sprechen mit anderen Microservices - let defaultHTTPSSettings = UseDefaultHTTPSSettings.tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro $ 1000 * 1000 * myserviceMaxTimeout } - createBackend url proxy = do - manager <- newManager . managerSetProxy proxy - $ defaultHTTPSSettings - url' <- parseBaseUrl url - return (mkClientEnv manager url') - internalProxy = case myserviceInternalProxyUrl of - "" -> noProxy - url -> useProxy $ HTTP.Proxy (fromString url) myserviceInternalProxyPort - -- externalProxy = case myserviceExternalProxyUrl of - -- "" -> noProxy - -- url -> useProxy $ HTTP.Proxy (fromString url) myserviceExternalProxyPort - - -- Definieren & Erzeugen der Funktionen um die anderen Services anzusprechen. - calls <- (,) - <$> createBackend myserviceAUri internalProxy - <*> createBackend myserviceBUri internalProxy - - -- Logging-Setup - hSetBuffering stdout LineBuffering - hSetBuffering stderr LineBuffering - - - -- Infos holen, brauchen wir später - myName <- getHostName - today <- formatTime defaultTimeLocale "%F" . utctDay <$> getCurrentTime - - - -- activeMQ-Transaktional-Queue zum schreiben nachher vorbereiten - amqPost <- newTQueueIO - - - -- bracket a b c == erst a machen, ergebnis an c als variablen übergeben. Schmeisst c ne exception/wird gekillt/..., werden die variablen an b übergeben. - bracket - -- logfiles öffnen - (LogFiles <$> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".info") AppendMode - <*> openFile (if myserviceDebug then "/logs/myservice-"<>myName<>"-"<>today<>".debug" else "/dev/null") AppendMode - <*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".error") AppendMode - <*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".timings") AppendMode - ) - -- und bei exception/beendigung schlißen.h - (\(LogFiles a b c d) -> mapM_ hClose [a,b,c,d]) - $ \logfiles -> do - - - -- logschreibe-funktionen aliasen; log ist hier abstrakt, iolog spezialisiert auf io. - let log = printLogFiles logfiles :: MonadIO m => [LogItem] -> m () - iolog = printLogFilesIO logfiles :: [LogItem] -> IO () - - - -- H.myApiEndpointV1Post ist ein Handler (alle Handler werden mit alias H importiert) und in einer eigenen Datei - -- Per Default bekommen Handler sowas wie die server-config, die Funktionen um mit anderen Services zu reden, die AMQ-Queue um ins Kibana zu loggen und eine Datei-Logging-Funktion - -- Man kann aber noch viel mehr machen - z.b. gecachte Daten übergeben, eine Talk-Instanz, etc. pp. - server = MyServiceBackend{ myApiEndpointV1Post = H.myApiEndpointV1Post sc calls amqPost log - } - config = MS.Config $ "http://" ++ myserviceHost ++ ":" ++ show myservicePort ++ "/" - iolog . pure . Info $ "Using Server configuration:" - iolog . pure . Info $ pretty sc { myserviceActivemqPassword = "******" -- Do NOT log the password ;) - , myserviceMongoPassword = "******" - } - -- alle Services starten (Hintergrund-Aktionen wie z.b. einen MongoDB-Dumper, einen Talk-Server oder wie hier die ActiveMQ - void $ forkIO $ keepActiveMQConnected sc iolog amqPost - -- logging-Framework erzeugen - loggingMW <- loggingMiddleware - -- server starten - if myserviceDebug - then runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]})) . loggingMW . logStdout) server - else runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]}))) server - - --- Sollte bald in die Library hs-stomp ausgelagert werden --- ist ein Beispiel für einen ActiveMQ-Dumper -keepActiveMQConnected :: ServerConfig -> ([LogItem] -> IO ()) -> TQueue BS.ByteString -> IO () -keepActiveMQConnected sc@ServerConfig{..} printLog var = do - res <- handle (\(e :: SomeException) -> do - printLog . pure . Error $ "Exception in AMQ-Thread: "<>show e - return $ Right () - ) $ AMQ.try $ do -- catches all AMQ-Exception that we can handle. All others bubble up. - printLog . pure . Info $ "AMQ: connecting..." - withConnection myserviceActivemqHost myserviceActivemqPort [ OAuth myserviceActivemqUsername myserviceActivemqPassword - , OTmo (30*1000) {- 30 sec timeout -} - ] - [] $ \c -> do - let oconv = return - printLog . pure . Info $ "AMQ: connected" - withWriter c "Chaos-Logger for Kibana" "chaos.logs" [] [] oconv $ \writer -> do - printLog . pure . Info $ "AMQ: queue created" - let postfun = writeQ writer (Type (Application "json") []) [] - void $ race - (forever $ atomically (readTQueue var) >>= postfun) - (threadDelay (600*1000*1000)) -- wait 10 Minutes - -- close writer - -- close connection - -- get outside of all try/handle/...-constructions befor recursing. - case res of - Left ex -> do - printLog . pure . Error $ "AMQ: "<>show ex - keepActiveMQConnected sc printLog var - Right _ -> keepActiveMQConnected sc printLog var - - --- Beispiel für eine Custom-Logging-Middleware. --- Hier werden z.B. alle 4xx-Status-Codes inkl. Payload ins stdout-Log geschrieben. --- Nützlich, wenn die Kollegen ihre Requests nicht ordentlich schreiben können und der Server das Format zurecht mit einem BadRequest ablehnt ;) -loggingMiddleware :: IO Middleware -loggingMiddleware = liftIO $ mkRequestLogger $ def { outputFormat = CustomOutputFormatWithDetails out } - where - out :: ZonedDate -> WAI.Request -> Status -> Maybe Integer -> NominalDiffTime -> [BS.ByteString] -> Builder -> LogStr - out _ r status _ _ payload _ - | statusCode status < 300 = "" - | statusCode status > 399 && statusCode status < 500 = "Error code "<>toLogStr (statusCode status) <>" sent. Request-Payload was: "<> mconcat (toLogStr <$> payload) <> "\n" - | otherwise = toLogStr (show r) <> "\n" - -``` - -#### Weitere Instanzen und Definitionen, die der Generator (noch) nicht macht - -In der `Myservice.Types` werden ein paar hilfreiche Typen und Typinstanzen definiert. Im Folgenden geht es dabei um Dinge für: - -- Envy - - Laden von $ENV_VAR in Datentypen - - Definitionen für Default-Settings -- ServerConfig - - Definition der Server-Konfiguration & Benennung der Environment-Variablen -- ExtraTypes - - ggf. Paketweite extra-Typen, die der Generator nicht macht, weil sie nicht aus der API kommen (z.B. cache) -- Out/BSON-Instanzen - - Der API-Generator generiert nur wenige Instanzen automatisch (z.B. Aeson), daher werden hier die fehlenden definiert. - - BSON: Kommunakation mit MongoDB - - Out: pretty-printing im Log - -```haskell -{-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -Wno-name-shadowing #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -module MyService.Types where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text -import Data.Time.Clock -import GHC.Generics -import System.Envy -import Text.PrettyPrint (text) -import Text.PrettyPrint.GenericPretty - --- Out hat hierfür keine Instanzen, daher kurz eine einfach Definition. -instance Out Text where - doc = text . unpack - docPrec i a = text $ showsPrec i a "" - -instance Out UTCTime where - doc = text . show - docPrec i a = text $ showsPrec i a "" - --- Der ServerConfig-Typ. Wird mit den defaults unten initialisiert, dann mit den Variablen aus der .env-Datei überschrieben und zum Schluss können Serveradmins diese via $MYSERVICE_FOO nochmal überschreiben. -data ServerConfig = ServerConfig - { myserviceHost :: String -- ^ Environment: $MYSERVICE_HOST - , myservicePort :: Int -- ^ Environment: $MYSERVICE_PORT - , myserviceMaxTimeout :: Int -- ^ Environment: $MYSERVICE_MAX_TIMEOUT - , myserviceInternalProxyUrl :: String -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_URL - , myserviceInternalProxyPort :: Int -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_PORT - , myserviceExternalProxyUrl :: String -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_URL - , myserviceExternalProxyPort :: Int -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_PORT - , myserviceActivemqHost :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_HOST - , myserviceActivemqPort :: Int -- ^ Environment: $MYSERVICE_ACTIVEMQ_PORT - , myserviceActivemqUsername :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_USERNAME - , myserviceActivemqPassword :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_PASSWORD - , myserviceMongoUsername :: String -- ^ Environment: $MYSERVICE_MONGO_USERNAME - , myserviceMongoPassword :: String -- ^ Environment: $MYSERVICE_MONGO_PASSWORD - , myserviceDebug :: Bool -- ^ Environment: $MYSERVICE_DEBUG - } deriving (Show, Eq, Generic) - --- Default-Konfigurations-Instanz für diesen Service. -instance DefConfig ServerConfig where - defConfig = ServerConfig "0.0.0.0" 8080 20 - "" - "" - "" - 0 - "" - 0 - "" - 0 - "" - "" - "" - "" - False - --- Kann auch aus dem ENV gefüllt werden -instance FromEnv ServerConfig --- Und hübsch ausgegeben werden. -instance Out ServerConfig - - -instance Out Response -instance FromBSON Repsonse -- FromBSON-Instanz geht immer davon aus, dass alle keys da sind (ggf. mit null bei Nothing). -``` - -#### Was noch zu tun ist - -Den Service implementieren. Einfach ein neues Modul aufmachen (z.B. `MyService.Handler` oder `MyService.DieserEndpunktbereich`/`MyService.JenerEndpunktbereich`) und dort die Funktion implementieren, die man in der `Main.hs` benutzt hat. -In dem Handler habt ihr dann keinen Stress mehr mit validierung, networking, logging, etc. pp. weil alles in der Main abgehandelt wurde und ihr nur noch den "Happy-Case" implementieren müsst. -Beispiel für unseren Handler oben: - -```haskell -myApiEndpointV1Post :: MonadIO m => ServerConfig -> (ClientEnv,ClientEnv) -> TQueue BS.ByteString -> ([LogItem] -> IO ()) -> Request -> m Response -myApiEndpointV1Post sc calls amqPost log req = do - liftIO . log $ [Info $ "recieved "<>pretty req] -- input-logging - liftIO . atomically . writeTQueue . LBS.toStrict $ "{\"hey Kibana, i recieved:\"" <> A.encode (pretty req) <> "}" -- log in activeMQ/Kibana - - - --- .... gaaaanz viel komplizierter code um die Response zu erhalten ;) - let ret = Response 1337 Nothing -- dummy-response ;) - -- gegeben wir haben eine gültige mongodb-pipe; - -- mehr logik will ich in die Beispiele nicht packen. - -- Man kann die z.b. als weiteren Wert in einer TMVar (damit man sie ändern & updaten kann) an die Funktion übergeben. - liftIO . access pipe master "DatabaseName" $ do - ifM (auth (myServiceMongoUsername sc) (myServiceMongoPassword sc)) (return ()) (liftIO . printLog . pure . Error $ "MongoDB: Login failed.") - save "DatabaseCollection" ["_id" =: 1337, "entry" =: ret] -- selbe id wie oben ;) - return ret -``` - -Diese dummy-Antwort führt auf, wie gut man die ganzen Sachen mischen kann. - -- Logging in die Dateien/stdout nach config -- Logging von Statistiker in Kibana -- Speichern der Antwort in der MongoDB -- Generieren einer Serverantwort und ausliefern dieser über die Schnittstelle - -#### Tipps & Tricks - -##### Dateien, die statisch ausgeliefert werden sollen - -Hierzu erstellt man ein Verzeichnis `static/` (konvention; ist im generator so generiert, dass das ausgeliefert wird). Packt man hier z.b. eine `index.html` rein, erscheint die, wenn man den Service ansurft. - -##### Wie bekomme ich diese fancy Preview hin? - -Der Editor, der ganz am Anfang zum Einsatz gekommen ist, braucht nur die `api-doc.yml` um diese Ansicht zu erzeugen. -Daher empfielt sich hier ein angepasster Fork davon indem die Pfade in der index.html korrigiert sind. Am einfachsten (und von den meisten services so benutzt): -In meiner Implementation liegt dann nach dem starten auf http://localhost:PORT/ui/ und kann direkt dort getestet werden. - -##### Wie sorge ich für bessere Warnungen, damit der Compiler meine Bugs fängt? - -```bash -stack build --file-watch --ghc-options '-freverse-errors -W -Wall -Wcompat' --interleaved-output -``` - -Was tut das? - -- `--file-watch`: automatisches (minimales) kompilieren bei dateiänderungen -- `--ghc-options` - - `-freverse-errors`: Fehlermeldungen in umgekehrter Reihenfolge (Erster Fehler ganz unten; wenig scrollen ) - - `-W`: Warnungen an - - `-Wall`: Alle sinnvollen Warnungen an (im gegensatz zu `-Weverything`, was WIRKLICH alles ist ) - - `-Wcompat`: Warnungen für Sachen, die in der nächsten Compilerversion kaputt brechen werden & vermieden werden sollten -- `--interleaved-output`: stack-log direkt ausgeben & nicht in dateien schreiben und die dann am ende zusammen cat\'en. - -Um pro Datei Warnungen auszuschalten (z.B. weil man ganz sicher weiss, was man tut -.-): `{-# OPTIONS_GHC -Wno-whatsoever #-}` als Pragma in die Datei. - -**Idealerweise sollte das Projekt keine Warnungen erzeugen.** - -### Deployment - -Als Beispiel sei hier ein einfaches Docker-Build mit Jenkins-CI gezeigt, weil ich das aus Gründen rumliegen hatte. Kann man analog in fast alle anderen CI übrsetzen. - -#### Docker - -Die angehängten Scripte gehen von einer Standard-Einrichtung aus (statische sachen in static, 2-3 händische Anpassungen auf das eigene Projekt nach auspacken). Nachher liegt dann auch unter static/version die gebaute Versionsnummer & kann abgerufen werden. -In der Dockerfile.release und der Jenkinsfile müssen noch anpassungen gemacht werden. Konkret: - -- in der Dockerfile.release: alle `<<>>`-Stellen sinnvoll befüllen -- in der Jenkinsfile die defs für "servicename" und "servicebinary" ausfüllen. Binary ist das, was bei stack exec aufgerufen wird; name ist der Image-Name für das docker-repository. - -#### Jenkins - -Änderungen die dann noch gemacht werden müssen: -- git-repository url anpassen -- Environment-Vars anpasses ($BRANCH = test & live haben keine zusatzdinger im docker-image-repository; ansonsten hat das image $BRANCH im namen) - -Wenn das durchgebaut ist, liegt im test/live-repository ein docker-image namens `servicename:version`. - -### OMG! Ich muss meine API ändern. Was mache ich nun? - -1. api-doc.yml bearbeiten, wie gewünscht -2. mittels generator die Api & submodule neu generieren -3. ggf. custom Änderungen übernehmen (:Gitdiffsplit hilft) -4. Alle Compilerfehler + Warnungen in der eigentlichen Applikation fixen -5. If it comipilez, ship it! (Besser nicht ;) ) diff --git a/content/templates/filters/embed-note.tpl b/content/templates/filters/embed-note.tpl new file mode 100644 index 0000000..69bf5fa --- /dev/null +++ b/content/templates/filters/embed-note.tpl @@ -0,0 +1,14 @@ +
+
+ +
+ + + +
+ +
+ +
+
+
diff --git a/static_gen/-/all.html b/static_gen/-/all.html index f02af5f..7df2f71 100644 --- a/static_gen/-/all.html +++ b/static_gen/-/all.html @@ -46,7 +46,7 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + +
+ + + + +
+
+ + + + +

+ + Webapp-Example: Main.hs + +

+
+ + +

+ Wie man das verwendet, siehe Webapp-Development in Haskell. +

+ 
{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module MyService where
+ 
+-- generische imports aus den dependencies/base, nicht in der prelude
+import           Codec.MIME.Type
+import           Configuration.Dotenv                 as Dotenv
+import           Control.Concurrent                   (forkIO, threadDelay)
+import           Control.Concurrent.Async
+import           Control.Concurrent.STM
+import           Control.Monad
+import           Control.Monad.Catch
+import           Control.Monad.Except
+import           Conversion
+import           Conversion.Text                      ()
+import           Data.Binary.Builder
+import           Data.String                          (IsString (..))
+import           Data.Time
+import           Data.Time.Clock
+import           Data.Time.Format
+import           Data.Default
+import           Network.HostName
+import           Network.HTTP.Client                  as HTTP hiding
+                                                               (withConnection)
+import           Network.HTTP.Types                   (Status, statusCode)
+import           Network.Mom.Stompl.Client.Queue
+import           Network.Wai                          (Middleware)
+import           Network.Wai.Logger
+import           Network.Wai.Middleware.Cors
+import           Network.Wai.Middleware.RequestLogger (OutputFormat (..),
+                                                       logStdout,
+                                                       mkRequestLogger,
+                                                       outputFormat)
+import           Servant.Client                       (mkClientEnv,
+                                                       parseBaseUrl)
+import           System.Directory
+import           System.Envy
+import           System.IO
+import           System.Log.FastLogger
+import           Text.PrettyPrint.GenericPretty
+ 
+-- generische imports, aber qualified, weil es sonst zu name-clashes kommt
+ 
+import qualified Data.ByteString                      as BS
+-- import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy                 as LBS
+import qualified Network.HTTP.Client.TLS              as UseDefaultHTTPSSettings (tlsManagerSettings)
+import qualified Network.Mom.Stompl.Client.Queue      as AMQ
+import qualified Network.Wai                          as WAI
+ 
+-- Handler für den MyServiceBackend-Typen und Imports aus den Libraries
+import           MyService.Handler                    as H  -- handler der H.myApiEndpointV1Post implementiert
+import           MyService.Types                            -- weitere Type (s. nächste box)
+import           MyServiceGen.API                     as MS -- aus der generierten library
+
+ 
+myServicemain :: IO ()
+myServicemain = do
+  -- .env-Datei ins Prozess-Environment laden, falls noch nicht von außen gesetzt
+  void $ loadFile $ Dotenv.Config [".env"] [] False
+  -- Config holen (defaults + overrides aus dem Environment)
+  sc@ServerConfig{..} <- decodeWithDefaults defConfig
+  -- Backend-Setup
+  -- legt sowas wie Proxy-Server fest und wo man wie dran kommt. Benötigt für das Sprechen mit anderen Microservices
+  let defaultHTTPSSettings = UseDefaultHTTPSSettings.tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro $ 1000 * 1000 * myserviceMaxTimeout }
+      createBackend url proxy = do
+        manager <- newManager . managerSetProxy proxy
+          $ defaultHTTPSSettings
+        url' <- parseBaseUrl url
+        return (mkClientEnv manager url')
+      internalProxy = case myserviceInternalProxyUrl of
+                        ""  -> noProxy
+                        url -> useProxy $ HTTP.Proxy (fromString url) myserviceInternalProxyPort
+      -- externalProxy = case myserviceExternalProxyUrl of
+      --                   ""  -> noProxy
+      --                   url -> useProxy $ HTTP.Proxy (fromString url) myserviceExternalProxyPort
+ 
+  -- Definieren & Erzeugen der Funktionen um die anderen Services anzusprechen.
+  calls <- (,)
+           <$> createBackend myserviceAUri internalProxy  
+           <*> createBackend myserviceBUri internalProxy 
+ 
+  -- Logging-Setup
+  hSetBuffering stdout LineBuffering
+  hSetBuffering stderr LineBuffering
+ 
+ 
+  -- Infos holen, brauchen wir später
+  myName <- getHostName
+  today <- formatTime defaultTimeLocale "%F" . utctDay <$> getCurrentTime
+ 
+ 
+  -- activeMQ-Transaktional-Queue zum schreiben nachher vorbereiten
+  amqPost <- newTQueueIO
+ 
+ 
+  -- bracket a b c == erst a machen, ergebnis an c als variablen übergeben. Schmeisst c ne exception/wird gekillt/..., werden die variablen an b übergeben.
+  bracket
+   -- logfiles öffnen
+   (LogFiles <$> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".info") AppendMode
+             <*> openFile (if myserviceDebug then "/logs/myservice-"<>myName<>"-"<>today<>".debug" else "/dev/null") AppendMode
+             <*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".error") AppendMode
+             <*> openFile ("/logs/myservice-"<>myName<>"-"<>today<>".timings") AppendMode
+   )
+   -- und bei exception/beendigung schlißen.h
+   (\(LogFiles a b c d) -> mapM_ hClose [a,b,c,d])
+   $ \logfiles -> do
+ 
+ 
+    -- logschreibe-funktionen aliasen; log ist hier abstrakt, iolog spezialisiert auf io.
+    let log = printLogFiles logfiles :: MonadIO m => [LogItem] -> m ()
+        iolog = printLogFilesIO logfiles :: [LogItem] -> IO ()
+ 
+ 
+        -- H.myApiEndpointV1Post ist ein Handler (alle Handler werden mit alias H importiert) und in einer eigenen Datei
+        -- Per Default bekommen Handler sowas wie die server-config, die Funktionen um mit anderen Services zu reden, die AMQ-Queue um ins Kibana zu loggen und eine Datei-Logging-Funktion
+        -- Man kann aber noch viel mehr machen - z.b. gecachte Daten übergeben, eine Talk-Instanz, etc. pp.
+        server = MyServiceBackend{ myApiEndpointV1Post = H.myApiEndpointV1Post sc calls amqPost log
+                                   }
+        config = MS.Config $ "http://" ++ myserviceHost ++ ":" ++ show myservicePort ++ "/"
+    iolog . pure . Info $ "Using Server configuration:"
+    iolog . pure . Info $ pretty sc { myserviceActivemqPassword = "******" -- Do NOT log the password ;)
+                                    , myserviceMongoPassword = "******"
+                                    }
+    -- alle Services starten (Hintergrund-Aktionen wie z.b. einen MongoDB-Dumper, einen Talk-Server oder wie hier die ActiveMQ
+    void $ forkIO $ keepActiveMQConnected sc iolog amqPost
+    -- logging-Framework erzeugen
+    loggingMW <- loggingMiddleware
+    -- server starten
+    if myserviceDebug
+       then runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]})) . loggingMW . logStdout) server
+       else runMyServiceMiddlewareServer config (cors (\_ -> Just (simpleCorsResourcePolicy {corsRequestHeaders = ["Content-Type"]}))) server
+ 
+ 
+-- Sollte bald in die Library hs-stomp ausgelagert werden
+-- ist ein Beispiel für einen ActiveMQ-Dumper
+keepActiveMQConnected :: ServerConfig -> ([LogItem] -> IO ()) -> TQueue BS.ByteString -> IO ()
+keepActiveMQConnected sc@ServerConfig{..} printLog var = do
+  res <- handle (\(e :: SomeException) -> do
+      printLog . pure . Error $ "Exception in AMQ-Thread: "<>show e
+      return $ Right ()
+    ) $ AMQ.try $ do -- catches all AMQ-Exception that we can handle. All others bubble up.
+        printLog . pure . Info $ "AMQ: connecting..."
+        withConnection myserviceActivemqHost myserviceActivemqPort [ OAuth myserviceActivemqUsername myserviceActivemqPassword
+                                                                   , OTmo (30*1000) {- 30 sec timeout -}
+                                                                   ]
+                                                                   [] $ \c -> do
+          let oconv = return
+          printLog . pure . Info $ "AMQ: connected"
+          withWriter c "Chaos-Logger for Kibana" "chaos.logs" [] [] oconv $ \writer -> do
+            printLog . pure . Info $ "AMQ: queue created"
+            let postfun = writeQ writer (Type (Application "json") []) []
+            void $ race
+              (forever $ atomically (readTQueue var) >>= postfun)
+              (threadDelay (600*1000*1000)) -- wait 10 Minutes
+          -- close writer
+        -- close connection
+  -- get outside of all try/handle/...-constructions befor recursing.
+  case res of
+    Left ex -> do
+      printLog . pure . Error $ "AMQ: "<>show ex
+      keepActiveMQConnected sc printLog var
+    Right _ -> keepActiveMQConnected sc printLog var
+ 
+ 
+-- Beispiel für eine Custom-Logging-Middleware.
+-- Hier werden z.B. alle 4xx-Status-Codes inkl. Payload ins stdout-Log geschrieben.
+-- Nützlich, wenn die Kollegen ihre Requests nicht ordentlich schreiben können und der Server das Format zurecht mit einem BadRequest ablehnt ;)
+loggingMiddleware :: IO Middleware
+loggingMiddleware = liftIO $ mkRequestLogger $ def { outputFormat = CustomOutputFormatWithDetails out }
+  where
+    out :: ZonedDate -> WAI.Request -> Status -> Maybe Integer -> NominalDiffTime -> [BS.ByteString] -> Builder -> LogStr
+    out _ r status _ _ payload _
+      | statusCode status < 300 = ""
+      | statusCode status > 399 && statusCode status < 500 = "Error code "<>toLogStr (statusCode status) <>" sent. Request-Payload was: "<> mconcat (toLogStr <$> payload) <> "\n"
+      | otherwise = toLogStr (show r) <> "\n"
+
+ +
+
+ + +
+
Links to this page
+ +
+ +
+ +
+ +
+ + +
+
+
+ +
+ + + + + diff --git a/static_gen/Haskell/Webapp-Example/MyService_Types.hs.html b/static_gen/Haskell/Webapp-Example/MyService_Types.hs.html new file mode 100644 index 0000000..fee36c4 --- /dev/null +++ b/static_gen/Haskell/Webapp-Example/MyService_Types.hs.html @@ -0,0 +1,1385 @@ + + + + + + + + Webapp-Example: MyService/Types.hs – Home + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + +
+ + + + +
+
+ + + + +

+ + Webapp-Example: MyService/Types.hs + +

+
+ + +

+ Anleitung siehe Webapp-Development in Haskell. +

+ 
{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DerivingVia           #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
+module MyService.Types where
+ 
+import           Data.Aeson                     (FromJSON, ToJSON)
+import           Data.Text
+import           Data.Time.Clock
+import           GHC.Generics
+import           System.Envy
+import           Text.PrettyPrint               (text)
+import           Text.PrettyPrint.GenericPretty
+ 
+-- Out hat hierfür keine Instanzen, daher kurz eine einfach Definition.
+instance Out Text where
+  doc = text . unpack
+  docPrec i a = text $ showsPrec i a ""
+ 
+instance Out UTCTime where
+  doc = text . show
+  docPrec i a = text $ showsPrec i a ""
+ 
+-- Der ServerConfig-Typ. Wird mit den defaults unten initialisiert, dann mit den Variablen aus der .env-Datei überschrieben und zum Schluss können Serveradmins diese via $MYSERVICE_FOO nochmal überschreiben.
+data ServerConfig = ServerConfig
+                  { myserviceHost              :: String -- ^ Environment: $MYSERVICE_HOST
+                  , myservicePort              :: Int    -- ^ Environment: $MYSERVICE_PORT
+                  , myserviceMaxTimeout        :: Int    -- ^ Environment: $MYSERVICE_MAX_TIMEOUT
+                  , myserviceInternalProxyUrl  :: String -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_URL
+                  , myserviceInternalProxyPort :: Int    -- ^ Environment: $MYSERVICE_INTERNAL_PROXY_PORT
+                  , myserviceExternalProxyUrl  :: String -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_URL
+                  , myserviceExternalProxyPort :: Int    -- ^ Environment: $MYSERVICE_EXTERNAL_PROXY_PORT
+                  , myserviceActivemqHost      :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_HOST
+                  , myserviceActivemqPort      :: Int    -- ^ Environment: $MYSERVICE_ACTIVEMQ_PORT
+                  , myserviceActivemqUsername  :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_USERNAME
+                  , myserviceActivemqPassword  :: String -- ^ Environment: $MYSERVICE_ACTIVEMQ_PASSWORD
+                  , myserviceMongoUsername     :: String -- ^ Environment: $MYSERVICE_MONGO_USERNAME
+                  , myserviceMongoPassword     :: String -- ^ Environment: $MYSERVICE_MONGO_PASSWORD
+                  , myserviceDebug             :: Bool   -- ^ Environment: $MYSERVICE_DEBUG
+                  } deriving (Show, Eq, Generic)
+ 
+-- Default-Konfigurations-Instanz für diesen Service.
+instance DefConfig ServerConfig where
+  defConfig = ServerConfig "0.0.0.0" 8080 20
+                           ""
+                           ""
+                           ""
+                           0
+                           ""
+                           0
+                           ""
+                           0
+                           ""
+                           ""
+                           ""
+                           ""
+                           False
+ 
+-- Kann auch aus dem ENV gefüllt werden
+instance FromEnv ServerConfig
+-- Und hübsch ausgegeben werden.
+instance Out ServerConfig
+ 
+ 
+instance Out Response
+instance FromBSON Repsonse -- FromBSON-Instanz geht immer davon aus, dass alle keys da sind (ggf. mit null bei Nothing).
+ +
+
+ + +
+
Links to this page
+ +
+ +
+ +
+ +
+ + +
+
+
+ +
+ + + + + diff --git a/static_gen/Logik.html b/static_gen/Logik.html index eb75d4f..512c86d 100644 --- a/static_gen/Logik.html +++ b/static_gen/Logik.html @@ -47,7 +47,7 @@ - +