From 7e747e4d1b39ab8246bae8e9d85890f66dece39b Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 20 Feb 2021 19:12:48 +0100
Subject: [PATCH 01/38] added basic api call functionality

---
 FileHandler.hs | 65 ++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 55 insertions(+), 10 deletions(-)

diff --git a/FileHandler.hs b/FileHandler.hs
index 2988cb7..f2539be 100755
--- a/FileHandler.hs
+++ b/FileHandler.hs
@@ -1,12 +1,13 @@
 #!/usr/bin/env stack
 {- stack
-    --resolver lts-6.11
+    --resolver lts-17.4
     --install-ghc
     runghc
     --package shakespeare
     --package wai-app-static
     --package wai-extra
     --package warp
+    --package req
  -}
 
 -- The code above is used for Haskell Stack's script interpreter
@@ -28,7 +29,7 @@
 import qualified Data.ByteString.Char8          as S8
 import qualified Data.ByteString.Lazy           as L
 import           Data.Functor.Identity
-import           Network.HTTP.Types
+import qualified Network.HTTP.Types             as HttpTypes
 import           Network.Wai
 import           Network.Wai.Application.Static
 import           Network.Wai.Handler.Warp
@@ -37,11 +38,18 @@ import           System.Environment
 import           System.FilePath
 import           Text.Blaze.Html.Renderer.Utf8
 import           Text.Hamlet
+import Control.Monad.IO.Class
+import Data.Aeson
+import Network.HTTP.Req
+import Data.CaseInsensitive
+import Data.Text
+import GHC.Int
+
 
 -- | Entrypoint to our application
 main :: IO ()
 main = do
-    -- For ease of setup, we want to have a "sanity" command line
+       -- For ease of setup, we want to have a "sanity" command line
     -- argument. We'll see how this is used in the Dockerfile
     -- later. Desired behavior:
     --
@@ -54,7 +62,7 @@ main = do
         [] -> do
             putStrLn "Launching DataHandler."
             -- Run our application (defined below) on port 5000
-            run 5000 app
+            run 5002 app
         _ -> error $ "Unknown arguments: " ++ show args
 
 -- | Our main application
@@ -64,7 +72,7 @@ app req send =
     case pathInfo req of
         -- "/": send the HTML homepage contents
         [] -> send $ responseBuilder
-                status200
+                HttpTypes.status200
                 [("Content-Type", "text/html; charset=utf-8")]
                 (renderHtmlBuilder homepage)
 
@@ -82,9 +90,9 @@ app req send =
 
         -- anything else: 404
         _ -> send $ responseLBS
-            status404
+            HttpTypes.status404
             [("Content-Type", "text/plain; charset=utf-8")]
-            "Not found"
+            "Not found :("
 
 -- | Create an HTML page which links to the /browse URL, and allows
 -- for a file upload
@@ -116,12 +124,13 @@ upload req send = do
     -- Parse the request body. We'll ignore parameters and just look
     -- at the files
     (_params, files) <- parseRequestBody lbsBackEnd req
-
+    let headers = requestHeaders req
+   -- debug (_params)
     -- Look for the file parameter called "file"
     case lookup "file" files of
         -- Not found, so return a 400 response
         Nothing -> send $ responseLBS
-            status400
+            HttpTypes.status400
             [("Content-Type", "text/plain; charset=utf-8")]
             "No file parameter found"
         -- Got it!
@@ -131,13 +140,49 @@ upload req send = do
                 name = takeFileName $ S8.unpack $ fileName file
                 -- and grab the content
                 content = fileContent file
+               
             -- Write it out
+            postApi headers file (L.length content)
             L.writeFile name content
 
             -- Send a 303 response to redirect back to the homepage
             send $ responseLBS
-                status303
+                HttpTypes.status303
                 [ ("Content-Type", "text/plain: charset=utf-8")
                 , ("Location", "/")
                 ]
                 "Upload successful!"
+
+
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO()
+postApi allheaders file size= runReq defaultHttpConfig $ do
+  let payload =
+        object
+          [ "name" .= (S8.unpack (fileName (file))),
+            "fileContentType" .= (S8.unpack (fileContentType (file))),
+            "size" .= (size)
+          ]
+
+  -- One function—full power and flexibility, automatic retrying on timeouts
+  -- and such, automatic connection sharing.
+  r <-
+    req
+      POST -- method
+      (https "requestbin.io" /: "1cd7bmm1") -- safe by construction URL
+      (ReqBodyJson payload) -- use built-in options or add your own
+      bsResponse  -- specify how to interpret response
+      (header "X-FF-PATH" (getOneHeader allheaders "X-FF-PATH" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+     -- mempty -- query params, headers, explicit port number, etc.
+  liftIO $ print (S8.unpack (responseBody r))
+
+
+
+debug :: ([Param]) -> IO()
+debug what = do
+    putStrLn (S8.unpack (snd (Prelude.head what)))
+
+
+getOneHeader :: ([HttpTypes.Header]) -> [Char] -> S8.ByteString
+getOneHeader headers headerName= 
+    snd (Prelude.head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack (headerName) ):: CI S8.ByteString)) headers))
+

From 45c79ec699d2250b79f657f18d1a1ee1b99e4f99 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sun, 21 Feb 2021 18:37:32 +0100
Subject: [PATCH 02/38] dont throw execptions, get reponse values

---
 FileHandler.hs | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/FileHandler.hs b/FileHandler.hs
index f2539be..7fe895a 100755
--- a/FileHandler.hs
+++ b/FileHandler.hs
@@ -142,20 +142,18 @@ upload req send = do
                 content = fileContent file
                
             -- Write it out
-            postApi headers file (L.length content)
+            restResponse <- postApi headers file (L.length content)
             L.writeFile name content
 
             -- Send a 303 response to redirect back to the homepage
             send $ responseLBS
-                HttpTypes.status303
-                [ ("Content-Type", "text/plain: charset=utf-8")
-                , ("Location", "/")
-                ]
-                "Upload successful!"
+                HttpTypes.status200
+                [ ("Content-Type", "text/plain: charset=utf-8")]
+                (encode $ snd restResponse)
 
 
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO()
-postApi allheaders file size= runReq defaultHttpConfig $ do
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO (S8.ByteString , Int)
+postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
           [ "name" .= (S8.unpack (fileName (file))),
@@ -168,12 +166,12 @@ postApi allheaders file size= runReq defaultHttpConfig $ do
   r <-
     req
       POST -- method
-      (https "requestbin.io" /: "1cd7bmm1") -- safe by construction URL
+      (http "ptsv2.com" /: "t/pip6j-1613925577/post") -- safe by construction URL
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-PATH" (getOneHeader allheaders "X-FF-PATH" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+      (header "X-FF-ParentID" (getOneHeader allheaders "X-FF-ParentID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
      -- mempty -- query params, headers, explicit port number, etc.
-  liftIO $ print (S8.unpack (responseBody r))
+  return $ (responseBody r, responseStatusCode r)
 
 
 
@@ -186,3 +184,6 @@ getOneHeader :: ([HttpTypes.Header]) -> [Char] -> S8.ByteString
 getOneHeader headers headerName= 
     snd (Prelude.head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack (headerName) ):: CI S8.ByteString)) headers))
 
+
+
+httpConfigDontCheckResponse _ _ _ = Nothing

From 6307305a0773c1bd5a1145a5379fcd88ee787f3c Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sun, 28 Feb 2021 11:32:48 +0100
Subject: [PATCH 03/38] handle status codes

---
 FileHandler.hs | 50 ++++++++++++++++++++++++++++----------------------
 1 file changed, 28 insertions(+), 22 deletions(-)

diff --git a/FileHandler.hs b/FileHandler.hs
index 7fe895a..b7ef6f4 100755
--- a/FileHandler.hs
+++ b/FileHandler.hs
@@ -140,25 +140,31 @@ upload req send = do
                 name = takeFileName $ S8.unpack $ fileName file
                 -- and grab the content
                 content = fileContent file
-               
-            -- Write it out
-            restResponse <- postApi headers file (L.length content)
-            L.writeFile name content
-
-            -- Send a 303 response to redirect back to the homepage
-            send $ responseLBS
-                HttpTypes.status200
-                [ ("Content-Type", "text/plain: charset=utf-8")]
-                (encode $ snd restResponse)
 
-
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO (S8.ByteString , Int)
+            -- Write it out
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content)
+            case responseStatusCode of
+                200 -> do
+                    L.writeFile name content
+                    -- Send a 303 response to redirect back to the homepage
+                    send $ responseLBS
+                        HttpTypes.status200
+                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        "uploaded"
+                _ ->
+                    send $ responseLBS
+                        (HttpTypes.mkStatus responseStatusCode (responseStatusMessage))
+                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        (L.fromStrict responseBody)
+
+
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO (S8.ByteString , Int, S8.ByteString)
 postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
-          [ "name" .= (S8.unpack (fileName (file))),
-            "fileContentType" .= (S8.unpack (fileContentType (file))),
-            "size" .= (size)
+          [ "name" .= S8.unpack (fileName file),
+            "fileContentType" .= S8.unpack (fileContentType file),
+            "size" .= size
           ]
 
   -- One function—full power and flexibility, automatic retrying on timeouts
@@ -166,23 +172,23 @@ postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse
   r <-
     req
       POST -- method
-      (http "ptsv2.com" /: "t/pip6j-1613925577/post") -- safe by construction URL
+      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
       (header "X-FF-ParentID" (getOneHeader allheaders "X-FF-ParentID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
      -- mempty -- query params, headers, explicit port number, etc.
-  return $ (responseBody r, responseStatusCode r)
+  return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 
 
-debug :: ([Param]) -> IO()
-debug what = do
+debug :: [Param] -> IO()
+debug what =
     putStrLn (S8.unpack (snd (Prelude.head what)))
 
 
-getOneHeader :: ([HttpTypes.Header]) -> [Char] -> S8.ByteString
-getOneHeader headers headerName= 
-    snd (Prelude.head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack (headerName) ):: CI S8.ByteString)) headers))
+getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
+getOneHeader headers headerName=
+    snd (Prelude.head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers))
 
 
 

From 9d11602e165a0f370e74b035ba76fc1f2a8e50b9 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 6 Mar 2021 11:03:06 +0100
Subject: [PATCH 04/38] upload of one file works

---
 FileHandler.hs | 45 ++++++++++++++++++++++++++++++---------------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/FileHandler.hs b/FileHandler.hs
index b7ef6f4..1cd93ee 100755
--- a/FileHandler.hs
+++ b/FileHandler.hs
@@ -19,7 +19,7 @@
 -- then state which packages need to be present to run this code.
 
 -- Enable the OverloadedStrings extension, a commonly used feature.
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
 
 -- We use the QuasiQuotes to embed Hamlet HTML templates inside
 -- our source file.
@@ -42,8 +42,10 @@ import Control.Monad.IO.Class
 import Data.Aeson
 import Network.HTTP.Req
 import Data.CaseInsensitive
-import Data.Text
+import qualified Data.Text as DataText
 import GHC.Int
+import GHC.Generics
+import System.Directory
 
 
 -- | Entrypoint to our application
@@ -135,22 +137,26 @@ upload req send = do
             "No file parameter found"
         -- Got it!
         Just file -> do
-            let
-                -- Determine the name of the file to write out
-                name = takeFileName $ S8.unpack $ fileName file
-                -- and grab the content
-                content = fileContent file
+            let content = fileContent file
 
             -- Write it out
             (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content)
             case responseStatusCode of
                 200 -> do
-                    L.writeFile name content
-                    -- Send a 303 response to redirect back to the homepage
-                    send $ responseLBS
-                        HttpTypes.status200
-                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                        "uploaded"
+                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String PostResponseFile)
+                    case d of
+                        Left err -> send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    (L.fromStrict $ S8.pack err)
+                        Right fileObject -> do 
+                                let id = fileSystemId fileObject
+                                createDirectoryIfMissing True [head id]
+                                L.writeFile (head id :  ("/" ++id)) content
+                                send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    "uploaded"
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode (responseStatusMessage))
@@ -162,7 +168,7 @@ postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -
 postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
-          [ "name" .= S8.unpack (fileName file),
+          [ "name" .= takeFileName $ S8.unpack (fileName file),
             "fileContentType" .= S8.unpack (fileContentType file),
             "size" .= size
           ]
@@ -188,8 +194,17 @@ debug what =
 
 getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
 getOneHeader headers headerName=
-    snd (Prelude.head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers))
+    snd (head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers))
 
 
 
 httpConfigDontCheckResponse _ _ _ = Nothing
+
+
+
+data PostResponseFile =
+  PostResponseFile { fileSystemId  :: !String
+           } deriving (Show,Generic)
+
+instance FromJSON PostResponseFile
+instance ToJSON PostResponseFile
\ No newline at end of file

From 6e20ff7591fe411ba354847890781fca764ad183 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 6 Mar 2021 12:21:35 +0100
Subject: [PATCH 05/38] basic download functionality

---
 FileHandler.hs | 65 ++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 63 insertions(+), 2 deletions(-)

diff --git a/FileHandler.hs b/FileHandler.hs
index 1cd93ee..e335121 100755
--- a/FileHandler.hs
+++ b/FileHandler.hs
@@ -90,6 +90,8 @@ app req send =
         -- "/upload": handle a file upload
         ["upload"] -> upload req send
 
+        ["download"] -> download req send
+
         -- anything else: 404
         _ -> send $ responseLBS
             HttpTypes.status404
@@ -168,7 +170,7 @@ postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -
 postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
-          [ "name" .= takeFileName $ S8.unpack (fileName file),
+          [ "name" .= S8.unpack (fileName file),
             "fileContentType" .= S8.unpack (fileContentType file),
             "size" .= size
           ]
@@ -187,6 +189,56 @@ postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse
 
 
 
+download :: Application
+download req send = do
+    let headers = requestHeaders req
+    (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers
+    case responseStatusCode of
+                200 -> do
+                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [GetResponseFile])
+                    case d of
+                        Left err -> send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    (L.fromStrict $ S8.pack err)
+                        Right files -> 
+                            case files of
+                                [fileObject] -> do
+                                    let fileID = fsid fileObject 
+                                    send $ responseFile
+                                        HttpTypes.status200
+                                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                                        (head fileID :  ("/" ++fileID))
+                                        (Nothing)
+                                [] ->
+                                    send $ responseLBS
+                                        HttpTypes.status200
+                                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                                        "nothing"
+                _ ->
+                    send $ responseLBS
+                        (HttpTypes.mkStatus responseStatusCode (responseStatusMessage))
+                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        (L.fromStrict responseBody)
+
+
+
+
+
+getApi :: [HttpTypes.Header] -> IO (S8.ByteString , Int, S8.ByteString)
+getApi allheaders= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+  r <-
+    req
+      GET -- method
+      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
+      NoReqBody -- use built-in options or add your own
+      bsResponse  -- specify how to interpret response
+      (header "X-FF-FileIDs" (getOneHeader allheaders "X-FF-FileIDs" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+     -- mempty -- query params, headers, explicit port number, etc.
+  return (responseBody r, responseStatusCode r, responseStatusMessage r)
+
+
+
 debug :: [Param] -> IO()
 debug what =
     putStrLn (S8.unpack (snd (Prelude.head what)))
@@ -207,4 +259,13 @@ data PostResponseFile =
            } deriving (Show,Generic)
 
 instance FromJSON PostResponseFile
-instance ToJSON PostResponseFile
\ No newline at end of file
+instance ToJSON PostResponseFile
+
+
+data GetResponseFile =
+  GetResponseFile { fsid :: !String  
+            , name :: !String
+           } deriving (Show,Generic)
+
+instance FromJSON GetResponseFile
+instance ToJSON GetResponseFile
\ No newline at end of file

From aa69ada0f710eda2c49b50cbe60d7a495d12a05f Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 6 Mar 2021 18:47:32 +0100
Subject: [PATCH 06/38] use a stack project instead of a single file, this
 enables typechecking

---
 FileHandler.hs |   3 +-
 README.md      | 398 +------------------------------------------------
 2 files changed, 3 insertions(+), 398 deletions(-)

diff --git a/FileHandler.hs b/FileHandler.hs
index e335121..e86c517 100755
--- a/FileHandler.hs
+++ b/FileHandler.hs
@@ -48,6 +48,7 @@ import GHC.Generics
 import System.Directory
 
 
+
 -- | Entrypoint to our application
 main :: IO ()
 main = do
@@ -96,7 +97,7 @@ app req send =
         _ -> send $ responseLBS
             HttpTypes.status404
             [("Content-Type", "text/plain; charset=utf-8")]
-            "Not found :("
+            "Endpoint does not exist"
 
 -- | Create an HTML page which links to the /browse URL, and allows
 -- for a file upload
diff --git a/README.md b/README.md
index 7244e6a..4f88f6f 100644
--- a/README.md
+++ b/README.md
@@ -1,397 +1 @@
-# FileHandlerService
-
-Haskell FileHandler Server.
-
-_Work In Progress_
-
-Base of this code base is this [repo](https://github.com/snoyberg/file-server-demo)
-
-## Features
-- [ ] browse does not exist anymore.
-- [ ] upload path is POST /upload?id=id,id1,id2&token=token
-- [ ] request to upload triggers request to backend
-- [ ] upload does support multiple files
-- [ ] download path is GET /download?id=id,id1,id2&token=token
-- [ ] request to download triggers request to backend
-- [ ] download supports multiple files (zipped as one)
-- [ ] service is either mapped with a usefull prefix /userdata/ or a fake subdomain files.....de/upload...  
-**(Roadmap feature)**
-- [ ] there is another path /preview/id?token=token
-
-Text below is from the original code base.
-
----
-
-## File server demo in a single Haskell file
-
-**Sneak peek**: Run `docker run --rm -p 8080:8080 snoyberg/file-server-demo` and open
-[http://localhost:8080](http://localhost:8080).
-
-We've all been there. We need to write some non-trivial piece of
-functionality, and end up doing it in bash or perl because that's what
-we have on the server we'll be deploying to. Or because it's the
-language we can most easily rely on being present at a consistent
-version on our coworkers' machines. We'd rather use a different
-language and leverage more advanced, non-standard libraries, but we
-can't do that reliably.
-
-One option is to create static executables or to ship around Docker
-images. This is great for many use cases, and we are going to have a
-follow-up blog post about using Docker and Alpine Linux to make such
-static executables. But there are at least two downsides to this
-approach:
-
-- It's not possible to modify a static executable directly. You need
-  to have access to the source code and the tool chain used to produce
-  it.
-- The executable is tied to a single operating system; good luck
-  getting your Linux executable to run on your OS X machine.
-
-Said another way: there are good reasons why people like to use
-scripting languages. This blog post is going to demonstrate doing some
-non-trivial work with Haskell, and do so with a fully reproducible and
-trivially installed toolchain, supported on multiple operating
-systems.
-
-## Why Haskell?
-
-Haskell is a functional programming language with high performance,
-great safety features, and a large ecosystem of open source libraries
-to choose from. Haskell programs are high level enough to be readable
-and modifiable by non-experts, making it ideal for these kinds of
-shared scripts. If you're new to Haskell, learn more on
-[haskell-lang.org](https://haskell-lang.org/).
-
-## The task
-
-We're going to put together a simple file server with upload
-capability. We're going to assume a non-hostile environment (like a
-corporate LAN with no external network access), and therefore not put
-in security precautions like upload size limits. We're going to use
-the relatively low-level Web Application Interface instead of a web
-framework. While it makes the code a bit longer, there's no magic
-involved. Common frameworks in Haskell include
-[Yesod](http://www.yesodweb.com/) and
-[Servant](http://haskell-servant.readthedocs.io/en/stable/). We're
-going to host this all with the blazingly fast Warp web server.
-
-## Get Stack
-
-[Stack](https://haskellstack.org) is a cross-platform program for
-developing Haskell projects. While it has many features, in our case
-the most important bit is that it can:
-
-- Download a complete Haskell toolchain for your OS
-- Install Haskell libraries from a
-  [curated package set](https://www.stackage.org/)
-- Run Haskell source files directly as a script (we'll show how below)
-
-Check out the
-[Get Started page on haskell-lang.org](https://haskell-lang.org/get-started)
-to get Stack on your system.
-
-## The code
-
-You can see
-[the full source code on Github](https://github.com/snoyberg/file-server-demo/blob/master/FileServer.hs). Let's
-step through the important parts here.
-
-### Script interpreter
-
-We start off our file with something that is distinctly _not_ Haskell
-code:
-
-```haskell
-#!/usr/bin/env stack
-{- stack
-    --resolver lts-6.11
-    --install-ghc
-    runghc
-    --package shakespeare
-    --package wai-app-static
-    --package wai-extra
-    --package warp
- -}
-```
-
-With this header, we've made our file executable from the shell. If
-you `chmod +x` the source file, you can run `./FileServer.hs`. The
-first line is a standard
-[shebang](https://en.wikipedia.org/wiki/Shebang_%28Unix%29). After
-that, we have a comment that provides Stack with the relevant command
-line options. These options tell it to:
-
-- Use the Haskell Long Term Support (LTS) 6.11 package set. From now
-  through the rest of time, you'll be running against the same set of
-  packages, so no worries about your code bitrotting!
-- Install GHC, the Glasgow Haskell Compiler. LTS 6.11 indicates what
-  version of GHC is needed (GHC 7.10.3). Once again: no bitrot
-  concerns!
-- `runghc` says we'd like to run a script with GHC
-- The rest of the lines specify which Haskell library packages we
-  depend on. You can see a full list of available libraries in LTS
-  6.11 [on the Stackage server](https://www.stackage.org/lts-6.11)
-
-For more information on Stack's script interpreter support, see
-[the Stack user guide](https://docs.haskellstack.org/en/stable/GUIDE/#script-interpreter).
-
-### Command line argument parsing
-
-Very often with these kinds of tools, we need to handle command line
-arguments. Haskell has some great libraries for doing this in an
-elegant way. For example, see
-[the optparse-applicative library tutorial](https://haskell-lang.org/library/optparse-applicative). However,
-if you want to go simple, you can also just use the `getArgs` function
-to get a list of arguments. We're going to add support for a `sanity`
-argument, which will allow us to sanity-check that running our
-application works:
-
-```haskell
-main :: IO ()
-main = do
-    args <- getArgs
-    case args of
-        ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
-        [] -> do
-            putStrLn "Launching application"
-            -- Run our application (defined below) on port 8080
-            run 8080 app
-        _ -> error $ "Unknown arguments: " ++ show args
-```
-
-### Routing
-
-We're going to support three different routes in our application:
-
-- The `/browse/...` tree should allow you to get a directory listing
-  of files in the current directory, and view/download individual
-  files.
-- The `/upload` page accepts a file upload and writes the uploaded
-  content to the current directory.
-- The homepage (`/`) should display an HTML page with a link to
-  `/browse` and provide an HTML upload form targeting `/upload`.
-
-Thanks to pattern matching in Haskell, getting this to work is very
-straightforward:
-
-```haskell
-app :: Application
-app req send =
-    -- Route the request based on the path requested
-    case pathInfo req of
-        -- "/": send the HTML homepage contents
-        [] -> send $ responseBuilder
-                status200
-                [("Content-Type", "text/html; charset=utf-8")]
-                (runIdentity $ execHtmlT homepage)
-
-        -- "/browse/...": use the file server to allow directory
-        -- listings and downloading files
-        ("browse":rest) ->
-            -- We create a modified request that strips off the
-            -- "browse" component of the path, so that the file server
-            -- does not need to look inside a /browse/ directory
-            let req' = req { pathInfo = rest }
-             in fileServer req' send
-
-        -- "/upload": handle a file upload
-        ["upload"] -> upload req send
-
-        -- anything else: 404
-        _ -> send $ responseLBS
-            status404
-            [("Content-Type", "text/plain; charset=utf-8")]
-            "Not found"
-```
-
-The most complicated bit above is the path modification for the
-`/browse` tree, which is something a web framework would handle for us
-automatically. Remember: we're doing this low level to avoid extra
-concepts, real world code is typically even easier than this!
-
-### Homepage content
-
-An area that Haskell really excels at is Domain Specific Languages
-(DSLs). We're going to use the
-[Hamlet](http://www.yesodweb.com/book/shakespearean-templates) for
-HTML templating. There are many other options in the Haskell world
-favoring other syntax, such as
-[Lucid library](https://www.stackage.org/package/lucid) (which
-provides a Haskell-based DSL), plus implementations of
-language-agnostic templates, like
-[mustache](https://www.stackage.org/package/mustache).
-
-Here's what our HTML page looks like in Hamlet:
-
-```haskell
-homepage :: Html ()
-homepage = [shamlet|
-$doctype 5
-<html>
-    <head>
-        <title>File server
-    <body>
-        <h1>File server
-        <p>
-            <a href=/browse/>Browse available files
-
-        <form method=POST action=/upload enctype=multipart/form-data>
-            <p>Upload a new file
-            <input type=file name=file>
-            <input type=submit>
-|]
-```
-
-Note that Hamlet - like Haskell itself - uses significant whitespace
-and indentation to denote nesting.
-
-### The rest
-
-We're not going to cover the rest of the code in the Haskell file. If
-you're interested in the details, please read the comments there, and
-feel free to ask questions about any ambiguous bits (hopefully the
-inline comments give enough clarity on what's going on).
-
-## Running
-
-Download the `FileServer.hs` file contents (or copy-paste, or clone
-the repo), make sure the file is executable (`chmod +x FileServer.hs`), and then run:
-
-```shell
-$ ./FileServer.hs
-```
-
-If you're on Windows, you can instead run:
-
-```batch
-> stack FileServer.hs
-```
-
-That's correct: the same source file will work on POSIX systems and
-Windows as well. The only requirement is Stack and GHC support. Again,
-to get Stack on your system, please see the
-[Get Started page](https://haskell-lang.org/get-started).
-
-The first time you run this program, it will take a while to
-complete. This is because Stack will need to download and install GHC
-and necessary libraries to a user-local directory. Once complete, the
-results are kept on your system, so subsequent runs will be almost
-instantaneous.
-
-Once running, you can
-[view the app on localhost:8080](http://localhost:8080).
-
-## Dockerizing
-
-Generally, I wouldn't recommend Dockerizing a source file like this;
-it makes more sense to Dockerize a compiled executable. We'll cover
-how to do that another time (though sneak preview: Stack has
-[built in support for generating Docker images](https://docs.haskellstack.org/en/stable/yaml_configuration/#image)). For
-now, let's actually Dockerize the source file itself, complete with
-Stack and the GHC toolchain.
-
-You can
-[check out the Dockerfile on Github](https://github.com/snoyberg/file-server-demo/blob/master/Dockerfile). That
-file may be slightly different from what I cover here.
-
-```dockerfile
-FROM ubuntu:16.04
-MAINTAINER Michael Snoyman
-```
-
-Nothing too interesting...
-
-```dockerfile
-ADD https://github.com/Yelp/dumb-init/releases/download/v1.1.3/dumb-init_1.1.3_amd64 /usr/local/bin/dumb-init
-RUN chmod +x /usr/local/bin/dumb-init
-```
-
-While interesting, this isn't Haskell-specific. We're just using an
-init process to get proper handling for signals. For more information,
-see
-[dumb-init's announcement blog post](http://engineeringblog.yelp.com/2016/01/dumb-init-an-init-for-docker.html).
-
-```dockerfile
-ADD https://get.haskellstack.org/get-stack.sh /usr/local/bin/
-RUN sh /usr/local/bin/get-stack.sh
-```
-
-Stack has a shell script available to automatically install it on
-POSIX systems. We just download that script and then run it. This is
-all it takes to have a Haskell-ready system set up: we're now ready to
-run script interpreter based files like our `FileServer.hs`!
-
-```dockerfile
-COPY FileServer.hs /usr/local/bin/file-server
-RUN chmod +x /usr/local/bin/file-server
-```
-
-We're copying over the source file we wrote and then ensuring it is
-executable. Interestingly, we can rename it to not include a `.hs`
-file extension. There is plenty of debate in the world around whether
-scripts should or should not include an extension indicating their
-source language; Haskell is allowing that debate to perpetuate :).
-
-```dockerfile
-RUN useradd -m www && mkdir -p /workdir && chown www /workdir
-USER www
-```
-
-While not strictly necessary, we'd rather not run our executable as
-the root user, for security purposes. Let's create a new user, create
-a working directory to store files in, and run all subsequent commands
-as the new user.
-
-```dockerfile
-RUN /usr/local/bin/file-server sanity
-```
-
-As I mentioned above, that initial run of the server takes a long
-time. We'd like to do the heavy lifting of downloading and installing
-during the Docker image build rather than at runtime. To make this
-happen, we run our program once with the `sanity` command line
-argument, so that it immediately exits after successfully starting up.
-
-```dockerfile
-CMD ["/usr/local/bin/dumb-init", "/usr/local/bin/file-server"]
-WORKDIR /workdir
-EXPOSE 8080
-```
-
-Finally, we use `CMD`, `WORKDIR`, and `EXPOSE` to make it easier to
-run. This Docker image is available on Docker Hub, so if you'd like to try
-it out without doing a full build on your local machine:
-
-```shell
-docker run --rm -p 8080:8080 snoyberg/file-server-demo
-```
-
-You should be able to play with the application on
-[http://localhost:8080](http://localhost:8080).
-
-## What's next
-
-As you can see, getting started with Haskell as a scripting language
-is easy. You may be interested in checking out
-[the turtle library](https://www.stackage.org/haddock/lts-6.11/turtle-1.2.8/Turtle-Tutorial.html),
-which is a Shell scripting DSL written in Haskell.
-
-If you're ready to get deeper into Haskell, I'd recommend:
-
-- Check out [haskell-lang.org](https://haskell-lang.org/), which has a
-  lot of beginner-targeted information, and we're adding more
-  regularly.
-- Check out
-  [Haskell Programming from First Principles](http://haskellbook.com/),
-  a book which will get you completely up and running with Haskell
-- Join one of the many
-  [Haskell online communities](https://haskell-lang.org/community)
-
-FP Complete both supports the open source Haskell ecosystem, as well
-as provides commercial support for those seeking it. If you're
-interested in learning more about how FP Complete can help you and
-your team be more successful in your development and devops work, you
-can
-[learn about what services we offer](https://www.fpcomplete.com/dev)
-or
-[contact us for a free consultation](mailto:consulting@fpcomplete.com).
+# Filehandler

From 79ca996ac39ac09b04d3682dc6591706116a008e Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sun, 7 Mar 2021 12:27:40 +0100
Subject: [PATCH 07/38] use a stack project instead of a single file, this
 enables typechecking

---
 ChangeLog.md      |   3 +
 Filehandler.cabal |  98 ++++++++++++++++++
 LICENSE           |  30 ++++++
 README.md         |   6 ++
 Setup.hs          |   2 +
 app/Main.hs       | 255 ++++++++++++++++++++++++++++++++++++++++++++++
 package.yaml      |  65 ++++++++++++
 src/Lib.hs        |   6 ++
 stack.yaml        |  83 +++++++++++++++
 stack.yaml.lock   |  13 +++
 test/Spec.hs      |   2 +
 11 files changed, 563 insertions(+)
 create mode 100644 ChangeLog.md
 create mode 100644 Filehandler.cabal
 create mode 100644 LICENSE
 create mode 100644 Setup.hs
 create mode 100644 app/Main.hs
 create mode 100644 package.yaml
 create mode 100644 src/Lib.hs
 create mode 100644 stack.yaml
 create mode 100644 stack.yaml.lock
 create mode 100644 test/Spec.hs

diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..3e2c396
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for Filehandler
+
+## Unreleased changes
diff --git a/Filehandler.cabal b/Filehandler.cabal
new file mode 100644
index 0000000..530efd4
--- /dev/null
+++ b/Filehandler.cabal
@@ -0,0 +1,98 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 810c23ddfee0d410c3632560ab726ca5db1e957ed8095989f8e2e7e554eb65f4
+
+name:           Filehandler
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/githubuser/Filehandler#readme>
+homepage:       https://github.com/githubuser/Filehandler#readme
+bug-reports:    https://github.com/githubuser/Filehandler/issues
+author:         Author name here
+maintainer:     example@example.com
+copyright:      2021 Author name here
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/githubuser/Filehandler
+
+library
+  exposed-modules:
+      Lib
+  other-modules:
+      Paths_Filehandler
+  hs-source-dirs:
+      src
+  build-depends:
+      base >=4.7 && <5
+    , req
+    , shakespeare
+    , wai
+    , wai-app-static
+    , wai-extra
+    , warp
+    , network
+    , text
+    , aeson
+    , filepath
+    , http-types
+    , bytestring
+    , directory
+    , case-insensitive
+    , blaze-html
+  default-language: Haskell2010
+
+executable Filehandler-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_Filehandler
+  hs-source-dirs:
+      app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      Filehandler
+    , base >=4.7 && <5
+    , req
+    , shakespeare
+    , wai
+    , wai-app-static
+    , wai-extra
+    , wai-cors
+    , warp
+    , network
+    , text
+    , aeson
+    , filepath
+    , http-types
+    , bytestring
+    , directory
+    , case-insensitive
+    , blaze-html
+  default-language: Haskell2010
+
+test-suite Filehandler-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_Filehandler
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      Filehandler
+    , base >=4.7 && <5
+    , req
+    , shakespeare
+    , wai-app-static
+    , wai-extra
+    , warp
+  default-language: Haskell2010
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..7caa388
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
index 4f88f6f..435b1bc 100644
--- a/README.md
+++ b/README.md
@@ -1 +1,7 @@
 # Filehandler
+
+`stack build --file-watch --watch-all  --fast`
+
+`filewatcher --restart '**/*.hs' 'stack build --fast && stack exec Filehandler-exe'`
+
+`stack exec Filehandler-exe`
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..7c25394
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE OverloadedStrings, DeriveGeneric, DuplicateRecordFields #-}
+
+-- We use the QuasiQuotes to embed Hamlet HTML templates inside
+-- our source file.
+{-# LANGUAGE QuasiQuotes #-}
+
+module Main where
+
+import Lib
+
+-- Import the various modules that we'll use in our code.
+import qualified Data.ByteString.Char8          as S8
+import qualified Data.ByteString.Lazy           as L
+import           Data.Functor.Identity
+import qualified Network.HTTP.Types             as HttpTypes
+import           Network.Wai
+import           Network.Wai.Application.Static
+import Network.Wai.Middleware.Cors
+import           Network.Wai.Handler.Warp
+import           Network.Wai.Parse
+import           System.Environment
+import           System.FilePath
+import           Text.Blaze.Html.Renderer.Utf8
+import           Text.Hamlet
+import Control.Monad.IO.Class
+import Data.Aeson
+import Network.HTTP.Req
+import Data.CaseInsensitive
+import qualified Data.Text as DataText
+import GHC.Int
+import GHC.Generics
+import System.Directory
+
+
+
+-- | Entrypoint to our application
+main :: IO ()
+main = do
+       -- For ease of setup, we want to have a "sanity" command line
+    -- argument. We'll see how this is used in the Dockerfile
+    -- later. Desired behavior:
+    --
+    --  If we have the argument "sanity", immediately exit
+    --  If we have no arguments, run the server
+    --  Otherwise, error out
+    args <- getArgs
+    case args of
+        ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
+        [] -> do
+            putStrLn "Launching DataHandler."
+            -- Run our application (defined below) on port 5000
+            run 5001 $ cors (const policy) app
+        _ -> error $ "Unknown arguments: " ++ show args
+
+-- | Our main application
+app :: Application
+app req send =
+    -- Route the request based on the path requested
+    case pathInfo req of
+       
+        -- "/upload": handle a file upload
+        ["upload"] -> upload req send
+
+        ["download"] -> download req send
+
+        -- anything else: 404
+        _ -> send $ responseLBS
+            HttpTypes.status404
+            [("Content-Type", "text/plain; charset=utf-8")]
+            "Endpoint does not exist"
+
+-- | Create an HTML page which links to the /browse URL, and allows
+-- for a file upload
+homepage :: Html
+homepage = [shamlet|
+$doctype 5
+<html>
+    <head>
+        <title>File server
+    <body>
+        <h1>File server
+        <p>
+            <a href=/browse/>Browse available files
+
+        <form method=POST action=/upload enctype=multipart/form-data>
+            <p>Upload a new file
+            <input type=file name=file>
+            <input type=submit>
+|]
+
+-- | Use the standard file server settings to serve files from the
+-- current directory
+fileServer :: Application
+fileServer = staticApp (defaultFileServerSettings ".")
+
+-- | Handle file uploads, storing the file in the current directory
+upload :: Application
+upload req send = do
+    -- Parse the request body. We'll ignore parameters and just look
+    -- at the files
+    (_params, files) <- parseRequestBody lbsBackEnd req
+    let headers = requestHeaders req
+   -- debug (_params)
+    -- Look for the file parameter called "file"
+    case lookup "file" files of
+        -- Not found, so return a 400 response
+        Nothing -> send $ responseLBS
+            HttpTypes.status400
+            [("Content-Type", "text/plain; charset=utf-8")]
+            "No file parameter found"
+        -- Got it!
+        Just file -> do
+            let content = fileContent file
+
+            -- Write it out
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content)
+            case responseStatusCode of
+                200 -> do
+                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String PostResponseFile)
+                    case d of
+                        Left err -> send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    (L.fromStrict $ S8.pack err)
+                        Right fileObject -> do 
+                                let id = fileSystemId (fileObject ::PostResponseFile)
+                                createDirectoryIfMissing True [head id]
+                                L.writeFile (head id :  ("/" ++id)) content
+                                send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    "uploaded"
+                _ ->
+                    send $ responseLBS
+                        (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
+                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        (L.fromStrict responseBody)
+
+
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO (S8.ByteString , Int, S8.ByteString)
+postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+  let payload =
+        object
+          [ "name" .= S8.unpack (fileName file),
+            "fileContentType" .= S8.unpack (fileContentType file),
+            "size" .= size
+          ]
+
+  -- One function—full power and flexibility, automatic retrying on timeouts
+  -- and such, automatic connection sharing.
+  r <-
+    req
+      POST -- method
+      (http "ptsv2.com" /: "t/os3vu-1615111052/post") -- safe by construction URL
+      (ReqBodyJson payload) -- use built-in options or add your own
+      bsResponse  -- specify how to interpret response
+      (header "X-FF-ParentID" (getOneHeader allheaders "X-FF-ParentID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+     -- mempty -- query params, headers, explicit port number, etc.
+  return (responseBody r, responseStatusCode r, responseStatusMessage r)
+
+
+
+download :: Application
+download req send = do
+    let headers = requestHeaders req
+    (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers
+    case responseStatusCode of
+                200 -> do
+                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [GetResponseFile])
+                    case d of
+                        Left err -> send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    (L.fromStrict $ S8.pack err)
+                        Right files -> 
+                            case files of
+                                [fileObject] -> do
+                                    let fileID = fileSystemId (fileObject::GetResponseFile) 
+                                    send $ responseFile
+                                        HttpTypes.status200
+                                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                                        (head fileID :  ("/" ++fileID))
+                                        Nothing
+                                [] ->
+                                    send $ responseLBS
+                                        HttpTypes.status200
+                                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                                        "nothing"
+                _ ->
+                    send $ responseLBS
+                        (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
+                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        (L.fromStrict responseBody)
+
+
+
+
+
+getApi :: [HttpTypes.Header] -> IO (S8.ByteString , Int, S8.ByteString)
+getApi allheaders= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+  r <-
+    req
+      GET -- method
+      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
+      NoReqBody -- use built-in options or add your own
+      bsResponse  -- specify how to interpret response
+      (header "X-FF-FileIDs" (getOneHeader allheaders "X-FF-FileIDs" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+     -- mempty -- query params, headers, explicit port number, etc.
+  return (responseBody r, responseStatusCode r, responseStatusMessage r)
+
+
+
+debug :: [Param] -> IO()
+debug what =
+    putStrLn (S8.unpack (snd (Prelude.head what)))
+
+
+getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
+getOneHeader headers headerName=
+    snd (head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers))
+
+
+
+httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
+httpConfigDontCheckResponse _ _ _ = Nothing
+
+
+
+data PostResponseFile =
+  PostResponseFile { fileSystemId  :: !String
+           } deriving (Show,Generic)
+
+instance FromJSON PostResponseFile
+instance ToJSON PostResponseFile
+
+
+data GetResponseFile =
+  GetResponseFile { fileSystemId :: !String  
+            , name :: !String
+           } deriving (Show,Generic)
+
+instance FromJSON GetResponseFile
+instance ToJSON GetResponseFile
+
+
+policy = Just CorsResourcePolicy {
+        corsOrigins = Nothing
+        , corsMethods = ["GET","POST"]
+        , corsRequestHeaders = ["Authorization", "content-type","X-FF-FileIDs","X-FF-ParentID"]
+        , corsExposedHeaders = Nothing
+        , corsMaxAge = Just $ 60*60*24 -- one day
+        , corsVaryOrigin = False
+        , corsRequireOrigin = False 
+        , corsIgnoreFailures = False
+      }
\ No newline at end of file
diff --git a/package.yaml b/package.yaml
new file mode 100644
index 0000000..6250490
--- /dev/null
+++ b/package.yaml
@@ -0,0 +1,65 @@
+name:                Filehandler
+version:             0.1.0.0
+github:              "githubuser/Filehandler"
+license:             BSD3
+author:              "Author name here"
+maintainer:          "example@example.com"
+copyright:           "2021 Author name here"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/Filehandler#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- req
+- shakespeare
+- wai
+- wai-app-static
+- wai-extra
+- warp
+- network
+- text
+- aeson
+- filepath
+- http-types
+- bytestring
+- directory
+- text
+- case-insensitive
+- blaze-html
+
+
+library:
+  source-dirs: src
+
+executables:
+  Filehandler-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - Filehandler
+
+tests:
+  Filehandler-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - Filehandler
diff --git a/src/Lib.hs b/src/Lib.hs
new file mode 100644
index 0000000..d36ff27
--- /dev/null
+++ b/src/Lib.hs
@@ -0,0 +1,6 @@
+module Lib
+    ( someFunc
+    ) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..c5ef460
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,83 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/5.yaml
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+#extra-deps:
+#- req
+#- shakespeare
+#- wai
+#- wai-app-static
+#- wai-extra
+#- warp
+#- network
+#- text
+#- aeson
+#- filepath
+#- http-types
+#- bytestring
+#- directory
+#- text
+#- case-insensitive
+#- blaze-html
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.5"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
diff --git a/stack.yaml.lock b/stack.yaml.lock
new file mode 100644
index 0000000..9d3217f
--- /dev/null
+++ b/stack.yaml.lock
@@ -0,0 +1,13 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+    size: 565266
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/5.yaml
+    sha256: 78e8ebabf11406261abbc95b44f240acf71802630b368888f6d758de7fc3a2f7
+  original:
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/5.yaml
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"

From 4df783b8d0151fb133604fbbad2bb03865419257 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sun, 7 Mar 2021 12:29:34 +0100
Subject: [PATCH 08/38] remove old main file

---
 FileHandler.hs | 272 -------------------------------------------------
 1 file changed, 272 deletions(-)
 delete mode 100755 FileHandler.hs

diff --git a/FileHandler.hs b/FileHandler.hs
deleted file mode 100755
index e86c517..0000000
--- a/FileHandler.hs
+++ /dev/null
@@ -1,272 +0,0 @@
-#!/usr/bin/env stack
-{- stack
-    --resolver lts-17.4
-    --install-ghc
-    runghc
-    --package shakespeare
-    --package wai-app-static
-    --package wai-extra
-    --package warp
-    --package req
- -}
-
--- The code above is used for Haskell Stack's script interpreter
--- feature. For more information, see:
--- https://docs.haskellstack.org/en/stable/GUIDE/#script-interpreter
---
--- Note how we explicitly list an LTS Haskell snapshot
--- (https://www.stackage.org/lts-6.11) to ensure reproducibility. We
--- then state which packages need to be present to run this code.
-
--- Enable the OverloadedStrings extension, a commonly used feature.
-{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
-
--- We use the QuasiQuotes to embed Hamlet HTML templates inside
--- our source file.
-{-# LANGUAGE QuasiQuotes #-}
-
--- Import the various modules that we'll use in our code.
-import qualified Data.ByteString.Char8          as S8
-import qualified Data.ByteString.Lazy           as L
-import           Data.Functor.Identity
-import qualified Network.HTTP.Types             as HttpTypes
-import           Network.Wai
-import           Network.Wai.Application.Static
-import           Network.Wai.Handler.Warp
-import           Network.Wai.Parse
-import           System.Environment
-import           System.FilePath
-import           Text.Blaze.Html.Renderer.Utf8
-import           Text.Hamlet
-import Control.Monad.IO.Class
-import Data.Aeson
-import Network.HTTP.Req
-import Data.CaseInsensitive
-import qualified Data.Text as DataText
-import GHC.Int
-import GHC.Generics
-import System.Directory
-
-
-
--- | Entrypoint to our application
-main :: IO ()
-main = do
-       -- For ease of setup, we want to have a "sanity" command line
-    -- argument. We'll see how this is used in the Dockerfile
-    -- later. Desired behavior:
-    --
-    -- * If we have the argument "sanity", immediately exit
-    -- * If we have no arguments, run the server
-    -- * Otherwise, error out
-    args <- getArgs
-    case args of
-        ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
-        [] -> do
-            putStrLn "Launching DataHandler."
-            -- Run our application (defined below) on port 5000
-            run 5002 app
-        _ -> error $ "Unknown arguments: " ++ show args
-
--- | Our main application
-app :: Application
-app req send =
-    -- Route the request based on the path requested
-    case pathInfo req of
-        -- "/": send the HTML homepage contents
-        [] -> send $ responseBuilder
-                HttpTypes.status200
-                [("Content-Type", "text/html; charset=utf-8")]
-                (renderHtmlBuilder homepage)
-
-        -- "/browse/...": use the file server to allow directory
-        -- listings and downloading files
-        ("browse":rest) ->
-            -- We create a modified request that strips off the
-            -- "browse" component of the path, so that the file server
-            -- does not need to look inside a /browse/ directory
-            let req' = req { pathInfo = rest }
-             in fileServer req' send
-
-        -- "/upload": handle a file upload
-        ["upload"] -> upload req send
-
-        ["download"] -> download req send
-
-        -- anything else: 404
-        _ -> send $ responseLBS
-            HttpTypes.status404
-            [("Content-Type", "text/plain; charset=utf-8")]
-            "Endpoint does not exist"
-
--- | Create an HTML page which links to the /browse URL, and allows
--- for a file upload
-homepage :: Html
-homepage = [shamlet|
-$doctype 5
-<html>
-    <head>
-        <title>File server
-    <body>
-        <h1>File server
-        <p>
-            <a href=/browse/>Browse available files
-
-        <form method=POST action=/upload enctype=multipart/form-data>
-            <p>Upload a new file
-            <input type=file name=file>
-            <input type=submit>
-|]
-
--- | Use the standard file server settings to serve files from the
--- current directory
-fileServer :: Application
-fileServer = staticApp (defaultFileServerSettings ".")
-
--- | Handle file uploads, storing the file in the current directory
-upload :: Application
-upload req send = do
-    -- Parse the request body. We'll ignore parameters and just look
-    -- at the files
-    (_params, files) <- parseRequestBody lbsBackEnd req
-    let headers = requestHeaders req
-   -- debug (_params)
-    -- Look for the file parameter called "file"
-    case lookup "file" files of
-        -- Not found, so return a 400 response
-        Nothing -> send $ responseLBS
-            HttpTypes.status400
-            [("Content-Type", "text/plain; charset=utf-8")]
-            "No file parameter found"
-        -- Got it!
-        Just file -> do
-            let content = fileContent file
-
-            -- Write it out
-            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content)
-            case responseStatusCode of
-                200 -> do
-                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String PostResponseFile)
-                    case d of
-                        Left err -> send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "text/plain: charset=utf-8")]
-                                    (L.fromStrict $ S8.pack err)
-                        Right fileObject -> do 
-                                let id = fileSystemId fileObject
-                                createDirectoryIfMissing True [head id]
-                                L.writeFile (head id :  ("/" ++id)) content
-                                send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "text/plain: charset=utf-8")]
-                                    "uploaded"
-                _ ->
-                    send $ responseLBS
-                        (HttpTypes.mkStatus responseStatusCode (responseStatusMessage))
-                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                        (L.fromStrict responseBody)
-
-
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO (S8.ByteString , Int, S8.ByteString)
-postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
-  let payload =
-        object
-          [ "name" .= S8.unpack (fileName file),
-            "fileContentType" .= S8.unpack (fileContentType file),
-            "size" .= size
-          ]
-
-  -- One function—full power and flexibility, automatic retrying on timeouts
-  -- and such, automatic connection sharing.
-  r <-
-    req
-      POST -- method
-      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
-      (ReqBodyJson payload) -- use built-in options or add your own
-      bsResponse  -- specify how to interpret response
-      (header "X-FF-ParentID" (getOneHeader allheaders "X-FF-ParentID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
-     -- mempty -- query params, headers, explicit port number, etc.
-  return (responseBody r, responseStatusCode r, responseStatusMessage r)
-
-
-
-download :: Application
-download req send = do
-    let headers = requestHeaders req
-    (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers
-    case responseStatusCode of
-                200 -> do
-                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [GetResponseFile])
-                    case d of
-                        Left err -> send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "text/plain: charset=utf-8")]
-                                    (L.fromStrict $ S8.pack err)
-                        Right files -> 
-                            case files of
-                                [fileObject] -> do
-                                    let fileID = fsid fileObject 
-                                    send $ responseFile
-                                        HttpTypes.status200
-                                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                                        (head fileID :  ("/" ++fileID))
-                                        (Nothing)
-                                [] ->
-                                    send $ responseLBS
-                                        HttpTypes.status200
-                                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                                        "nothing"
-                _ ->
-                    send $ responseLBS
-                        (HttpTypes.mkStatus responseStatusCode (responseStatusMessage))
-                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                        (L.fromStrict responseBody)
-
-
-
-
-
-getApi :: [HttpTypes.Header] -> IO (S8.ByteString , Int, S8.ByteString)
-getApi allheaders= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
-  r <-
-    req
-      GET -- method
-      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
-      NoReqBody -- use built-in options or add your own
-      bsResponse  -- specify how to interpret response
-      (header "X-FF-FileIDs" (getOneHeader allheaders "X-FF-FileIDs" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
-     -- mempty -- query params, headers, explicit port number, etc.
-  return (responseBody r, responseStatusCode r, responseStatusMessage r)
-
-
-
-debug :: [Param] -> IO()
-debug what =
-    putStrLn (S8.unpack (snd (Prelude.head what)))
-
-
-getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
-getOneHeader headers headerName=
-    snd (head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers))
-
-
-
-httpConfigDontCheckResponse _ _ _ = Nothing
-
-
-
-data PostResponseFile =
-  PostResponseFile { fileSystemId  :: !String
-           } deriving (Show,Generic)
-
-instance FromJSON PostResponseFile
-instance ToJSON PostResponseFile
-
-
-data GetResponseFile =
-  GetResponseFile { fsid :: !String  
-            , name :: !String
-           } deriving (Show,Generic)
-
-instance FromJSON GetResponseFile
-instance ToJSON GetResponseFile
\ No newline at end of file

From 4308dc206c7f7490fffc0653c5abdc4ccb92d2dd Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 13 Mar 2021 12:40:15 +0100
Subject: [PATCH 09/38] cleanup arg handlign

---
 Filehandler.cabal |  1 +
 app/Main.hs       | 66 +++++++++++++++++++++--------------------------
 2 files changed, 31 insertions(+), 36 deletions(-)

diff --git a/Filehandler.cabal b/Filehandler.cabal
index 530efd4..29e1fc7 100644
--- a/Filehandler.cabal
+++ b/Filehandler.cabal
@@ -77,6 +77,7 @@ executable Filehandler-exe
     , directory
     , case-insensitive
     , blaze-html
+    , mtl
   default-language: Haskell2010
 
 test-suite Filehandler-test
diff --git a/app/Main.hs b/app/Main.hs
index 7c25394..c8e8f1d 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,8 +1,5 @@
 {-# LANGUAGE OverloadedStrings, DeriveGeneric, DuplicateRecordFields #-}
 
--- We use the QuasiQuotes to embed Hamlet HTML templates inside
--- our source file.
-{-# LANGUAGE QuasiQuotes #-}
 
 module Main where
 
@@ -30,6 +27,7 @@ import qualified Data.Text as DataText
 import GHC.Int
 import GHC.Generics
 import System.Directory
+import Control.Monad.State
 
 
 
@@ -46,14 +44,18 @@ main = do
     args <- getArgs
     case args of
         ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
-        [] -> do
-            putStrLn "Launching DataHandler."
+        [restUrl,"dev"] -> do
+            putStrLn "Launching DataHandler with dev profile"
             -- Run our application (defined below) on port 5000
-            run 5001 $ cors (const policy) app
+            run 5002 $ cors (const devCorsPolicy) (app)
+        [restUrl] -> do
+            putStrLn "Launching DataHandler with prod profile"
+            -- Run our application (defined below) on port 5000
+            run 5002 (app)
         _ -> error $ "Unknown arguments: " ++ show args
 
 -- | Our main application
-app :: Application
+app :: Application 
 app req send =
     -- Route the request based on the path requested
     case pathInfo req of
@@ -69,32 +71,11 @@ app req send =
             [("Content-Type", "text/plain; charset=utf-8")]
             "Endpoint does not exist"
 
--- | Create an HTML page which links to the /browse URL, and allows
--- for a file upload
-homepage :: Html
-homepage = [shamlet|
-$doctype 5
-<html>
-    <head>
-        <title>File server
-    <body>
-        <h1>File server
-        <p>
-            <a href=/browse/>Browse available files
-
-        <form method=POST action=/upload enctype=multipart/form-data>
-            <p>Upload a new file
-            <input type=file name=file>
-            <input type=submit>
-|]
-
--- | Use the standard file server settings to serve files from the
--- current directory
-fileServer :: Application
-fileServer = staticApp (defaultFileServerSettings ".")
+
+
 
 -- | Handle file uploads, storing the file in the current directory
-upload :: Application
+upload :: Application 
 upload req send = do
     -- Parse the request body. We'll ignore parameters and just look
     -- at the files
@@ -151,10 +132,10 @@ postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse
   r <-
     req
       POST -- method
-      (http "ptsv2.com" /: "t/os3vu-1615111052/post") -- safe by construction URL
+      (http "restUrl" /: "t/os3vu-1615111052/post") -- safe by construction URL
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-ParentID" (getOneHeader allheaders "X-FF-ParentID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+      (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
      -- mempty -- query params, headers, explicit port number, etc.
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
@@ -204,7 +185,7 @@ getApi allheaders= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConf
       (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-FileIDs" (getOneHeader allheaders "X-FF-FileIDs" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+      (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
      -- mempty -- query params, headers, explicit port number, etc.
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
@@ -243,7 +224,19 @@ instance FromJSON GetResponseFile
 instance ToJSON GetResponseFile
 
 
-policy = Just CorsResourcePolicy {
+devCorsPolicy = Just CorsResourcePolicy {
+        corsOrigins = Nothing
+        , corsMethods = ["GET","POST"]
+        , corsRequestHeaders = ["Authorization", "content-type","X-FF-FileIDs","X-FF-ParentID"]
+        , corsExposedHeaders = Nothing
+        , corsMaxAge = Just $ 60*60*24 -- one day
+        , corsVaryOrigin = False
+        , corsRequireOrigin = False 
+        , corsIgnoreFailures = False
+      }
+
+-- maybe needed for prod?
+prodCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
         , corsMethods = ["GET","POST"]
         , corsRequestHeaders = ["Authorization", "content-type","X-FF-FileIDs","X-FF-ParentID"]
@@ -252,4 +245,5 @@ policy = Just CorsResourcePolicy {
         , corsVaryOrigin = False
         , corsRequireOrigin = False 
         , corsIgnoreFailures = False
-      }
\ No newline at end of file
+      }
+      
\ No newline at end of file

From 22bdfe3e1ca3bafc75108b7eae93d076e9e6461d Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 13 Mar 2021 15:10:09 +0100
Subject: [PATCH 10/38] added build pipeline and docker image

---
 .github/workflows/latestRelease.yml | 40 ++++++++++++++++++
 Dockerfile                          | 30 ++++---------
 app/Main.hs                         | 31 ++++++++------
 package.yaml                        | 65 -----------------------------
 4 files changed, 66 insertions(+), 100 deletions(-)
 create mode 100644 .github/workflows/latestRelease.yml
 delete mode 100644 package.yaml

diff --git a/.github/workflows/latestRelease.yml b/.github/workflows/latestRelease.yml
new file mode 100644
index 0000000..8663d34
--- /dev/null
+++ b/.github/workflows/latestRelease.yml
@@ -0,0 +1,40 @@
+name: Latest Release
+
+on:
+  workflow_dispatch:
+  push:
+    branches: "master"
+    paths:
+      - 'app/**'
+      - 'src/**'
+      - 'test/**'
+
+jobs:
+  Build_Docker_Image_on_Push:
+    runs-on: ubuntu-latest
+    steps:
+      -
+        name: Set up Project
+        uses: actions/checkout@v2
+      -
+        name: Build Filehandler
+        run: |
+          stack build
+          
+      -
+        name: Login to DockerHub
+        uses: docker/login-action@v1
+        with:
+          username: ${{ secrets.DOCKER_USER }}
+          password: ${{ secrets.DOCKER_PW }}
+      -
+        name: Build and push
+        run: |
+          BINLOCATION=$(stack path --local-install-root)
+          BINLOCATION=$(realpath --relative-to=. $BINLOCATION)
+          docker build -t filefighter/filehandler:latest . --build-arg BINLOCATION=$BINLOCATION
+          docker push filefighter/filehandler:latest
+      -
+        name: Trigger update on server
+        run:
+          - curl -u ${{ secrets.LOG_CREDS }} https://logs.filefighter.de/filefighter-update.log
\ No newline at end of file
diff --git a/Dockerfile b/Dockerfile
index d94c63d..795d0a8 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,33 +1,17 @@
-FROM ubuntu:16.04
+FROM ubuntu:latest
 
-# Get dumb-init to avoid Ctrl-C issues. See:
-# http://engineeringblog.yelp.com/2016/01/dumb-init-an-init-for-docker.html
-ADD https://github.com/Yelp/dumb-init/releases/download/v1.1.3/dumb-init_1.1.3_amd64 /usr/local/bin/dumb-init
-RUN chmod +x /usr/local/bin/dumb-init
+ARG BINLOCATION
+ENV RESTURL=ptsv2.com
 
-# Set up Haskell Stack, the Haskell build tool.
-# Stack is the only dependency we have to run our application.
-# Once available, it will grab everything else we need
-# (compiler, libraries, etc).
-ADD https://get.haskellstack.org/get-stack.sh /usr/local/bin/
-RUN sh /usr/local/bin/get-stack.sh
+RUN echo $BINLOCATION
 
 # Copy over the source code and make it executable.
-COPY FileHandler.hs /usr/local/bin/file-handler
-RUN chmod +x /usr/local/bin/file-handler
+ADD $BINLOCATION/bin/Filehandler-exe /usr/local/bin/filehandler-exe
+RUN chmod +x /usr/local/bin/filehandler-exe
 
-# Create a new user account and directory to run from, and then
-# run everything else as that user.
-RUN useradd -m www && mkdir -p /workdir && chown www /workdir
-USER www
-
-# We run our application with "sanity" to force it to install all of
-# its dependencies during Docker image build time, making the Docker
-# image launch much faster.
-RUN /usr/local/bin/file-handler sanity
 
 # We're all ready, now just configure our image to run the server on
 # launch from the correct working directory.
-CMD ["/usr/local/bin/dumb-init", "/usr/local/bin/file-handler"]
+CMd /usr/local/bin/filehandler-exe ${RESTURL}
 WORKDIR /workdir
 EXPOSE 5000
\ No newline at end of file
diff --git a/app/Main.hs b/app/Main.hs
index c8e8f1d..38bd267 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -47,11 +47,11 @@ main = do
         [restUrl,"dev"] -> do
             putStrLn "Launching DataHandler with dev profile"
             -- Run our application (defined below) on port 5000
-            run 5002 $ cors (const devCorsPolicy) (app)
+            run 5000 $ cors (const devCorsPolicy) (app)
         [restUrl] -> do
             putStrLn "Launching DataHandler with prod profile"
             -- Run our application (defined below) on port 5000
-            run 5002 (app)
+            run 5000 (app)
         _ -> error $ "Unknown arguments: " ++ show args
 
 -- | Our main application
@@ -92,9 +92,10 @@ upload req send = do
         -- Got it!
         Just file -> do
             let content = fileContent file
+            restUrl <- getRestUrl
 
             -- Write it out
-            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content)
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content) restUrl
             case responseStatusCode of
                 200 -> do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String PostResponseFile)
@@ -118,8 +119,8 @@ upload req send = do
                         (L.fromStrict responseBody)
 
 
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> IO (S8.ByteString , Int, S8.ByteString)
-postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> String -> IO (S8.ByteString , Int, S8.ByteString)
+postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
           [ "name" .= S8.unpack (fileName file),
@@ -132,10 +133,10 @@ postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse
   r <-
     req
       POST -- method
-      (http "restUrl" /: "t/os3vu-1615111052/post") -- safe by construction URL
+      (http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- safe by construction URL
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+      (header "X-FF-ID" (getOneHeader allheaders "X-FF-ID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
      -- mempty -- query params, headers, explicit port number, etc.
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
@@ -144,7 +145,8 @@ postApi allheaders file size= runReq (defaultHttpConfig {httpConfigCheckResponse
 download :: Application
 download req send = do
     let headers = requestHeaders req
-    (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers
+    restUrl <- getRestUrl
+    (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers restUrl
     case responseStatusCode of
                 200 -> do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [GetResponseFile])
@@ -177,12 +179,12 @@ download req send = do
 
 
 
-getApi :: [HttpTypes.Header] -> IO (S8.ByteString , Int, S8.ByteString)
-getApi allheaders= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+getApi :: [HttpTypes.Header] -> String -> IO (S8.ByteString , Int, S8.ByteString)
+getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   r <-
     req
       GET -- method
-      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URL
+      (http (DataText.pack restUrl) /: "t/vmlnd-1614506338/post") -- safe by construction URL
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
       (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
@@ -246,4 +248,9 @@ prodCorsPolicy = Just CorsResourcePolicy {
         , corsRequireOrigin = False 
         , corsIgnoreFailures = False
       }
-      
\ No newline at end of file
+      
+
+getRestUrl :: IO String
+getRestUrl= do
+    args <- getArgs
+    return $ head args
\ No newline at end of file
diff --git a/package.yaml b/package.yaml
deleted file mode 100644
index 6250490..0000000
--- a/package.yaml
+++ /dev/null
@@ -1,65 +0,0 @@
-name:                Filehandler
-version:             0.1.0.0
-github:              "githubuser/Filehandler"
-license:             BSD3
-author:              "Author name here"
-maintainer:          "example@example.com"
-copyright:           "2021 Author name here"
-
-extra-source-files:
-- README.md
-- ChangeLog.md
-
-# Metadata used when publishing your package
-# synopsis:            Short description of your package
-# category:            Web
-
-# To avoid duplicated efforts in documentation and dealing with the
-# complications of embedding Haddock markup inside cabal files, it is
-# common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/githubuser/Filehandler#readme>
-
-dependencies:
-- base >= 4.7 && < 5
-- req
-- shakespeare
-- wai
-- wai-app-static
-- wai-extra
-- warp
-- network
-- text
-- aeson
-- filepath
-- http-types
-- bytestring
-- directory
-- text
-- case-insensitive
-- blaze-html
-
-
-library:
-  source-dirs: src
-
-executables:
-  Filehandler-exe:
-    main:                Main.hs
-    source-dirs:         app
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - Filehandler
-
-tests:
-  Filehandler-test:
-    main:                Spec.hs
-    source-dirs:         test
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - Filehandler

From 48f0a7bcfffc1106215e7d3ee582585820f846a0 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 13 Mar 2021 15:17:18 +0100
Subject: [PATCH 11/38] change readme

---
 README.md | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 435b1bc..318e774 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,28 @@
-# Filehandler
+# FileHandlerService
+
+Haskell FileHandler Server.
+
+_Work In Progress_
+
+Base of this code base is this [repo](https://github.com/snoyberg/file-server-demo)
+
+## Features
+- [ ] browse does not exist anymore.
+- [ ] upload path is POST /upload?id=id,id1,id2&token=token
+- [ ] request to upload triggers request to backend
+- [ ] upload does support multiple files
+- [ ] download path is GET /download?id=id,id1,id2&token=token
+- [ ] request to download triggers request to backend
+- [ ] download supports multiple files (zipped as one)
+- [ ] service is either mapped with a usefull prefix /userdata/ or a fake subdomain files.....de/upload...  
+**(Roadmap feature)**
+- [ ] there is another path /preview/id?token=token
+
+Text below is from the original code base.
+
+---
+
+# Getting started
 
 `stack build --file-watch --watch-all  --fast`
 

From e01dc1d8a19f10879c52f2ebb470640ec66f4371 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Tue, 23 Mar 2021 12:12:07 +0100
Subject: [PATCH 12/38] minor chnges on profile and headers

---
 app/Main.hs | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 38bd267..9ba4654 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -47,11 +47,11 @@ main = do
         [restUrl,"dev"] -> do
             putStrLn "Launching DataHandler with dev profile"
             -- Run our application (defined below) on port 5000
-            run 5000 $ cors (const devCorsPolicy) (app)
-        [restUrl] -> do
+            run 5000 $ cors (const devCorsPolicy) app
+        [restUrl,"prod"] -> do
             putStrLn "Launching DataHandler with prod profile"
             -- Run our application (defined below) on port 5000
-            run 5000 (app)
+            run 5000 app
         _ -> error $ "Unknown arguments: " ++ show args
 
 -- | Our main application
@@ -229,7 +229,7 @@ instance ToJSON GetResponseFile
 devCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
         , corsMethods = ["GET","POST"]
-        , corsRequestHeaders = ["Authorization", "content-type","X-FF-FileIDs","X-FF-ParentID"]
+        , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID"]
         , corsExposedHeaders = Nothing
         , corsMaxAge = Just $ 60*60*24 -- one day
         , corsVaryOrigin = False
@@ -241,7 +241,7 @@ devCorsPolicy = Just CorsResourcePolicy {
 prodCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
         , corsMethods = ["GET","POST"]
-        , corsRequestHeaders = ["Authorization", "content-type","X-FF-FileIDs","X-FF-ParentID"]
+        , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID"]
         , corsExposedHeaders = Nothing
         , corsMaxAge = Just $ 60*60*24 -- one day
         , corsVaryOrigin = False
@@ -251,6 +251,4 @@ prodCorsPolicy = Just CorsResourcePolicy {
       
 
 getRestUrl :: IO String
-getRestUrl= do
-    args <- getArgs
-    return $ head args
\ No newline at end of file
+getRestUrl=head <$> getArgs
\ No newline at end of file

From 74e7af4007acf5ce21f68c0858eea01140303d68 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Wed, 24 Mar 2021 10:54:19 +0100
Subject: [PATCH 13/38] only use json, add header for filesize

---
 app/Main.hs | 57 +++++++++++++++++++++++++++++++++--------------------
 1 file changed, 36 insertions(+), 21 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 9ba4654..6411fd8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -28,7 +28,7 @@ import GHC.Int
 import GHC.Generics
 import System.Directory
 import Control.Monad.State
-
+import System.IO
 
 
 -- | Entrypoint to our application
@@ -68,8 +68,8 @@ app req send =
         -- anything else: 404
         _ -> send $ responseLBS
             HttpTypes.status404
-            [("Content-Type", "text/plain; charset=utf-8")]
-            "Endpoint does not exist"
+            [("Content-Type", "application/json; charset=utf-8")]
+            (encode $ RestApiStatus "This endpoint does not exist." "Not Found")
 
 
 
@@ -87,8 +87,8 @@ upload req send = do
         -- Not found, so return a 400 response
         Nothing -> send $ responseLBS
             HttpTypes.status400
-            [("Content-Type", "text/plain; charset=utf-8")]
-            "No file parameter found"
+            [("Content-Type", "application/json; charset=utf-8")]
+            (encode $ RestApiStatus "No file parameter found" "Bad Request")
         -- Got it!
         Just file -> do
             let content = fileContent file
@@ -101,21 +101,21 @@ upload req send = do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String PostResponseFile)
                     case d of
                         Left err -> send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "text/plain: charset=utf-8")]
-                                    (L.fromStrict $ S8.pack err)
+                                    HttpTypes.status500
+                                    [ ("Content-Type", "application/json; charset=utf-8")]
+                                    (encode $ RestApiStatus err "Internal Server Error")
                         Right fileObject -> do 
                                 let id = fileSystemId (fileObject ::PostResponseFile)
                                 createDirectoryIfMissing True [head id]
                                 L.writeFile (head id :  ("/" ++id)) content
                                 send $ responseLBS
                                     HttpTypes.status200
-                                    [ ("Content-Type", "text/plain: charset=utf-8")]
-                                    "uploaded"
+                                    [ ("Content-Type", "application/json; charset=utf-8")]
+                                    (encode $ RestApiStatus "Uploaded" "Success")
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
-                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        [ ("Content-Type", "application/json; charset=utf-8")]
                         (L.fromStrict responseBody)
 
 
@@ -152,27 +152,29 @@ download req send = do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [GetResponseFile])
                     case d of
                         Left err -> send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "text/plain: charset=utf-8")]
+                                    HttpTypes.status501
+                                    [ ("Content-Type", "application/json; charset=utf-8")]
                                     (L.fromStrict $ S8.pack err)
                         Right files -> 
                             case files of
                                 [fileObject] -> do
-                                    let fileID = fileSystemId (fileObject::GetResponseFile) 
+                                    let fileID = fileSystemId (fileObject::GetResponseFile)
+                                    let path = head fileID :  ("/" ++fileID)
+                                    filesize <- withFile path ReadMode hFileSize
                                     send $ responseFile
                                         HttpTypes.status200
-                                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                                        (head fileID :  ("/" ++fileID))
+                                        [("X-FF-SIZE", S8.pack $ show filesize)] -- TODO: use the correct mimetype
+                                        path
                                         Nothing
                                 [] ->
                                     send $ responseLBS
-                                        HttpTypes.status200
-                                        [ ("Content-Type", "text/plain: charset=utf-8")]
-                                        "nothing"
+                                        HttpTypes.status501
+                                        [ ("Content-Type", "application/json; charset=utf-8")]
+                                        (encode $ RestApiStatus "Uploaded" "Not Implemented")
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
-                        [ ("Content-Type", "text/plain: charset=utf-8")]
+                        [ ("Content-Type", "application/json; charset=utf-8")]
                         (L.fromStrict responseBody)
 
 
@@ -204,6 +206,8 @@ getOneHeader headers headerName=
 
 
 
+
+
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
 httpConfigDontCheckResponse _ _ _ = Nothing
 
@@ -222,9 +226,20 @@ data GetResponseFile =
             , name :: !String
            } deriving (Show,Generic)
 
+
+
+
 instance FromJSON GetResponseFile
 instance ToJSON GetResponseFile
 
+data RestApiStatus = 
+    RestApiStatus {
+        message :: !String
+        , status :: !String
+    } deriving (Show,Generic)
+
+instance FromJSON RestApiStatus
+instance ToJSON RestApiStatus
 
 devCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
@@ -251,4 +266,4 @@ prodCorsPolicy = Just CorsResourcePolicy {
       
 
 getRestUrl :: IO String
-getRestUrl=head <$> getArgs
\ No newline at end of file
+getRestUrl=head <$> getArgs

From ec5566a125ee4bd3837c6ea6f99d0a6d4ac81b35 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Wed, 24 Mar 2021 12:44:28 +0100
Subject: [PATCH 14/38] add mimetype

---
 app/Main.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 6411fd8..87f9fed 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -125,7 +125,8 @@ postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheck
         object
           [ "name" .= S8.unpack (fileName file),
             "fileContentType" .= S8.unpack (fileContentType file),
-            "size" .= size
+            "size" .= size,
+            "relativePath" .= ("TODO" :: String)
           ]
 
   -- One function—full power and flexibility, automatic retrying on timeouts
@@ -133,7 +134,7 @@ postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheck
   r <-
     req
       POST -- method
-      (http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- safe by construction URL
+      (http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
       (header "X-FF-ID" (getOneHeader allheaders "X-FF-ID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
@@ -163,7 +164,7 @@ download req send = do
                                     filesize <- withFile path ReadMode hFileSize
                                     send $ responseFile
                                         HttpTypes.status200
-                                        [("X-FF-SIZE", S8.pack $ show filesize)] -- TODO: use the correct mimetype
+                                        [("Content-Disposition","attachment; filename=\"example-file.mp4\"")] -- TODO: use the correct mimetype 
                                         path
                                         Nothing
                                 [] ->
@@ -202,7 +203,9 @@ debug what =
 
 getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
 getOneHeader headers headerName=
-    snd (head (Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers))
+    case Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers of 
+        [header] -> snd header
+        _ -> ""
 
 
 
@@ -245,7 +248,7 @@ devCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
         , corsMethods = ["GET","POST"]
         , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID"]
-        , corsExposedHeaders = Nothing
+        , corsExposedHeaders =  Just ["Content-Disposition"]
         , corsMaxAge = Just $ 60*60*24 -- one day
         , corsVaryOrigin = False
         , corsRequireOrigin = False 

From bde238f7f8053376beccb2f34a0757cf82567e86 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Wed, 24 Mar 2021 12:44:54 +0100
Subject: [PATCH 15/38] add mimetype

---
 app/Main.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/app/Main.hs b/app/Main.hs
index 87f9fed..dc2ccc5 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -124,11 +124,12 @@ postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheck
   let payload =
         object
           [ "name" .= S8.unpack (fileName file),
-            "fileContentType" .= S8.unpack (fileContentType file),
+            "mimetype" .= S8.unpack (fileContentType file),
             "size" .= size,
             "relativePath" .= ("TODO" :: String)
           ]
 
+
   -- One function—full power and flexibility, automatic retrying on timeouts
   -- and such, automatic connection sharing.
   r <-

From 524fd87886a63a02043d4c3e229bfe350ae07140 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Wed, 24 Mar 2021 17:59:40 +0100
Subject: [PATCH 16/38] refactor rest response type

---
 app/Main.hs | 47 +++++++++++++++++++++++++----------------------
 1 file changed, 25 insertions(+), 22 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index dc2ccc5..15a88fe 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -98,20 +98,20 @@ upload req send = do
             (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content) restUrl
             case responseStatusCode of
                 200 -> do
-                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String PostResponseFile)
+                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String RestResponseFile)
                     case d of
                         Left err -> send $ responseLBS
                                     HttpTypes.status500
                                     [ ("Content-Type", "application/json; charset=utf-8")]
                                     (encode $ RestApiStatus err "Internal Server Error")
                         Right fileObject -> do 
-                                let id = fileSystemId (fileObject ::PostResponseFile)
+                                let id = fileSystemId (fileObject ::RestResponseFile)
                                 createDirectoryIfMissing True [head id]
                                 L.writeFile (head id :  ("/" ++id)) content
                                 send $ responseLBS
                                     HttpTypes.status200
                                     [ ("Content-Type", "application/json; charset=utf-8")]
-                                    (encode $ RestApiStatus "Uploaded" "Success")
+                                     (L.fromStrict responseBody)
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
@@ -136,6 +136,7 @@ postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheck
     req
       POST -- method
       (http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
+      --(http (DataText.pack restUrl) /: (DataText.pack  ("api/v1/filesystem/" ++ (S8.unpack $ getOneHeader allheaders "X-FF-ID" ) ++ "/upload"))) -- TODO: parentID in url
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
       (header "X-FF-ID" (getOneHeader allheaders "X-FF-ID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
@@ -151,7 +152,7 @@ download req send = do
     (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers restUrl
     case responseStatusCode of
                 200 -> do
-                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [GetResponseFile])
+                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [RestResponseFile])
                     case d of
                         Left err -> send $ responseLBS
                                     HttpTypes.status501
@@ -160,7 +161,7 @@ download req send = do
                         Right files -> 
                             case files of
                                 [fileObject] -> do
-                                    let fileID = fileSystemId (fileObject::GetResponseFile)
+                                    let fileID = fileSystemId (fileObject::RestResponseFile)
                                     let path = head fileID :  ("/" ++fileID)
                                     filesize <- withFile path ReadMode hFileSize
                                     send $ responseFile
@@ -209,33 +210,35 @@ getOneHeader headers headerName=
         _ -> ""
 
 
-
-
-
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
 httpConfigDontCheckResponse _ _ _ = Nothing
 
 
-
-data PostResponseFile =
-  PostResponseFile { fileSystemId  :: !String
-           } deriving (Show,Generic)
-
-instance FromJSON PostResponseFile
-instance ToJSON PostResponseFile
-
-
-data GetResponseFile =
-  GetResponseFile { fileSystemId :: !String  
+data RestResponseFile =
+  GetResponseFile { 
+            fileSystemId :: !String  
             , name :: !String
+            , path :: !String
+            , size :: Int 
+            , createdByUser :: User
+            , lastUpdated :: Int 
+            , mimetype :: String
+            , shared :: Bool 
            } deriving (Show,Generic)
 
+instance FromJSON RestResponseFile
+instance ToJSON RestResponseFile
+data User = 
+    User {
+        userId :: Int 
+        , username :: String
+        , groups :: [String]
+    } deriving (Show,Generic)
 
+instance FromJSON User
+instance ToJSON User
 
 
-instance FromJSON GetResponseFile
-instance ToJSON GetResponseFile
-
 data RestApiStatus = 
     RestApiStatus {
         message :: !String

From ce24243ff5ef5401347d0fa25fd9f0be6c45626e Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Wed, 24 Mar 2021 18:01:51 +0100
Subject: [PATCH 17/38] add feature release workflow

---
 .github/workflows/featureRelease.yml | 41 ++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)
 create mode 100644 .github/workflows/featureRelease.yml

diff --git a/.github/workflows/featureRelease.yml b/.github/workflows/featureRelease.yml
new file mode 100644
index 0000000..6e973a7
--- /dev/null
+++ b/.github/workflows/featureRelease.yml
@@ -0,0 +1,41 @@
+name: Latest Release
+
+on:
+  workflow_dispatch:
+  push:
+    branches:
+     - 'feature/**'
+    paths:
+      - 'app/**'
+      - 'src/**'
+      - 'test/**'
+
+jobs:
+  Build_Docker_Image_on_Push:
+    runs-on: ubuntu-latest
+    steps:
+      -
+        name: Set up Project
+        uses: actions/checkout@v2
+      -
+        name: Build Filehandler
+        run: |
+          stack build
+          
+      -
+        name: Login to DockerHub
+        uses: docker/login-action@v1
+        with:
+          username: ${{ secrets.DOCKER_USER }}
+          password: ${{ secrets.DOCKER_PW }}
+      -
+        name: Build and push
+        run: |
+          BINLOCATION=$(stack path --local-install-root)
+          BINLOCATION=$(realpath --relative-to=. $BINLOCATION)
+          docker build -t filefighter/filehandler:feature . --build-arg BINLOCATION=$BINLOCATION
+          docker push filefighter/filehandler:feature
+      -
+        name: Trigger update on server
+        run:
+          - curl -u ${{ secrets.LOG_CREDS }} https://logs.filefighter.de/filefighter-update.log
\ No newline at end of file

From 06c18a0fcb5c1b2fa762172ec41df74afa1593c9 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Fri, 26 Mar 2021 12:06:08 +0100
Subject: [PATCH 18/38] upload file to /tmp an not to memory

---
 Dockerfile        |  4 +---
 Filehandler.cabal |  5 ++---
 app/Main.hs       | 48 +++++++++++++++++++++++++----------------------
 3 files changed, 29 insertions(+), 28 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 795d0a8..351c98c 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -3,8 +3,6 @@ FROM ubuntu:latest
 ARG BINLOCATION
 ENV RESTURL=ptsv2.com
 
-RUN echo $BINLOCATION
-
 # Copy over the source code and make it executable.
 ADD $BINLOCATION/bin/Filehandler-exe /usr/local/bin/filehandler-exe
 RUN chmod +x /usr/local/bin/filehandler-exe
@@ -12,6 +10,6 @@ RUN chmod +x /usr/local/bin/filehandler-exe
 
 # We're all ready, now just configure our image to run the server on
 # launch from the correct working directory.
-CMd /usr/local/bin/filehandler-exe ${RESTURL}
+CMD /usr/local/bin/filehandler-exe ${RESTURL} "prod" > /dev/stdout
 WORKDIR /workdir
 EXPOSE 5000
\ No newline at end of file
diff --git a/Filehandler.cabal b/Filehandler.cabal
index 29e1fc7..0824115 100644
--- a/Filehandler.cabal
+++ b/Filehandler.cabal
@@ -23,7 +23,7 @@ extra-source-files:
 
 source-repository head
   type: git
-  location: https://github.com/githubuser/Filehandler
+  location: https://github.com/FileFighter/Filehandler
 
 library
   exposed-modules:
@@ -62,7 +62,6 @@ executable Filehandler-exe
       Filehandler
     , base >=4.7 && <5
     , req
-    , shakespeare
     , wai
     , wai-app-static
     , wai-extra
@@ -76,8 +75,8 @@ executable Filehandler-exe
     , bytestring
     , directory
     , case-insensitive
-    , blaze-html
     , mtl
+    , resourcet
   default-language: Haskell2010
 
 test-suite Filehandler-test
diff --git a/app/Main.hs b/app/Main.hs
index 15a88fe..a374127 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -17,8 +17,6 @@ import           Network.Wai.Handler.Warp
 import           Network.Wai.Parse
 import           System.Environment
 import           System.FilePath
-import           Text.Blaze.Html.Renderer.Utf8
-import           Text.Hamlet
 import Control.Monad.IO.Class
 import Data.Aeson
 import Network.HTTP.Req
@@ -29,6 +27,7 @@ import GHC.Generics
 import System.Directory
 import Control.Monad.State
 import System.IO
+import Control.Monad.Trans.Resource
 
 
 -- | Entrypoint to our application
@@ -46,7 +45,7 @@ main = do
         ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
         [restUrl,"dev"] -> do
             putStrLn "Launching DataHandler with dev profile"
-            -- Run our application (defined below) on port 5000
+            -- Run our application (defined below) on port 5000 with cors enabled
             run 5000 $ cors (const devCorsPolicy) app
         [restUrl,"prod"] -> do
             putStrLn "Launching DataHandler with prod profile"
@@ -61,7 +60,7 @@ app req send =
     case pathInfo req of
        
         -- "/upload": handle a file upload
-        ["upload"] -> upload req send
+        ["upload",id] -> upload req send
 
         ["download"] -> download req send
 
@@ -76,10 +75,9 @@ app req send =
 
 -- | Handle file uploads, storing the file in the current directory
 upload :: Application 
-upload req send = do
-    -- Parse the request body. We'll ignore parameters and just look
-    -- at the files
-    (_params, files) <- parseRequestBody lbsBackEnd req
+upload req send =do
+    tempFileState <- createInternalState
+    (_params, files) <- parseRequestBody (tempFileBackEnd tempFileState)  req
     let headers = requestHeaders req
    -- debug (_params)
     -- Look for the file parameter called "file"
@@ -93,34 +91,40 @@ upload req send = do
         Just file -> do
             let content = fileContent file
             restUrl <- getRestUrl
+            filesize <- withFile content ReadMode hFileSize
 
             -- Write it out
-            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file (L.length content) restUrl
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file filesize restUrl (DataText.unpack $ pathInfo  req!!1)
             case responseStatusCode of
                 200 -> do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String RestResponseFile)
                     case d of
-                        Left err -> send $ responseLBS
-                                    HttpTypes.status500
-                                    [ ("Content-Type", "application/json; charset=utf-8")]
-                                    (encode $ RestApiStatus err "Internal Server Error")
+                        Left err -> do
+                                    closeInternalState tempFileState
+                                    send $ responseLBS
+                                      HttpTypes.status500
+                                      [ ("Content-Type", "application/json; charset=utf-8")]
+                                      (encode $ RestApiStatus err "Internal Server Error")
                         Right fileObject -> do 
                                 let id = fileSystemId (fileObject ::RestResponseFile)
                                 createDirectoryIfMissing True [head id]
-                                L.writeFile (head id :  ("/" ++id)) content
+                                renameFile content (head id :  ("/" ++id))
+                                putStrLn ("Uploaded " ++ (head id :  ("/" ++id)))
+                                closeInternalState tempFileState
                                 send $ responseLBS
                                     HttpTypes.status200
                                     [ ("Content-Type", "application/json; charset=utf-8")]
                                      (L.fromStrict responseBody)
-                _ ->
+                _ -> do 
+                    closeInternalState tempFileState
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
                         [ ("Content-Type", "application/json; charset=utf-8")]
                         (L.fromStrict responseBody)
 
 
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> GHC.Int.Int64 -> String -> IO (S8.ByteString , Int, S8.ByteString)
-postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> Integer -> String -> String -> IO (S8.ByteString , Int, S8.ByteString)
+postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
           [ "name" .= S8.unpack (fileName file),
@@ -136,10 +140,10 @@ postApi allheaders file size restUrl= runReq (defaultHttpConfig {httpConfigCheck
     req
       POST -- method
       (http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
-      --(http (DataText.pack restUrl) /: (DataText.pack  ("api/v1/filesystem/" ++ (S8.unpack $ getOneHeader allheaders "X-FF-ID" ) ++ "/upload"))) -- TODO: parentID in url
+      --(http (DataText.pack restUrl) /: DataText.pack  ("api/v1/filesystem/" ++ fileId ++ "/upload")) -- TODO: parentID in url
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-ID" (getOneHeader allheaders "X-FF-ID" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+      (header "X-FF-ID"  (S8.pack fileId) <> header "Authorization" (getOneHeader allheaders "Authorization")) -- parentID not in Headers
      -- mempty -- query params, headers, explicit port number, etc.
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
@@ -198,9 +202,9 @@ getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
 
 
 
-debug :: [Param] -> IO()
-debug what =
-    putStrLn (S8.unpack (snd (Prelude.head what)))
+--debug :: [Param] -> IO()
+ --debug what =
+   -- putStrLn (S8.unpack (snd (Prelude.head what)))
 
 
 getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString

From de76b01ef9cacd994013a850d69f559f24525382 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Fri, 26 Mar 2021 17:20:41 +0100
Subject: [PATCH 19/38] tweak dockerfile for security and logging

---
 Dockerfile  |  7 ++++++-
 app/Main.hs | 12 +++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 351c98c..a89a68f 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -3,13 +3,18 @@ FROM ubuntu:latest
 ARG BINLOCATION
 ENV RESTURL=ptsv2.com
 
+RUN apt update && apt upgrade -y
+
 # Copy over the source code and make it executable.
 ADD $BINLOCATION/bin/Filehandler-exe /usr/local/bin/filehandler-exe
 RUN chmod +x /usr/local/bin/filehandler-exe
 
+# create group and user, then the working dir and add permissions to it
+RUN groupadd -g 999 appuser && useradd -r -u 999 -g appuser appuser && mkdir -p /workdir && chown appuser /workdir
+USER appuser
 
 # We're all ready, now just configure our image to run the server on
 # launch from the correct working directory.
-CMD /usr/local/bin/filehandler-exe ${RESTURL} "prod" > /dev/stdout
+CMD exec /usr/local/bin/filehandler-exe ${RESTURL} "prod"
 WORKDIR /workdir
 EXPOSE 5000
\ No newline at end of file
diff --git a/app/Main.hs b/app/Main.hs
index a374127..3e7d7b0 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -44,11 +44,11 @@ main = do
     case args of
         ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
         [restUrl,"dev"] -> do
-            putStrLn "Launching DataHandler with dev profile"
+            logStdOut "Launching DataHandler with dev profile"
             -- Run our application (defined below) on port 5000 with cors enabled
             run 5000 $ cors (const devCorsPolicy) app
         [restUrl,"prod"] -> do
-            putStrLn "Launching DataHandler with prod profile"
+            logStdOut "Launching DataHandler with prod profile"
             -- Run our application (defined below) on port 5000
             run 5000 app
         _ -> error $ "Unknown arguments: " ++ show args
@@ -109,7 +109,7 @@ upload req send =do
                                 let id = fileSystemId (fileObject ::RestResponseFile)
                                 createDirectoryIfMissing True [head id]
                                 renameFile content (head id :  ("/" ++id))
-                                putStrLn ("Uploaded " ++ (head id :  ("/" ++id)))
+                                logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
                                 closeInternalState tempFileState
                                 send $ responseLBS
                                     HttpTypes.status200
@@ -213,6 +213,12 @@ getOneHeader headers headerName=
         [header] -> snd header
         _ -> ""
 
+-- needed because buffering is causing problems with docker
+logStdOut :: String -> IO ()
+logStdOut text = do
+        putStrLn text
+        hFlush stdout 
+
 
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
 httpConfigDontCheckResponse _ _ _ = Nothing

From af436656ccecb44be43306167a942f8027cab302 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 27 Mar 2021 12:14:08 +0100
Subject: [PATCH 20/38] prepare deployemnt

---
 Dockerfile  | 3 ++-
 app/Main.hs | 4 ++--
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index a89a68f..11ef6a3 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,7 +1,7 @@
 FROM ubuntu:latest
 
 ARG BINLOCATION
-ENV RESTURL=ptsv2.com
+ENV RESTURL=FileFighterREST:8080
 
 RUN apt update && apt upgrade -y
 
@@ -15,6 +15,7 @@ USER appuser
 
 # We're all ready, now just configure our image to run the server on
 # launch from the correct working directory.
+# using exec solves ctl + c issues
 CMD exec /usr/local/bin/filehandler-exe ${RESTURL} "prod"
 WORKDIR /workdir
 EXPOSE 5000
\ No newline at end of file
diff --git a/app/Main.hs b/app/Main.hs
index 3e7d7b0..99175e5 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -60,9 +60,9 @@ app req send =
     case pathInfo req of
        
         -- "/upload": handle a file upload
-        ["upload",id] -> upload req send
+        ["data","upload",id] -> upload req send
 
-        ["download"] -> download req send
+        ["data","download"] -> download req send
 
         -- anything else: 404
         _ -> send $ responseLBS

From 4cb6db1ec7b6b275ed320105af8f866cf4e01217 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 27 Mar 2021 13:45:08 +0100
Subject: [PATCH 21/38] change rest port

---
 Dockerfile  | 4 ++--
 app/Main.hs | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 11ef6a3..053a0e0 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,9 +1,9 @@
 FROM ubuntu:latest
 
 ARG BINLOCATION
-ENV RESTURL=FileFighterREST:8080
+ENV RESTURL=FileFighterREST
 
-RUN apt update && apt upgrade -y
+RUN apt-get update && apt-get upgrade -y
 
 # Copy over the source code and make it executable.
 ADD $BINLOCATION/bin/Filehandler-exe /usr/local/bin/filehandler-exe
diff --git a/app/Main.hs b/app/Main.hs
index 99175e5..4e98e81 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -65,10 +65,10 @@ app req send =
         ["data","download"] -> download req send
 
         -- anything else: 404
-        _ -> send $ responseLBS
+        missingEndpoint -> send $ responseLBS
             HttpTypes.status404
             [("Content-Type", "application/json; charset=utf-8")]
-            (encode $ RestApiStatus "This endpoint does not exist." "Not Found")
+            (encode $ RestApiStatus ("FileHandler: This endpoint does not exist." ++ show missingEndpoint) "Not Found")
 
 
 
@@ -143,7 +143,7 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
       --(http (DataText.pack restUrl) /: DataText.pack  ("api/v1/filesystem/" ++ fileId ++ "/upload")) -- TODO: parentID in url
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-ID"  (S8.pack fileId) <> header "Authorization" (getOneHeader allheaders "Authorization")) -- parentID not in Headers
+      (header "X-FF-ID"  (S8.pack fileId) <> header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
      -- mempty -- query params, headers, explicit port number, etc.
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 

From d541b38523bc3d7825482f0231985262a515b375 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Mon, 29 Mar 2021 15:06:05 +0200
Subject: [PATCH 22/38] needs more cow bell

---
 app/Main.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 4e98e81..4b66dcd 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -139,12 +139,13 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
   r <-
     req
       POST -- method
-      (http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
-      --(http (DataText.pack restUrl) /: DataText.pack  ("api/v1/filesystem/" ++ fileId ++ "/upload")) -- TODO: parentID in url
+      --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
+      (http (DataText.pack restUrl) /: "v1" /:"filesystem"/: "43564654" /: "upload") -- TODO: parentID in url
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-ID"  (S8.pack fileId) <> header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
+      (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
      -- mempty -- query params, headers, explicit port number, etc.
+  liftIO $ logStdOut $ show $responseBody r
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 
@@ -193,11 +194,13 @@ getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
   r <-
     req
       GET -- method
-      (http (DataText.pack restUrl) /: "t/vmlnd-1614506338/post") -- safe by construction URL
+    --  (http (DataText.pack restUrl) /: "t/vmlnd-1614506338/post") -- safe by construction URL
+      (http (DataText.pack restUrl) /: "health" /: "fgsdhjfgh") -- safe by construction URL
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization"))
+      (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization") <> port 80)
      -- mempty -- query params, headers, explicit port number, etc.
+  liftIO $ logStdOut $ show $responseBody r
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 

From 7eea01abc749c747a48a0cbf30ee2597941f237e Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Mon, 29 Mar 2021 15:34:53 +0200
Subject: [PATCH 23/38] fix url handling

---
 app/Main.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 4b66dcd..74063c1 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -94,7 +94,7 @@ upload req send =do
             filesize <- withFile content ReadMode hFileSize
 
             -- Write it out
-            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file filesize restUrl (DataText.unpack $ pathInfo  req!!1)
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file filesize restUrl (DataText.unpack $ pathInfo  req!!2)
             case responseStatusCode of
                 200 -> do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String RestResponseFile)
@@ -128,9 +128,9 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
   let payload =
         object
           [ "name" .= S8.unpack (fileName file),
+            "path" .= S8.unpack (fileName file),
             "mimetype" .= S8.unpack (fileContentType file),
-            "size" .= size,
-            "relativePath" .= ("TODO" :: String)
+            "size" .= size 
           ]
 
 
@@ -140,7 +140,7 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
     req
       POST -- method
       --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
-      (http (DataText.pack restUrl) /: "v1" /:"filesystem"/: "43564654" /: "upload") -- TODO: parentID in url
+      (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "upload") -- TODO: parentID in url
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
       (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers

From 0d6b71f541c58c9d0773c7b1804a5f7fa24533a5 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 10 Apr 2021 12:08:37 +0200
Subject: [PATCH 24/38] added deleteEndpoint (wip)

---
 app/Main.hs | 117 ++++++++++++++++++++++++++++++++++++++--------------
 src/Lib.hs  |   7 +++-
 2 files changed, 91 insertions(+), 33 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 74063c1..2e5ab5c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings, DeriveGeneric, DuplicateRecordFields #-}
-
+{-# LANGUAGE TemplateHaskell #-}
 
 module Main where
 
@@ -19,6 +19,7 @@ import           System.Environment
 import           System.FilePath
 import Control.Monad.IO.Class
 import Data.Aeson
+import Data.Aeson.TH(deriveJSON, defaultOptions, Options(fieldLabelModifier))
 import Network.HTTP.Req
 import Data.CaseInsensitive
 import qualified Data.Text as DataText
@@ -30,6 +31,34 @@ import System.IO
 import Control.Monad.Trans.Resource
 
 
+
+data User = 
+    User {
+        userId :: Int 
+        , username :: String
+        , groups :: [String]
+    } deriving (Show,Generic)
+
+instance FromJSON User
+instance ToJSON User
+
+data RestResponseFile =
+  RestResponseFile { 
+            fileSystemId :: !String  
+            , name :: !String
+            , path :: !String
+            , size :: Int 
+            , createdByUser :: User
+            , lastUpdated :: Int 
+            , mimetype :: String
+            , filesystemType :: String
+            , shared :: Bool 
+           } deriving (Show,Generic)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = typeFieldRename} ''RestResponseFile)
+
+
+
 -- | Entrypoint to our application
 main :: IO ()
 main = do
@@ -64,6 +93,8 @@ app req send =
 
         ["data","download"] -> download req send
 
+        ["data","delete",id] -> delete req send
+
         -- anything else: 404
         missingEndpoint -> send $ responseLBS
             HttpTypes.status404
@@ -74,6 +105,8 @@ app req send =
 
 
 -- | Handle file uploads, storing the file in the current directory
+
+
 upload :: Application 
 upload req send =do
     tempFileState <- createInternalState
@@ -91,12 +124,10 @@ upload req send =do
         Just file -> do
             let content = fileContent file
             restUrl <- getRestUrl
-            filesize <- withFile content ReadMode hFileSize
-
-            -- Write it out
+            filesize <- withFile content ReadMode hFileSize            
             (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file filesize restUrl (DataText.unpack $ pathInfo  req!!2)
             case responseStatusCode of
-                200 -> do
+                201 -> do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String RestResponseFile)
                     case d of
                         Left err -> do
@@ -108,7 +139,7 @@ upload req send =do
                         Right fileObject -> do 
                                 let id = fileSystemId (fileObject ::RestResponseFile)
                                 createDirectoryIfMissing True [head id]
-                                renameFile content (head id :  ("/" ++id))
+                                renameFile content (getPathFromFileId id)
                                 logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
                                 closeInternalState tempFileState
                                 send $ responseLBS
@@ -129,7 +160,7 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
         object
           [ "name" .= S8.unpack (fileName file),
             "path" .= S8.unpack (fileName file),
-            "mimetype" .= S8.unpack (fileContentType file),
+            "mimeType" .= S8.unpack (fileContentType file),
             "size" .= size 
           ]
 
@@ -145,7 +176,7 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
       bsResponse  -- specify how to interpret response
       (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
      -- mempty -- query params, headers, explicit port number, etc.
-  liftIO $ logStdOut $ show $responseBody r
+  liftIO $ logStdOut $ S8.unpack (fileContentType file)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 
@@ -200,10 +231,45 @@ getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
       bsResponse  -- specify how to interpret response
       (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization") <> port 80)
      -- mempty -- query params, headers, explicit port number, etc.
-  liftIO $ logStdOut $ show $responseBody r
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 
+delete :: Application 
+delete req send = do
+    let headers = requestHeaders req
+    restUrl <- getRestUrl
+    (responseBody, responseStatusCode, responseStatusMessage) <- deleteApi headers restUrl (DataText.unpack $ pathInfo  req!!2)
+    case responseStatusCode of
+        200 -> do
+            let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [RestResponseFile])
+            case d of
+                Left err -> 
+                    send $ responseLBS
+                                HttpTypes.status500
+                                [ ("Content-Type", "application/json; charset=utf-8")]
+                                (encode $ RestApiStatus err "Internal Server Error")
+                Right fileObjects -> do
+                    mapM deleteFile fileObjects
+                    send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "application/json; charset=utf-8")]
+                                     (L.fromStrict responseBody)
+        _ -> send $ responseLBS
+                    (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
+                    [ ("Content-Type", "application/json; charset=utf-8")]
+                    (L.fromStrict responseBody)
+
+
+deleteApi :: [HttpTypes.Header] -> String -> String ->  IO (S8.ByteString , Int, S8.ByteString)
+deleteApi allheaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+    r <-
+        req
+        DELETE 
+        (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "delete") -- TODO: parentID in url
+        NoReqBody  
+        bsResponse
+        (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
+    return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 --debug :: [Param] -> IO()
  --debug what =
@@ -223,33 +289,20 @@ logStdOut text = do
         hFlush stdout 
 
 
-httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
-httpConfigDontCheckResponse _ _ _ = Nothing
+getPathFromFileId :: String -> String
+getPathFromFileId id=head id :  ("/" ++id)
 
 
-data RestResponseFile =
-  GetResponseFile { 
-            fileSystemId :: !String  
-            , name :: !String
-            , path :: !String
-            , size :: Int 
-            , createdByUser :: User
-            , lastUpdated :: Int 
-            , mimetype :: String
-            , shared :: Bool 
-           } deriving (Show,Generic)
+deleteFile :: RestResponseFile -> IO ()
+deleteFile file = case filesystemType file of 
+                    "FOLDER" -> logStdOut "did not delete folder"
+                    _ -> removeFile $ getPathFromFileId (fileSystemId file)
+
+
+httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
+httpConfigDontCheckResponse _ _ _ = Nothing
 
-instance FromJSON RestResponseFile
-instance ToJSON RestResponseFile
-data User = 
-    User {
-        userId :: Int 
-        , username :: String
-        , groups :: [String]
-    } deriving (Show,Generic)
 
-instance FromJSON User
-instance ToJSON User
 
 
 data RestApiStatus = 
diff --git a/src/Lib.hs b/src/Lib.hs
index d36ff27..4333191 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -1,6 +1,11 @@
 module Lib
-    ( someFunc
+    ( someFunc, typeFieldRename
     ) where
 
 someFunc :: IO ()
 someFunc = putStrLn "someFunc"
+
+
+typeFieldRename :: String -> String
+typeFieldRename "filesystem_type" = "type"
+typeFieldRename name = name
\ No newline at end of file

From 5c7c85f5c57a4a7284e2716fe6ed25baab39bc7f Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 10 Apr 2021 18:32:29 +0200
Subject: [PATCH 25/38] setup for tests

---
 Filehandler.cabal | 22 ++--------------------
 app/Main.hs       |  5 +----
 src/Lib.hs        | 11 +++++++----
 test/Spec.hs      | 18 +++++++++++++++++-
 4 files changed, 27 insertions(+), 29 deletions(-)

diff --git a/Filehandler.cabal b/Filehandler.cabal
index 0824115..0ac6804 100644
--- a/Filehandler.cabal
+++ b/Filehandler.cabal
@@ -34,21 +34,6 @@ library
       src
   build-depends:
       base >=4.7 && <5
-    , req
-    , shakespeare
-    , wai
-    , wai-app-static
-    , wai-extra
-    , warp
-    , network
-    , text
-    , aeson
-    , filepath
-    , http-types
-    , bytestring
-    , directory
-    , case-insensitive
-    , blaze-html
   default-language: Haskell2010
 
 executable Filehandler-exe
@@ -90,9 +75,6 @@ test-suite Filehandler-test
   build-depends:
       Filehandler
     , base >=4.7 && <5
-    , req
-    , shakespeare
-    , wai-app-static
-    , wai-extra
-    , warp
+    , hspec
+    , QuickCheck
   default-language: Haskell2010
diff --git a/app/Main.hs b/app/Main.hs
index 2e5ab5c..01a2c51 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -249,7 +249,7 @@ delete req send = do
                                 [ ("Content-Type", "application/json; charset=utf-8")]
                                 (encode $ RestApiStatus err "Internal Server Error")
                 Right fileObjects -> do
-                    mapM deleteFile fileObjects
+                    mapM_ deleteFile fileObjects
                     send $ responseLBS
                                     HttpTypes.status200
                                     [ ("Content-Type", "application/json; charset=utf-8")]
@@ -289,9 +289,6 @@ logStdOut text = do
         hFlush stdout 
 
 
-getPathFromFileId :: String -> String
-getPathFromFileId id=head id :  ("/" ++id)
-
 
 deleteFile :: RestResponseFile -> IO ()
 deleteFile file = case filesystemType file of 
diff --git a/src/Lib.hs b/src/Lib.hs
index 4333191..d183362 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -1,11 +1,14 @@
 module Lib
-    ( someFunc, typeFieldRename
+    ( typeFieldRename, getPathFromFileId
     ) where
 
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
 
 
 typeFieldRename :: String -> String
 typeFieldRename "filesystem_type" = "type"
-typeFieldRename name = name
\ No newline at end of file
+typeFieldRename name = name
+
+
+
+getPathFromFileId :: String -> String
+getPathFromFileId id=head id :  ("/" ++id)
diff --git a/test/Spec.hs b/test/Spec.hs
index cd4753f..7df5105 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,2 +1,18 @@
+import Test.Hspec
+import Test.QuickCheck
+import Control.Exception (evaluate)
+import Lib
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = hspec $
+  describe "getPathFromFileId" $ do
+    it "returns the first element of a list" $
+      getPathFromFileId "34535345" `shouldBe` "3/34535345"
+
+    it "returns the first element of an *arbitrary* list" $
+      property $ \x xs -> head (x:xs) == (x :: Int)
+
+    it "throws an exception if used with an empty list" $
+      evaluate (head []) `shouldThrow` anyException
+    
+  
\ No newline at end of file

From 43b6ef99bb894b7a78cba4e23d4a5590b6e3363e Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sun, 11 Apr 2021 17:14:55 +0200
Subject: [PATCH 26/38] delete endpoint working

---
 app/Main.hs | 35 +++++++++++++++++------------------
 src/Lib.hs  |  3 ++-
 2 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 01a2c51..61b93ea 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -55,8 +55,11 @@ data RestResponseFile =
             , shared :: Bool 
            } deriving (Show,Generic)
 
-$(deriveJSON defaultOptions {fieldLabelModifier = typeFieldRename} ''RestResponseFile)
+-- $(deriveJSON defaultOptions {fieldLabelModifier = typeFieldRename} ''RestResponseFile)
 
+instance FromJSON RestResponseFile where
+  parseJSON = genericParseJSON defaultOptions {
+                fieldLabelModifier = typeFieldRename }
 
 
 -- | Entrypoint to our application
@@ -177,6 +180,7 @@ postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConf
       (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
      -- mempty -- query params, headers, explicit port number, etc.
   liftIO $ logStdOut $ S8.unpack (fileContentType file)
+  liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 
@@ -236,6 +240,7 @@ getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
 
 delete :: Application 
 delete req send = do
+    logStdOut "requesting delete"
     let headers = requestHeaders req
     restUrl <- getRestUrl
     (responseBody, responseStatusCode, responseStatusMessage) <- deleteApi headers restUrl (DataText.unpack $ pathInfo  req!!2)
@@ -249,7 +254,7 @@ delete req send = do
                                 [ ("Content-Type", "application/json; charset=utf-8")]
                                 (encode $ RestApiStatus err "Internal Server Error")
                 Right fileObjects -> do
-                    mapM_ deleteFile fileObjects
+                    mapM_ deleteFile (filter filterFiles fileObjects)
                     send $ responseLBS
                                     HttpTypes.status200
                                     [ ("Content-Type", "application/json; charset=utf-8")]
@@ -265,10 +270,12 @@ deleteApi allheaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheck
     r <-
         req
         DELETE 
+        --(http "ptsv2.com" /: "t/vmlnd-1614506338/post")
         (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "delete") -- TODO: parentID in url
         NoReqBody  
         bsResponse
         (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
+    liftIO $ logStdOut $ S8.unpack (responseBody r)
     return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 --debug :: [Param] -> IO()
@@ -291,9 +298,12 @@ logStdOut text = do
 
 
 deleteFile :: RestResponseFile -> IO ()
-deleteFile file = case filesystemType file of 
-                    "FOLDER" -> logStdOut "did not delete folder"
-                    _ -> removeFile $ getPathFromFileId (fileSystemId file)
+deleteFile file = removeFile $ getPathFromFileId (fileSystemId file)
+
+filterFiles :: RestResponseFile -> Bool
+filterFiles file = case filesystemType file of 
+                    "FOLDER" -> False
+                    _ -> True
 
 
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
@@ -313,7 +323,7 @@ instance ToJSON RestApiStatus
 
 devCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
-        , corsMethods = ["GET","POST"]
+        , corsMethods = ["GET","POST","DELETE"]
         , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID"]
         , corsExposedHeaders =  Just ["Content-Disposition"]
         , corsMaxAge = Just $ 60*60*24 -- one day
@@ -322,18 +332,7 @@ devCorsPolicy = Just CorsResourcePolicy {
         , corsIgnoreFailures = False
       }
 
--- maybe needed for prod?
-prodCorsPolicy = Just CorsResourcePolicy {
-        corsOrigins = Nothing
-        , corsMethods = ["GET","POST"]
-        , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID"]
-        , corsExposedHeaders = Nothing
-        , corsMaxAge = Just $ 60*60*24 -- one day
-        , corsVaryOrigin = False
-        , corsRequireOrigin = False 
-        , corsIgnoreFailures = False
-      }
-      
+
 
 getRestUrl :: IO String
 getRestUrl=head <$> getArgs
diff --git a/src/Lib.hs b/src/Lib.hs
index d183362..e356dcb 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -5,7 +5,8 @@ module Lib
 
 
 typeFieldRename :: String -> String
-typeFieldRename "filesystem_type" = "type"
+typeFieldRename "filesystemType" = "type"
+typeFieldRename "type" = "filesystemType"
 typeFieldRename name = name
 
 

From 7970fd73bbe98c4f11865e9e06c5970bab01a100 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 17 Apr 2021 12:32:01 +0200
Subject: [PATCH 27/38] added more headers and health endpoint

---
 app/Main.hs | 63 ++++++++++++++++++++++++++++++-----------------------
 1 file changed, 36 insertions(+), 27 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 61b93ea..d46e587 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE OverloadedStrings, DeriveGeneric, DuplicateRecordFields #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings, DeriveGeneric, DuplicateRecordFields, TemplateHaskell #-}
 
 module Main where
 
@@ -55,7 +54,7 @@ data RestResponseFile =
             , shared :: Bool 
            } deriving (Show,Generic)
 
--- $(deriveJSON defaultOptions {fieldLabelModifier = typeFieldRename} ''RestResponseFile)
+
 
 instance FromJSON RestResponseFile where
   parseJSON = genericParseJSON defaultOptions {
@@ -98,6 +97,8 @@ app req send =
 
         ["data","delete",id] -> delete req send
 
+        ["data","health"] -> health req send 
+
         -- anything else: 404
         missingEndpoint -> send $ responseLBS
             HttpTypes.status404
@@ -107,9 +108,6 @@ app req send =
 
 
 
--- | Handle file uploads, storing the file in the current directory
-
-
 upload :: Application 
 upload req send =do
     tempFileState <- createInternalState
@@ -127,8 +125,7 @@ upload req send =do
         Just file -> do
             let content = fileContent file
             restUrl <- getRestUrl
-            filesize <- withFile content ReadMode hFileSize            
-            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file filesize restUrl (DataText.unpack $ pathInfo  req!!2)
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file restUrl (DataText.unpack $ pathInfo  req!!2)
             case responseStatusCode of
                 201 -> do
                     let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String RestResponseFile)
@@ -157,28 +154,25 @@ upload req send =do
                         (L.fromStrict responseBody)
 
 
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> Integer -> String -> String -> IO (S8.ByteString , Int, S8.ByteString)
-postApi allheaders file size restUrl fileId= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> String -> String -> IO (S8.ByteString , Int, S8.ByteString)
+postApi allHeaders file restUrl fileId= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
-          [ "name" .= S8.unpack (fileName file),
-            "path" .= S8.unpack (fileName file),
+          [ "name" .= S8.unpack (getOneHeader allHeaders "X-FF-NAME"), -- name and path are taken from headers 
+            "path" .= S8.unpack (getOneHeader allHeaders "X-FF-PATH"), -- because they could have been change by the user in the frontend
             "mimeType" .= S8.unpack (fileContentType file),
-            "size" .= size 
+            "size" .= S8.unpack (getOneHeader allHeaders "X-FF-SIZE") 
           ]
 
 
-  -- One function—full power and flexibility, automatic retrying on timeouts
-  -- and such, automatic connection sharing.
   r <-
     req
       POST -- method
-      --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") -- TODO: parentID in url
-      (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "upload") -- TODO: parentID in url
+      --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") 
+      (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "upload")
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
-     -- mempty -- query params, headers, explicit port number, etc.
+      (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080)
   liftIO $ logStdOut $ S8.unpack (fileContentType file)
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
@@ -225,7 +219,7 @@ download req send = do
 
 
 getApi :: [HttpTypes.Header] -> String -> IO (S8.ByteString , Int, S8.ByteString)
-getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+getApi allHeaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   r <-
     req
       GET -- method
@@ -233,7 +227,7 @@ getApi allheaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
       (http (DataText.pack restUrl) /: "health" /: "fgsdhjfgh") -- safe by construction URL
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allheaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allheaders "Authorization") <> port 80)
+      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization") <> port 80)
      -- mempty -- query params, headers, explicit port number, etc.
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
@@ -266,7 +260,7 @@ delete req send = do
 
 
 deleteApi :: [HttpTypes.Header] -> String -> String ->  IO (S8.ByteString , Int, S8.ByteString)
-deleteApi allheaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+deleteApi allHeaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
     r <-
         req
         DELETE 
@@ -274,13 +268,24 @@ deleteApi allheaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheck
         (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "delete") -- TODO: parentID in url
         NoReqBody  
         bsResponse
-        (header "Authorization" (getOneHeader allheaders "Authorization") <> port 8080) -- parentID not in Headers
+        (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080) -- parentID not in Headers
     liftIO $ logStdOut $ S8.unpack (responseBody r)
     return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
---debug :: [Param] -> IO()
- --debug what =
-   -- putStrLn (S8.unpack (snd (Prelude.head what)))
+health :: Application 
+health req send = do
+    deploymentType <- getDeploymentType
+    let response =
+            object 
+                [ "version" .= ("1.0.0" :: String),
+                  "deploymentType" .= deploymentType
+                ] 
+    send $ responseLBS
+                                    HttpTypes.status200
+                                    [ ("Content-Type", "application/json; charset=utf-8")]
+                                    (encode response)
+
+
 
 
 getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
@@ -324,7 +329,7 @@ instance ToJSON RestApiStatus
 devCorsPolicy = Just CorsResourcePolicy {
         corsOrigins = Nothing
         , corsMethods = ["GET","POST","DELETE"]
-        , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID"]
+        , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID","X-FF-NAME","X-FF-PATH","X-FF-SIZE"]
         , corsExposedHeaders =  Just ["Content-Disposition"]
         , corsMaxAge = Just $ 60*60*24 -- one day
         , corsVaryOrigin = False
@@ -336,3 +341,7 @@ devCorsPolicy = Just CorsResourcePolicy {
 
 getRestUrl :: IO String
 getRestUrl=head <$> getArgs
+
+
+getDeploymentType :: IO String
+getDeploymentType=head .  tail <$> getArgs

From dce7c72a803b8b62648184601f7191feebc88bb9 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Mon, 19 Apr 2021 16:07:12 +0200
Subject: [PATCH 28/38] prepare downlaod endpoint

---
 app/Main.hs | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index d46e587..ffc5bb8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -195,19 +195,22 @@ download req send = do
                         Right files -> 
                             case files of
                                 [fileObject] -> do
-                                    let fileID = fileSystemId (fileObject::RestResponseFile)
-                                    let path = head fileID :  ("/" ++fileID)
-                                    filesize <- withFile path ReadMode hFileSize
+                                    let fileID = fileSystemId fileObject
+                                        path = getPathFromFileId fileID
+                                        realName = name fileObject
+                                        fileMimeType = S8.pack $ mimetype fileObject
                                     send $ responseFile
                                         HttpTypes.status200
-                                        [("Content-Disposition","attachment; filename=\"example-file.mp4\"")] -- TODO: use the correct mimetype 
+                                        [("Content-Disposition", S8.pack ("attachment; filename=\"" ++ realName ++ "\""))
+                                        , ("Content-Type",fileMimeType)
+                                        ]
                                         path
                                         Nothing
-                                [] ->
+                                xs ->
                                     send $ responseLBS
                                         HttpTypes.status501
                                         [ ("Content-Type", "application/json; charset=utf-8")]
-                                        (encode $ RestApiStatus "Uploaded" "Not Implemented")
+                                        (encode $ RestApiStatus "Error" "Not Implemented")
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
@@ -223,12 +226,14 @@ getApi allHeaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
   r <-
     req
       GET -- method
-    --  (http (DataText.pack restUrl) /: "t/vmlnd-1614506338/post") -- safe by construction URL
-      (http (DataText.pack restUrl) /: "health" /: "fgsdhjfgh") -- safe by construction URL
+    --  (http (DataText.pack restUrl) /: "t/vmlnd-1614506338/post") -- safe by construction URLs
+      --(http (DataText.pack restUrl) /: "v1"  /: "filesystem" /: "download") -- safe by construction URL
+      (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info") 
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization") <> port 80)
+      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080)
      -- mempty -- query params, headers, explicit port number, etc.
+  liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 

From abd4638567c4274b46be47c0806b314bba77fcbb Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sun, 25 Apr 2021 14:00:57 +0200
Subject: [PATCH 29/38] added zipping of files for downloading

---
 Filehandler.cabal |  2 ++
 app/Main.hs       | 35 +++++++++++++++++++++++++++--------
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/Filehandler.cabal b/Filehandler.cabal
index 0ac6804..5766b0a 100644
--- a/Filehandler.cabal
+++ b/Filehandler.cabal
@@ -62,6 +62,8 @@ executable Filehandler-exe
     , case-insensitive
     , mtl
     , resourcet
+    , zip
+    , temporary
   default-language: Haskell2010
 
 test-suite Filehandler-test
diff --git a/app/Main.hs b/app/Main.hs
index ffc5bb8..fed85f8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -27,7 +27,9 @@ import GHC.Generics
 import System.Directory
 import Control.Monad.State
 import System.IO
+import System.IO.Temp
 import Control.Monad.Trans.Resource
+import Codec.Archive.Zip
 
 
 
@@ -183,6 +185,7 @@ download :: Application
 download req send = do
     let headers = requestHeaders req
     restUrl <- getRestUrl
+    logStdOut "download"
     (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers restUrl
     case responseStatusCode of
                 200 -> do
@@ -206,11 +209,19 @@ download req send = do
                                         ]
                                         path
                                         Nothing
-                                xs ->
-                                    send $ responseLBS
-                                        HttpTypes.status501
-                                        [ ("Content-Type", "application/json; charset=utf-8")]
-                                        (encode $ RestApiStatus "Error" "Not Implemented")
+                                xs -> 
+                                    withSystemTempFile "FileFighterFileHandler.zip" $ 
+                                        \tmpFileName handle-> 
+                                        do  let nameOfTheFolder = "NameOfTheFolderToDownload.zip"
+                                            let ss = mapM (\n -> do inZipPath <- mkEntrySelector (path n)
+                                                                    loadEntry Store inZipPath (getPathFromFileId (fileSystemId n))) 
+                                                        xs
+                                            createArchive tmpFileName ss
+                                            send $ responseFileDeleting'
+                                                [("Content-Disposition", S8.pack ("attachment; filename=\"" ++ nameOfTheFolder ++ "\""))
+                                                , ("Content-Type","application/zip")
+                                                ]
+                                                tmpFileName
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
@@ -226,12 +237,12 @@ getApi allHeaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
   r <-
     req
       GET -- method
-    --  (http (DataText.pack restUrl) /: "t/vmlnd-1614506338/post") -- safe by construction URLs
+     (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URLs
       --(http (DataText.pack restUrl) /: "v1"  /: "filesystem" /: "download") -- safe by construction URL
-      (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info") 
+     -- (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info") 
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080)
+      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization"))
      -- mempty -- query params, headers, explicit port number, etc.
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
@@ -319,6 +330,14 @@ filterFiles file = case filesystemType file of
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
 httpConfigDontCheckResponse _ _ _ = Nothing
 
+responseFileDeleting' ::  HttpTypes.ResponseHeaders -> FilePath -> Response
+responseFileDeleting'  headers filepath= 
+    let (status,header,streamer) = 
+            responseToStream $ responseFile HttpTypes.status200 headers filepath Nothing
+     in responseStream status header (\write flush ->
+             -- this would be a good place to put a bracket, if needed
+             do streamer (\body -> body write flush)
+                removeFile filepath)
 
 
 

From 15a4c6e8bd77d10ad999beb8509ccd16e1655dc9 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Mon, 26 Apr 2021 13:50:53 +0200
Subject: [PATCH 30/38] use temporary file also for deleting

---
 app/Main.hs | 12 +++---------
 1 file changed, 3 insertions(+), 9 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index fed85f8..4634230 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -217,11 +217,13 @@ download req send = do
                                                                     loadEntry Store inZipPath (getPathFromFileId (fileSystemId n))) 
                                                         xs
                                             createArchive tmpFileName ss
-                                            send $ responseFileDeleting'
+                                            send $ responseFile
+                                                HttpTypes.status200
                                                 [("Content-Disposition", S8.pack ("attachment; filename=\"" ++ nameOfTheFolder ++ "\""))
                                                 , ("Content-Type","application/zip")
                                                 ]
                                                 tmpFileName
+                                                Nothing
                 _ ->
                     send $ responseLBS
                         (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
@@ -330,14 +332,6 @@ filterFiles file = case filesystemType file of
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
 httpConfigDontCheckResponse _ _ _ = Nothing
 
-responseFileDeleting' ::  HttpTypes.ResponseHeaders -> FilePath -> Response
-responseFileDeleting'  headers filepath= 
-    let (status,header,streamer) = 
-            responseToStream $ responseFile HttpTypes.status200 headers filepath Nothing
-     in responseStream status header (\write flush ->
-             -- this would be a good place to put a bracket, if needed
-             do streamer (\body -> body write flush)
-                removeFile filepath)
 
 
 

From 923aa601acf6c42b2700b510f06672d81b81b233 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 8 May 2021 13:18:16 +0200
Subject: [PATCH 31/38] change return type of upload endpoint, extend health

---
 app/Main.hs | 158 ++++++++++++++++++++++++++++------------------------
 1 file changed, 84 insertions(+), 74 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 4634230..5fba38e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -18,7 +18,6 @@ import           System.Environment
 import           System.FilePath
 import Control.Monad.IO.Class
 import Data.Aeson
-import Data.Aeson.TH(deriveJSON, defaultOptions, Options(fieldLabelModifier))
 import Network.HTTP.Req
 import Data.CaseInsensitive
 import qualified Data.Text as DataText
@@ -33,35 +32,6 @@ import Codec.Archive.Zip
 
 
 
-data User = 
-    User {
-        userId :: Int 
-        , username :: String
-        , groups :: [String]
-    } deriving (Show,Generic)
-
-instance FromJSON User
-instance ToJSON User
-
-data RestResponseFile =
-  RestResponseFile { 
-            fileSystemId :: !String  
-            , name :: !String
-            , path :: !String
-            , size :: Int 
-            , createdByUser :: User
-            , lastUpdated :: Int 
-            , mimetype :: String
-            , filesystemType :: String
-            , shared :: Bool 
-           } deriving (Show,Generic)
-
-
-
-instance FromJSON RestResponseFile where
-  parseJSON = genericParseJSON defaultOptions {
-                fieldLabelModifier = typeFieldRename }
-
 
 -- | Entrypoint to our application
 main :: IO ()
@@ -111,49 +81,44 @@ app req send =
 
 
 upload :: Application 
-upload req send =do
-    tempFileState <- createInternalState
-    (_params, files) <- parseRequestBody (tempFileBackEnd tempFileState)  req
-    let headers = requestHeaders req
-   -- debug (_params)
-    -- Look for the file parameter called "file"
-    case lookup "file" files of
-        -- Not found, so return a 400 response
-        Nothing -> send $ responseLBS
-            HttpTypes.status400
-            [("Content-Type", "application/json; charset=utf-8")]
-            (encode $ RestApiStatus "No file parameter found" "Bad Request")
-        -- Got it!
-        Just file -> do
-            let content = fileContent file
-            restUrl <- getRestUrl
-            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file restUrl (DataText.unpack $ pathInfo  req!!2)
-            case responseStatusCode of
-                201 -> do
-                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String RestResponseFile)
-                    case d of
-                        Left err -> do
-                                    closeInternalState tempFileState
-                                    send $ responseLBS
-                                      HttpTypes.status500
-                                      [ ("Content-Type", "application/json; charset=utf-8")]
-                                      (encode $ RestApiStatus err "Internal Server Error")
-                        Right fileObject -> do 
-                                let id = fileSystemId (fileObject ::RestResponseFile)
-                                createDirectoryIfMissing True [head id]
-                                renameFile content (getPathFromFileId id)
-                                logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
-                                closeInternalState tempFileState
-                                send $ responseLBS
-                                    HttpTypes.status200
+upload req send = runResourceT $ withInternalState $
+           \internalState ->
+            do  (_params, files) <- parseRequestBody (tempFileBackEnd internalState)  req
+                let headers = requestHeaders req
+            -- debug (_params)
+                -- Look for the file parameter called "file"
+                case lookup "file" files of
+                    -- Not found, so return a 400 response
+                    Nothing -> send $ responseLBS
+                        HttpTypes.status400
+                        [("Content-Type", "application/json; charset=utf-8")]
+                        (encode $ RestApiStatus "No file parameter found" "Bad Request")
+                    -- Got it!
+                    Just file -> do
+                        let content = fileContent file
+                        restUrl <- getRestUrl
+                        (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file restUrl (DataText.unpack $ pathInfo  req!!2)
+                        case responseStatusCode of
+                            201 -> do
+                                let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [RestResponseFile])
+                                case d of
+                                    Left err -> send $ responseLBS
+                                                HttpTypes.status500
+                                                [ ("Content-Type", "application/json; charset=utf-8")]
+                                                (encode $ RestApiStatus err "Internal Server Error")
+                                    Right filesAndFolders -> do 
+                                            let id = fileSystemId $ head (filter filterFiles filesAndFolders)
+                                            createDirectoryIfMissing True [head id]
+                                            renameFile content (getPathFromFileId id)
+                                            logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
+                                            send $ responseLBS
+                                                HttpTypes.status200
+                                                [ ("Content-Type", "application/json; charset=utf-8")]
+                                                (L.fromStrict responseBody)
+                            _ -> send $ responseLBS
+                                    (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
                                     [ ("Content-Type", "application/json; charset=utf-8")]
-                                     (L.fromStrict responseBody)
-                _ -> do 
-                    closeInternalState tempFileState
-                    send $ responseLBS
-                        (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
-                        [ ("Content-Type", "application/json; charset=utf-8")]
-                        (L.fromStrict responseBody)
+                                    (L.fromStrict responseBody)
 
 
 postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> String -> String -> IO (S8.ByteString , Int, S8.ByteString)
@@ -244,7 +209,7 @@ getApi allHeaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse =
      -- (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info") 
       NoReqBody -- use built-in options or add your own
       bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization"))
+      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization")) --PORT !!
      -- mempty -- query params, headers, explicit port number, etc.
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
@@ -293,10 +258,18 @@ deleteApi allHeaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheck
 health :: Application 
 health req send = do
     deploymentType <- getDeploymentType
+    foldersIO <- fmap  (filterM doesDirectoryExist)  (listDirectory ".")
+    folders <- foldersIO
+    files <- concat <$> mapM listDirectoryRelative folders 
+    liftIO $ logStdOut $ show files
+    actualFilesSize  <- sum <$>  mapM  getFileSize files
+
     let response =
             object 
                 [ "version" .= ("1.0.0" :: String),
-                  "deploymentType" .= deploymentType
+                  "deploymentType" .= deploymentType,
+                  "actualFilesSize" .= actualFilesSize,
+                  "fileCount" .= length files
                 ] 
     send $ responseLBS
                                     HttpTypes.status200
@@ -363,3 +336,40 @@ getRestUrl=head <$> getArgs
 
 getDeploymentType :: IO String
 getDeploymentType=head .  tail <$> getArgs
+
+
+
+data User = 
+    User {
+        userId :: Int 
+        , username :: String
+        , groups :: [String]
+    } deriving (Show,Generic)
+
+instance FromJSON User
+instance ToJSON User
+
+data RestResponseFile =
+  RestResponseFile { 
+            fileSystemId :: !String  
+            , name :: !String
+            , path :: !String
+            , size :: Int 
+            , createdByUser :: User
+            , lastUpdated :: Int 
+            , mimetype :: String
+            , filesystemType :: String
+            , shared :: Bool 
+           } deriving (Show,Generic)
+
+
+
+instance FromJSON RestResponseFile where
+  parseJSON = genericParseJSON defaultOptions {
+                fieldLabelModifier = typeFieldRename }
+
+
+
+
+listDirectoryRelative:: FilePath -> IO [FilePath]
+listDirectoryRelative x = Prelude.map (x </>) <$> listDirectory x
\ No newline at end of file

From d58edf51e193fe181e60d5fb04a81ddaf91e53ad Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Sat, 8 May 2021 13:24:27 +0200
Subject: [PATCH 32/38] add more error handling

---
 app/Main.hs | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 5fba38e..27c58b1 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -106,15 +106,21 @@ upload req send = runResourceT $ withInternalState $
                                                 HttpTypes.status500
                                                 [ ("Content-Type", "application/json; charset=utf-8")]
                                                 (encode $ RestApiStatus err "Internal Server Error")
-                                    Right filesAndFolders -> do 
-                                            let id = fileSystemId $ head (filter filterFiles filesAndFolders)
-                                            createDirectoryIfMissing True [head id]
-                                            renameFile content (getPathFromFileId id)
-                                            logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
-                                            send $ responseLBS
-                                                HttpTypes.status200
-                                                [ ("Content-Type", "application/json; charset=utf-8")]
-                                                (L.fromStrict responseBody)
+                                    Right filesAndFolders -> 
+                                            case filter filterFiles filesAndFolders of 
+                                                [] ->   send $ responseLBS
+                                                        HttpTypes.status500
+                                                        [ ("Content-Type", "application/json; charset=utf-8")]
+                                                        (encode $ RestApiStatus "No file found in rest response." "Internal Server Error")
+                                                [file] -> do 
+                                                            let id = fileSystemId file
+                                                            createDirectoryIfMissing True [head id]
+                                                            renameFile content (getPathFromFileId id)
+                                                            logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
+                                                            send $ responseLBS
+                                                                HttpTypes.status200
+                                                                [ ("Content-Type", "application/json; charset=utf-8")]
+                                                                (L.fromStrict responseBody)
                             _ -> send $ responseLBS
                                     (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
                                     [ ("Content-Type", "application/json; charset=utf-8")]
@@ -261,7 +267,6 @@ health req send = do
     foldersIO <- fmap  (filterM doesDirectoryExist)  (listDirectory ".")
     folders <- foldersIO
     files <- concat <$> mapM listDirectoryRelative folders 
-    liftIO $ logStdOut $ show files
     actualFilesSize  <- sum <$>  mapM  getFileSize files
 
     let response =

From e919238916af904eaff30ca4205533a91f981af8 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Mon, 10 May 2021 08:59:53 +0200
Subject: [PATCH 33/38] Format the code

---
 app/Main.hs | 590 ++++++++++++++++++++++++++--------------------------
 1 file changed, 294 insertions(+), 296 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 27c58b1..5b6f57f 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,380 +1,378 @@
-{-# LANGUAGE OverloadedStrings, DeriveGeneric, DuplicateRecordFields, TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Main where
 
-import Lib
-
 -- Import the various modules that we'll use in our code.
-import qualified Data.ByteString.Char8          as S8
-import qualified Data.ByteString.Lazy           as L
-import           Data.Functor.Identity
-import qualified Network.HTTP.Types             as HttpTypes
-import           Network.Wai
-import           Network.Wai.Application.Static
-import Network.Wai.Middleware.Cors
-import           Network.Wai.Handler.Warp
-import           Network.Wai.Parse
-import           System.Environment
-import           System.FilePath
+
+import Codec.Archive.Zip
 import Control.Monad.IO.Class
+import Control.Monad.State
+import Control.Monad.Trans.Resource
 import Data.Aeson
-import Network.HTTP.Req
+import qualified Data.ByteString.Char8 as S8
+import qualified Data.ByteString.Lazy as L
 import Data.CaseInsensitive
+import Data.Functor.Identity
 import qualified Data.Text as DataText
-import GHC.Int
 import GHC.Generics
+import GHC.Int
+import Lib
+import Network.HTTP.Req
+import qualified Network.HTTP.Types as HttpTypes
+import Network.Wai
+import Network.Wai.Application.Static
+import Network.Wai.Handler.Warp
+import Network.Wai.Middleware.Cors
+import Network.Wai.Parse
 import System.Directory
-import Control.Monad.State
+import System.Environment
+import System.FilePath
 import System.IO
 import System.IO.Temp
-import Control.Monad.Trans.Resource
-import Codec.Archive.Zip
-
-
-
 
 -- | Entrypoint to our application
 main :: IO ()
 main = do
-       -- For ease of setup, we want to have a "sanity" command line
-    -- argument. We'll see how this is used in the Dockerfile
-    -- later. Desired behavior:
-    --
-    --  If we have the argument "sanity", immediately exit
-    --  If we have no arguments, run the server
-    --  Otherwise, error out
-    args <- getArgs
-    case args of
-        ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
-        [restUrl,"dev"] -> do
-            logStdOut "Launching DataHandler with dev profile"
-            -- Run our application (defined below) on port 5000 with cors enabled
-            run 5000 $ cors (const devCorsPolicy) app
-        [restUrl,"prod"] -> do
-            logStdOut "Launching DataHandler with prod profile"
-            -- Run our application (defined below) on port 5000
-            run 5000 app
-        _ -> error $ "Unknown arguments: " ++ show args
+  -- For ease of setup, we want to have a "sanity" command line
+  -- argument. We'll see how this is used in the Dockerfile
+  -- later. Desired behavior:
+  --
+  --  If we have the argument "sanity", immediately exit
+  --  If we have no arguments, run the server
+  --  Otherwise, error out
+  args <- getArgs
+  case args of
+    ["sanity"] -> putStrLn "Sanity check passed, ready to roll!"
+    [restUrl, "dev"] -> do
+      logStdOut "Launching DataHandler with dev profile"
+      -- Run our application (defined below) on port 5000 with cors enabled
+      run 5000 $ cors (const devCorsPolicy) app
+    [restUrl, "prod"] -> do
+      logStdOut "Launching DataHandler with prod profile"
+      -- Run our application (defined below) on port 5000
+      run 5000 app
+    _ -> error $ "Unknown arguments: " ++ show args
 
 -- | Our main application
-app :: Application 
+app :: Application
 app req send =
-    -- Route the request based on the path requested
-    case pathInfo req of
-       
-        -- "/upload": handle a file upload
-        ["data","upload",id] -> upload req send
-
-        ["data","download"] -> download req send
-
-        ["data","delete",id] -> delete req send
-
-        ["data","health"] -> health req send 
-
-        -- anything else: 404
-        missingEndpoint -> send $ responseLBS
-            HttpTypes.status404
-            [("Content-Type", "application/json; charset=utf-8")]
-            (encode $ RestApiStatus ("FileHandler: This endpoint does not exist." ++ show missingEndpoint) "Not Found")
-
-
-
-
-upload :: Application 
-upload req send = runResourceT $ withInternalState $
-           \internalState ->
-            do  (_params, files) <- parseRequestBody (tempFileBackEnd internalState)  req
-                let headers = requestHeaders req
-            -- debug (_params)
-                -- Look for the file parameter called "file"
-                case lookup "file" files of
-                    -- Not found, so return a 400 response
-                    Nothing -> send $ responseLBS
-                        HttpTypes.status400
+  -- Route the request based on the path requested
+  case pathInfo req of
+    -- "/upload": handle a file upload
+    ["data", "upload", id] -> upload req send
+    ["data", "download"] -> download req send
+    ["data", "delete", id] -> delete req send
+    ["data", "health"] -> health req send
+    -- anything else: 404
+    missingEndpoint ->
+      send $
+        responseLBS
+          HttpTypes.status404
+          [("Content-Type", "application/json; charset=utf-8")]
+          (encode $ RestApiStatus ("FileHandler: This endpoint does not exist." ++ show missingEndpoint) "Not Found")
+
+upload :: Application
+upload req send = runResourceT $
+  withInternalState $
+    \internalState ->
+      do
+        (_params, files) <- parseRequestBody (tempFileBackEnd internalState) req
+        let headers = requestHeaders req
+        -- debug (_params)
+        -- Look for the file parameter called "file"
+        case lookup "file" files of
+          -- Not found, so return a 400 response
+          Nothing ->
+            send $
+              responseLBS
+                HttpTypes.status400
+                [("Content-Type", "application/json; charset=utf-8")]
+                (encode $ RestApiStatus "No file parameter found" "Bad Request")
+          -- Got it!
+          Just file -> do
+            let content = fileContent file
+            restUrl <- getRestUrl
+            (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file restUrl (DataText.unpack $ pathInfo req !! 2)
+            case responseStatusCode of
+              201 -> do
+                let d = (eitherDecode $ L.fromStrict responseBody) :: (Either String [RestResponseFile])
+                case d of
+                  Left err ->
+                    send $
+                      responseLBS
+                        HttpTypes.status500
                         [("Content-Type", "application/json; charset=utf-8")]
-                        (encode $ RestApiStatus "No file parameter found" "Bad Request")
-                    -- Got it!
-                    Just file -> do
-                        let content = fileContent file
-                        restUrl <- getRestUrl
-                        (responseBody, responseStatusCode, responseStatusMessage) <- postApi headers file restUrl (DataText.unpack $ pathInfo  req!!2)
-                        case responseStatusCode of
-                            201 -> do
-                                let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [RestResponseFile])
-                                case d of
-                                    Left err -> send $ responseLBS
-                                                HttpTypes.status500
-                                                [ ("Content-Type", "application/json; charset=utf-8")]
-                                                (encode $ RestApiStatus err "Internal Server Error")
-                                    Right filesAndFolders -> 
-                                            case filter filterFiles filesAndFolders of 
-                                                [] ->   send $ responseLBS
-                                                        HttpTypes.status500
-                                                        [ ("Content-Type", "application/json; charset=utf-8")]
-                                                        (encode $ RestApiStatus "No file found in rest response." "Internal Server Error")
-                                                [file] -> do 
-                                                            let id = fileSystemId file
-                                                            createDirectoryIfMissing True [head id]
-                                                            renameFile content (getPathFromFileId id)
-                                                            logStdOut ("Uploaded " ++ (head id :  ("/" ++id)))
-                                                            send $ responseLBS
-                                                                HttpTypes.status200
-                                                                [ ("Content-Type", "application/json; charset=utf-8")]
-                                                                (L.fromStrict responseBody)
-                            _ -> send $ responseLBS
-                                    (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
-                                    [ ("Content-Type", "application/json; charset=utf-8")]
-                                    (L.fromStrict responseBody)
-
+                        (encode $ RestApiStatus err "Internal Server Error")
+                  Right filesAndFolders ->
+                    case filter filterFiles filesAndFolders of
+                      [] ->
+                        send $
+                          responseLBS
+                            HttpTypes.status500
+                            [("Content-Type", "application/json; charset=utf-8")]
+                            (encode $ RestApiStatus "No file found in rest response." "Internal Server Error")
+                      [file] -> do
+                        let id = fileSystemId file
+                        createDirectoryIfMissing True [head id]
+                        renameFile content (getPathFromFileId id)
+                        logStdOut ("Uploaded " ++ (head id : ("/" ++ id)))
+                        send $
+                          responseLBS
+                            HttpTypes.status200
+                            [("Content-Type", "application/json; charset=utf-8")]
+                            (L.fromStrict responseBody)
+              _ ->
+                send $
+                  responseLBS
+                    (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
+                    [("Content-Type", "application/json; charset=utf-8")]
+                    (L.fromStrict responseBody)
 
-postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> String -> String -> IO (S8.ByteString , Int, S8.ByteString)
-postApi allHeaders file restUrl fileId= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+postApi :: [HttpTypes.Header] -> Network.Wai.Parse.FileInfo c -> String -> String -> IO (S8.ByteString, Int, S8.ByteString)
+postApi allHeaders file restUrl fileId = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   let payload =
         object
-          [ "name" .= S8.unpack (getOneHeader allHeaders "X-FF-NAME"), -- name and path are taken from headers 
+          [ "name" .= S8.unpack (getOneHeader allHeaders "X-FF-NAME"), -- name and path are taken from headers
             "path" .= S8.unpack (getOneHeader allHeaders "X-FF-PATH"), -- because they could have been change by the user in the frontend
             "mimeType" .= S8.unpack (fileContentType file),
-            "size" .= S8.unpack (getOneHeader allHeaders "X-FF-SIZE") 
+            "size" .= S8.unpack (getOneHeader allHeaders "X-FF-SIZE")
           ]
 
-
   r <-
     req
       POST -- method
-      --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post") 
-      (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "upload")
+      --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post")
+      (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: DataText.pack fileId /: "upload")
       (ReqBodyJson payload) -- use built-in options or add your own
-      bsResponse  -- specify how to interpret response
+      bsResponse -- specify how to interpret response
       (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080)
   liftIO $ logStdOut $ S8.unpack (fileContentType file)
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
-
-
 download :: Application
 download req send = do
-    let headers = requestHeaders req
-    restUrl <- getRestUrl
-    logStdOut "download"
-    (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers restUrl
-    case responseStatusCode of
-                200 -> do
-                    let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [RestResponseFile])
-                    case d of
-                        Left err -> send $ responseLBS
-                                    HttpTypes.status501
-                                    [ ("Content-Type", "application/json; charset=utf-8")]
-                                    (L.fromStrict $ S8.pack err)
-                        Right files -> 
-                            case files of
-                                [fileObject] -> do
-                                    let fileID = fileSystemId fileObject
-                                        path = getPathFromFileId fileID
-                                        realName = name fileObject
-                                        fileMimeType = S8.pack $ mimetype fileObject
-                                    send $ responseFile
-                                        HttpTypes.status200
-                                        [("Content-Disposition", S8.pack ("attachment; filename=\"" ++ realName ++ "\""))
-                                        , ("Content-Type",fileMimeType)
-                                        ]
-                                        path
-                                        Nothing
-                                xs -> 
-                                    withSystemTempFile "FileFighterFileHandler.zip" $ 
-                                        \tmpFileName handle-> 
-                                        do  let nameOfTheFolder = "NameOfTheFolderToDownload.zip"
-                                            let ss = mapM (\n -> do inZipPath <- mkEntrySelector (path n)
-                                                                    loadEntry Store inZipPath (getPathFromFileId (fileSystemId n))) 
-                                                        xs
-                                            createArchive tmpFileName ss
-                                            send $ responseFile
-                                                HttpTypes.status200
-                                                [("Content-Disposition", S8.pack ("attachment; filename=\"" ++ nameOfTheFolder ++ "\""))
-                                                , ("Content-Type","application/zip")
-                                                ]
-                                                tmpFileName
-                                                Nothing
-                _ ->
-                    send $ responseLBS
-                        (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
-                        [ ("Content-Type", "application/json; charset=utf-8")]
-                        (L.fromStrict responseBody)
-
-
-
-
-
-getApi :: [HttpTypes.Header] -> String -> IO (S8.ByteString , Int, S8.ByteString)
-getApi allHeaders restUrl= runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
+  let headers = requestHeaders req
+  restUrl <- getRestUrl
+  logStdOut "download"
+  (responseBody, responseStatusCode, responseStatusMessage) <- getApi headers restUrl
+  case responseStatusCode of
+    200 -> do
+      let d = (eitherDecode $ L.fromStrict responseBody) :: (Either String [RestResponseFile])
+      case d of
+        Left err ->
+          send $
+            responseLBS
+              HttpTypes.status501
+              [("Content-Type", "application/json; charset=utf-8")]
+              (L.fromStrict $ S8.pack err)
+        Right files ->
+          case files of
+            [fileObject] -> do
+              let fileID = fileSystemId fileObject
+                  path = getPathFromFileId fileID
+                  realName = name fileObject
+                  fileMimeType = S8.pack $ mimetype fileObject
+              send $
+                responseFile
+                  HttpTypes.status200
+                  [ ("Content-Disposition", S8.pack ("attachment; filename=\"" ++ realName ++ "\"")),
+                    ("Content-Type", fileMimeType)
+                  ]
+                  path
+                  Nothing
+            xs ->
+              withSystemTempFile "FileFighterFileHandler.zip" $
+                \tmpFileName handle ->
+                  do
+                    let nameOfTheFolder = "NameOfTheFolderToDownload.zip"
+                    let ss =
+                          mapM
+                            ( \n -> do
+                                inZipPath <- mkEntrySelector (path n)
+                                loadEntry Store inZipPath (getPathFromFileId (fileSystemId n))
+                            )
+                            xs
+                    createArchive tmpFileName ss
+                    send $
+                      responseFile
+                        HttpTypes.status200
+                        [ ("Content-Disposition", S8.pack ("attachment; filename=\"" ++ nameOfTheFolder ++ "\"")),
+                          ("Content-Type", "application/zip")
+                        ]
+                        tmpFileName
+                        Nothing
+    _ ->
+      send $
+        responseLBS
+          (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
+          [("Content-Type", "application/json; charset=utf-8")]
+          (L.fromStrict responseBody)
+
+getApi :: [HttpTypes.Header] -> String -> IO (S8.ByteString, Int, S8.ByteString)
+getApi allHeaders restUrl = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
   r <-
     req
       GET -- method
-     (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URLs
+      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URLs
       --(http (DataText.pack restUrl) /: "v1"  /: "filesystem" /: "download") -- safe by construction URL
-     -- (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info") 
+      -- (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info")
       NoReqBody -- use built-in options or add your own
-      bsResponse  -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS" ) <> header "Authorization" (getOneHeader allHeaders "Authorization")) --PORT !!
-     -- mempty -- query params, headers, explicit port number, etc.
+      bsResponse -- specify how to interpret response
+      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS") <> header "Authorization" (getOneHeader allHeaders "Authorization")) --PORT !!
+      -- mempty -- query params, headers, explicit port number, etc.
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
-
-delete :: Application 
+delete :: Application
 delete req send = do
-    logStdOut "requesting delete"
-    let headers = requestHeaders req
-    restUrl <- getRestUrl
-    (responseBody, responseStatusCode, responseStatusMessage) <- deleteApi headers restUrl (DataText.unpack $ pathInfo  req!!2)
-    case responseStatusCode of
-        200 -> do
-            let d = (eitherDecode $ L.fromStrict responseBody ) :: (Either String [RestResponseFile])
-            case d of
-                Left err -> 
-                    send $ responseLBS
-                                HttpTypes.status500
-                                [ ("Content-Type", "application/json; charset=utf-8")]
-                                (encode $ RestApiStatus err "Internal Server Error")
-                Right fileObjects -> do
-                    mapM_ deleteFile (filter filterFiles fileObjects)
-                    send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "application/json; charset=utf-8")]
-                                     (L.fromStrict responseBody)
-        _ -> send $ responseLBS
-                    (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
-                    [ ("Content-Type", "application/json; charset=utf-8")]
-                    (L.fromStrict responseBody)
-
-
-deleteApi :: [HttpTypes.Header] -> String -> String ->  IO (S8.ByteString , Int, S8.ByteString)
+  logStdOut "requesting delete"
+  let headers = requestHeaders req
+  restUrl <- getRestUrl
+  (responseBody, responseStatusCode, responseStatusMessage) <- deleteApi headers restUrl (DataText.unpack $ pathInfo req !! 2)
+  case responseStatusCode of
+    200 -> do
+      let d = (eitherDecode $ L.fromStrict responseBody) :: (Either String [RestResponseFile])
+      case d of
+        Left err ->
+          send $
+            responseLBS
+              HttpTypes.status500
+              [("Content-Type", "application/json; charset=utf-8")]
+              (encode $ RestApiStatus err "Internal Server Error")
+        Right fileObjects -> do
+          mapM_ deleteFile (filter filterFiles fileObjects)
+          send $
+            responseLBS
+              HttpTypes.status200
+              [("Content-Type", "application/json; charset=utf-8")]
+              (L.fromStrict responseBody)
+    _ ->
+      send $
+        responseLBS
+          (HttpTypes.mkStatus responseStatusCode responseStatusMessage)
+          [("Content-Type", "application/json; charset=utf-8")]
+          (L.fromStrict responseBody)
+
+deleteApi :: [HttpTypes.Header] -> String -> String -> IO (S8.ByteString, Int, S8.ByteString)
 deleteApi allHeaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheckResponse = httpConfigDontCheckResponse}) $ do
-    r <-
-        req
-        DELETE 
-        --(http "ptsv2.com" /: "t/vmlnd-1614506338/post")
-        (http (DataText.pack restUrl) /: "v1" /:"filesystem" /: DataText.pack fileId /: "delete") -- TODO: parentID in url
-        NoReqBody  
-        bsResponse
-        (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080) -- parentID not in Headers
-    liftIO $ logStdOut $ S8.unpack (responseBody r)
-    return (responseBody r, responseStatusCode r, responseStatusMessage r)
+  r <-
+    req
+      DELETE
+      --(http "ptsv2.com" /: "t/vmlnd-1614506338/post")
+      (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: DataText.pack fileId /: "delete") -- TODO: parentID in url
+      NoReqBody
+      bsResponse
+      (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080) -- parentID not in Headers
+  liftIO $ logStdOut $ S8.unpack (responseBody r)
+  return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
-health :: Application 
+health :: Application
 health req send = do
-    deploymentType <- getDeploymentType
-    foldersIO <- fmap  (filterM doesDirectoryExist)  (listDirectory ".")
-    folders <- foldersIO
-    files <- concat <$> mapM listDirectoryRelative folders 
-    actualFilesSize  <- sum <$>  mapM  getFileSize files
-
-    let response =
-            object 
-                [ "version" .= ("1.0.0" :: String),
-                  "deploymentType" .= deploymentType,
-                  "actualFilesSize" .= actualFilesSize,
-                  "fileCount" .= length files
-                ] 
-    send $ responseLBS
-                                    HttpTypes.status200
-                                    [ ("Content-Type", "application/json; charset=utf-8")]
-                                    (encode response)
-
-
+  deploymentType <- getDeploymentType
+  foldersIO <- fmap (filterM doesDirectoryExist) (listDirectory ".")
+  folders <- foldersIO
+  files <- concat <$> mapM listDirectoryRelative folders
+  actualFilesSize <- sum <$> mapM getFileSize files
 
+  let response =
+        object
+          [ "version" .= ("1.0.0" :: String),
+            "deploymentType" .= deploymentType,
+            "actualFilesSize" .= actualFilesSize,
+            "fileCount" .= length files
+          ]
+  send $
+    responseLBS
+      HttpTypes.status200
+      [("Content-Type", "application/json; charset=utf-8")]
+      (encode response)
 
 getOneHeader :: [HttpTypes.Header] -> String -> S8.ByteString
-getOneHeader headers headerName=
-    case Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk(S8.pack headerName ):: CI S8.ByteString)) headers of 
-        [header] -> snd header
-        _ -> ""
+getOneHeader headers headerName =
+  case Prelude.filter (\n -> fst n == (Data.CaseInsensitive.mk (S8.pack headerName) :: CI S8.ByteString)) headers of
+    [header] -> snd header
+    _ -> ""
 
 -- needed because buffering is causing problems with docker
 logStdOut :: String -> IO ()
 logStdOut text = do
-        putStrLn text
-        hFlush stdout 
-
-
+  putStrLn text
+  hFlush stdout
 
 deleteFile :: RestResponseFile -> IO ()
 deleteFile file = removeFile $ getPathFromFileId (fileSystemId file)
 
 filterFiles :: RestResponseFile -> Bool
-filterFiles file = case filesystemType file of 
-                    "FOLDER" -> False
-                    _ -> True
-
+filterFiles file = case filesystemType file of
+  "FOLDER" -> False
+  _ -> True
 
 httpConfigDontCheckResponse :: p1 -> p2 -> p3 -> Maybe a
 httpConfigDontCheckResponse _ _ _ = Nothing
 
-
-
-
-data RestApiStatus = 
-    RestApiStatus {
-        message :: !String
-        , status :: !String
-    } deriving (Show,Generic)
+data RestApiStatus = RestApiStatus
+  { message :: !String,
+    status :: !String
+  }
+  deriving (Show, Generic)
 
 instance FromJSON RestApiStatus
+
 instance ToJSON RestApiStatus
 
-devCorsPolicy = Just CorsResourcePolicy {
-        corsOrigins = Nothing
-        , corsMethods = ["GET","POST","DELETE"]
-        , corsRequestHeaders = ["Authorization", "content-type","X-FF-IDS","X-FF-ID","X-FF-NAME","X-FF-PATH","X-FF-SIZE"]
-        , corsExposedHeaders =  Just ["Content-Disposition"]
-        , corsMaxAge = Just $ 60*60*24 -- one day
-        , corsVaryOrigin = False
-        , corsRequireOrigin = False 
-        , corsIgnoreFailures = False
+devCorsPolicy =
+  Just
+    CorsResourcePolicy
+      { corsOrigins = Nothing,
+        corsMethods = ["GET", "POST", "DELETE"],
+        corsRequestHeaders = ["Authorization", "content-type", "X-FF-IDS", "X-FF-ID", "X-FF-NAME", "X-FF-PATH", "X-FF-SIZE"],
+        corsExposedHeaders = Just ["Content-Disposition"],
+        corsMaxAge = Just $ 60 * 60 * 24, -- one day
+        corsVaryOrigin = False,
+        corsRequireOrigin = False,
+        corsIgnoreFailures = False
       }
 
-
-
 getRestUrl :: IO String
-getRestUrl=head <$> getArgs
-
+getRestUrl = head <$> getArgs
 
 getDeploymentType :: IO String
-getDeploymentType=head .  tail <$> getArgs
+getDeploymentType = head . tail <$> getArgs
 
-
-
-data User = 
-    User {
-        userId :: Int 
-        , username :: String
-        , groups :: [String]
-    } deriving (Show,Generic)
+data User = User
+  { userId :: Int,
+    username :: String,
+    groups :: [String]
+  }
+  deriving (Show, Generic)
 
 instance FromJSON User
-instance ToJSON User
-
-data RestResponseFile =
-  RestResponseFile { 
-            fileSystemId :: !String  
-            , name :: !String
-            , path :: !String
-            , size :: Int 
-            , createdByUser :: User
-            , lastUpdated :: Int 
-            , mimetype :: String
-            , filesystemType :: String
-            , shared :: Bool 
-           } deriving (Show,Generic)
 
+instance ToJSON User
 
+data RestResponseFile = RestResponseFile
+  { fileSystemId :: !String,
+    name :: !String,
+    path :: !String,
+    size :: Int,
+    createdByUser :: User,
+    lastUpdated :: Int,
+    mimetype :: String,
+    filesystemType :: String,
+    shared :: Bool
+  }
+  deriving (Show, Generic)
 
 instance FromJSON RestResponseFile where
-  parseJSON = genericParseJSON defaultOptions {
-                fieldLabelModifier = typeFieldRename }
-
-
-
+  parseJSON =
+    genericParseJSON
+      defaultOptions
+        { fieldLabelModifier = typeFieldRename
+        }
 
-listDirectoryRelative:: FilePath -> IO [FilePath]
+listDirectoryRelative :: FilePath -> IO [FilePath]
 listDirectoryRelative x = Prelude.map (x </>) <$> listDirectory x
\ No newline at end of file

From 8343c7294ee225e9d04307b2384f7a2d170933a8 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Tue, 11 May 2021 19:14:32 +0200
Subject: [PATCH 34/38] add stage profile

---
 Dockerfile  |  3 ++-
 app/Main.hs | 32 +++++++++++++++++++-------------
 2 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 053a0e0..42d30df 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -2,6 +2,7 @@ FROM ubuntu:latest
 
 ARG BINLOCATION
 ENV RESTURL=FileFighterREST
+ENV PROFILE=prod
 
 RUN apt-get update && apt-get upgrade -y
 
@@ -16,6 +17,6 @@ USER appuser
 # We're all ready, now just configure our image to run the server on
 # launch from the correct working directory.
 # using exec solves ctl + c issues
-CMD exec /usr/local/bin/filehandler-exe ${RESTURL} "prod"
+CMD exec /usr/local/bin/filehandler-exe ${RESTURL} $PROFILE
 WORKDIR /workdir
 EXPOSE 5000
\ No newline at end of file
diff --git a/app/Main.hs b/app/Main.hs
index 5b6f57f..95e339a 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -50,6 +50,10 @@ main = do
       logStdOut "Launching DataHandler with dev profile"
       -- Run our application (defined below) on port 5000 with cors enabled
       run 5000 $ cors (const devCorsPolicy) app
+    [restUrl, "stage"] -> do
+      logStdOut "Launching DataHandler with dev profile"
+      -- Run our application (defined below) on port 5000 with cors enabled
+      run 5000 $ cors (const devCorsPolicy) app
     [restUrl, "prod"] -> do
       logStdOut "Launching DataHandler with prod profile"
       -- Run our application (defined below) on port 5000
@@ -115,7 +119,7 @@ upload req send = runResourceT $
                             [("Content-Type", "application/json; charset=utf-8")]
                             (encode $ RestApiStatus "No file found in rest response." "Internal Server Error")
                       [file] -> do
-                        let id = fileSystemId file
+                        let id = show $ fileSystemId file
                         createDirectoryIfMissing True [head id]
                         renameFile content (getPathFromFileId id)
                         logStdOut ("Uploaded " ++ (head id : ("/" ++ id)))
@@ -145,10 +149,11 @@ postApi allHeaders file restUrl fileId = runReq (defaultHttpConfig {httpConfigCh
     req
       POST -- method
       --(http (DataText.pack restUrl) /: "t/os3vu-1615111052/post")
-      (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: DataText.pack fileId /: "upload")
+      (http (DataText.pack restUrl) /: "api" /: "v1" /: "filesystem" /: DataText.pack fileId /: "upload")
       (ReqBodyJson payload) -- use built-in options or add your own
       bsResponse -- specify how to interpret response
       (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080)
+  liftIO $ logStdOut  (show (http (DataText.pack restUrl) /: "api" /: "v1" /: "filesystem" /: DataText.pack fileId /: "upload"))
   liftIO $ logStdOut $ S8.unpack (fileContentType file)
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
@@ -173,9 +178,9 @@ download req send = do
           case files of
             [fileObject] -> do
               let fileID = fileSystemId fileObject
-                  path = getPathFromFileId fileID
+                  path = getPathFromFileId $ show fileID
                   realName = name fileObject
-                  fileMimeType = S8.pack $ mimetype fileObject
+                  fileMimeType = S8.pack $ mimeType fileObject
               send $
                 responseFile
                   HttpTypes.status200
@@ -193,7 +198,7 @@ download req send = do
                           mapM
                             ( \n -> do
                                 inZipPath <- mkEntrySelector (path n)
-                                loadEntry Store inZipPath (getPathFromFileId (fileSystemId n))
+                                loadEntry Store inZipPath (getPathFromFileId (show $ fileSystemId n))
                             )
                             xs
                     createArchive tmpFileName ss
@@ -217,12 +222,12 @@ getApi allHeaders restUrl = runReq (defaultHttpConfig {httpConfigCheckResponse =
   r <-
     req
       GET -- method
-      (http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URLs
-      --(http (DataText.pack restUrl) /: "v1"  /: "filesystem" /: "download") -- safe by construction URL
+      --(http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URLs
+      (http (DataText.pack restUrl) /: "v1"  /: "filesystem" /: "download") -- safe by construction URL
       -- (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info")
       NoReqBody -- use built-in options or add your own
       bsResponse -- specify how to interpret response
-      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS") <> header "Authorization" (getOneHeader allHeaders "Authorization")) --PORT !!
+      (header "X-FF-IDS" (getOneHeader allHeaders "X-FF-IDS") <> header "Authorization" (getOneHeader allHeaders "Authorization")  <> port 8080) --PORT !!
       -- mempty -- query params, headers, explicit port number, etc.
   liftIO $ logStdOut $ S8.unpack (responseBody r)
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
@@ -263,7 +268,7 @@ deleteApi allHeaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheck
     req
       DELETE
       --(http "ptsv2.com" /: "t/vmlnd-1614506338/post")
-      (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: DataText.pack fileId /: "delete") -- TODO: parentID in url
+      (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: DataText.pack fileId /: "delete") 
       NoReqBody
       bsResponse
       (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080) -- parentID not in Headers
@@ -304,7 +309,7 @@ logStdOut text = do
   hFlush stdout
 
 deleteFile :: RestResponseFile -> IO ()
-deleteFile file = removeFile $ getPathFromFileId (fileSystemId file)
+deleteFile file = removeFile $ getPathFromFileId (show $ fileSystemId file)
 
 filterFiles :: RestResponseFile -> Bool
 filterFiles file = case filesystemType file of
@@ -355,13 +360,14 @@ instance FromJSON User
 instance ToJSON User
 
 data RestResponseFile = RestResponseFile
-  { fileSystemId :: !String,
+  { fileSystemId :: !Int,
     name :: !String,
     path :: !String,
     size :: Int,
-    createdByUser :: User,
+    owner :: User,
+    lastUpdatedBy :: User,
     lastUpdated :: Int,
-    mimetype :: String,
+    mimeType :: String,
     filesystemType :: String,
     shared :: Bool
   }

From 0fe20e6d1bd1e94c6eb6b8416c7af487ec368779 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Wed, 12 May 2021 15:34:11 +0200
Subject: [PATCH 35/38] make mimetype as possible null value, (clean this up
 later)

---
 app/Main.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 95e339a..a41b730 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -180,12 +180,12 @@ download req send = do
               let fileID = fileSystemId fileObject
                   path = getPathFromFileId $ show fileID
                   realName = name fileObject
-                  fileMimeType = S8.pack $ mimeType fileObject
+                  fileMimeType = mimeType fileObject
               send $
                 responseFile
                   HttpTypes.status200
                   [ ("Content-Disposition", S8.pack ("attachment; filename=\"" ++ realName ++ "\"")),
-                    ("Content-Type", fileMimeType)
+                    ("Content-Type", "fileMimeType") -- Todo
                   ]
                   path
                   Nothing
@@ -367,7 +367,7 @@ data RestResponseFile = RestResponseFile
     owner :: User,
     lastUpdatedBy :: User,
     lastUpdated :: Int,
-    mimeType :: String,
+    mimeType :: Maybe String,
     filesystemType :: String,
     shared :: Bool
   }
@@ -377,7 +377,8 @@ instance FromJSON RestResponseFile where
   parseJSON =
     genericParseJSON
       defaultOptions
-        { fieldLabelModifier = typeFieldRename
+        { fieldLabelModifier = typeFieldRename,
+          omitNothingFields = True
         }
 
 listDirectoryRelative :: FilePath -> IO [FilePath]

From 538a2c2e37718151e4077b6b6c852afc8ea19192 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Thu, 13 May 2021 17:00:50 +0200
Subject: [PATCH 36/38] cleanup, add stable pipeline

---
 .github/workflows/featureRelease.yml |  6 +----
 .github/workflows/stableRelease.yml  | 34 ++++++++++++++++++++++++++++
 Dockerfile                           |  5 ++--
 app/Main.hs                          |  6 ++---
 4 files changed, 40 insertions(+), 11 deletions(-)
 create mode 100644 .github/workflows/stableRelease.yml

diff --git a/.github/workflows/featureRelease.yml b/.github/workflows/featureRelease.yml
index 6e973a7..697ce5f 100644
--- a/.github/workflows/featureRelease.yml
+++ b/.github/workflows/featureRelease.yml
@@ -34,8 +34,4 @@ jobs:
           BINLOCATION=$(stack path --local-install-root)
           BINLOCATION=$(realpath --relative-to=. $BINLOCATION)
           docker build -t filefighter/filehandler:feature . --build-arg BINLOCATION=$BINLOCATION
-          docker push filefighter/filehandler:feature
-      -
-        name: Trigger update on server
-        run:
-          - curl -u ${{ secrets.LOG_CREDS }} https://logs.filefighter.de/filefighter-update.log
\ No newline at end of file
+          docker push filefighter/filehandler:feature
\ No newline at end of file
diff --git a/.github/workflows/stableRelease.yml b/.github/workflows/stableRelease.yml
new file mode 100644
index 0000000..965f90f
--- /dev/null
+++ b/.github/workflows/stableRelease.yml
@@ -0,0 +1,34 @@
+name: Stable Release
+
+on:
+  push:
+    tags:
+      - 'v*.*.*'
+
+jobs:
+  Build_Docker_Image_on_Push:
+    runs-on: ubuntu-latest
+    steps:
+      -
+        name: Set up Project
+        uses: actions/checkout@v2
+      -
+        name: Build Filehandler
+        run: |
+          stack build
+          
+      -
+        name: Login to DockerHub
+        uses: docker/login-action@v1
+        with:
+          username: ${{ secrets.DOCKER_USER }}
+          password: ${{ secrets.DOCKER_PW }}
+      -
+        name: Build and push
+        run: |
+          VERSION=${{ steps.vars.outputs.tag }}
+          BINLOCATION=$(stack path --local-install-root)
+          BINLOCATION=$(realpath --relative-to=. $BINLOCATION)
+          docker build -t filefighter/filehandler:$VERSION -t filefighter/filehandler:stable . --build-arg BINLOCATION=$BINLOCATION
+          docker push filefighter/filehandler:$VERSION
+          docker push filefighter/filehandler:stable
\ No newline at end of file
diff --git a/Dockerfile b/Dockerfile
index 42d30df..8936738 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -10,9 +10,10 @@ RUN apt-get update && apt-get upgrade -y
 ADD $BINLOCATION/bin/Filehandler-exe /usr/local/bin/filehandler-exe
 RUN chmod +x /usr/local/bin/filehandler-exe
 
+# TODO: because we want to write to a host directory we must run as root, or change the permissions of the directory
 # create group and user, then the working dir and add permissions to it
-RUN groupadd -g 999 appuser && useradd -r -u 999 -g appuser appuser && mkdir -p /workdir && chown appuser /workdir
-USER appuser
+#RUN groupadd -g 999 appuser && useradd -r -u 999 -g appuser appuser && mkdir -p /workdir && chown appuser /workdir
+#USER appuser
 
 # We're all ready, now just configure our image to run the server on
 # launch from the correct working directory.
diff --git a/app/Main.hs b/app/Main.hs
index a41b730..08ec832 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -121,7 +121,7 @@ upload req send = runResourceT $
                       [file] -> do
                         let id = show $ fileSystemId file
                         createDirectoryIfMissing True [head id]
-                        renameFile content (getPathFromFileId id)
+                        copyFile content (getPathFromFileId id)
                         logStdOut ("Uploaded " ++ (head id : ("/" ++ id)))
                         send $
                           responseLBS
@@ -222,7 +222,6 @@ getApi allHeaders restUrl = runReq (defaultHttpConfig {httpConfigCheckResponse =
   r <-
     req
       GET -- method
-      --(http "ptsv2.com" /: "t/vmlnd-1614506338/post") -- safe by construction URLs
       (http (DataText.pack restUrl) /: "v1"  /: "filesystem" /: "download") -- safe by construction URL
       -- (http (DataText.pack restUrl) /:"v1" /: "filesystem" /: DataText.pack  (S8.unpack (getOneHeader allHeaders "X-FF-IDS" )) /: "info")
       NoReqBody -- use built-in options or add your own
@@ -267,8 +266,7 @@ deleteApi allHeaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheck
   r <-
     req
       DELETE
-      --(http "ptsv2.com" /: "t/vmlnd-1614506338/post")
-      (http (DataText.pack restUrl) /: "v1" /: "filesystem" /: DataText.pack fileId /: "delete") 
+      (http (DataText.pack restUrl) /: "api" /: "v1" /: "filesystem" /: DataText.pack fileId /: "delete") 
       NoReqBody
       bsResponse
       (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080) -- parentID not in Headers

From 31b1444825d9fb7f1837591ed1410b8212c4d6f8 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Thu, 13 May 2021 17:48:48 +0200
Subject: [PATCH 37/38] add possible null values

---
 app/Main.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 08ec832..7cd0480 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -32,6 +32,7 @@ import System.Environment
 import System.FilePath
 import System.IO
 import System.IO.Temp
+import Data.Maybe ( fromMaybe )
 
 -- | Entrypoint to our application
 main :: IO ()
@@ -180,12 +181,12 @@ download req send = do
               let fileID = fileSystemId fileObject
                   path = getPathFromFileId $ show fileID
                   realName = name fileObject
-                  fileMimeType = mimeType fileObject
+                  fileMimeType = fromMaybe "application/octet-stream" (mimeType fileObject)
               send $
                 responseFile
                   HttpTypes.status200
                   [ ("Content-Disposition", S8.pack ("attachment; filename=\"" ++ realName ++ "\"")),
-                    ("Content-Type", "fileMimeType") -- Todo
+                    ("Content-Type", S8.pack fileMimeType)
                   ]
                   path
                   Nothing
@@ -196,9 +197,9 @@ download req send = do
                     let nameOfTheFolder = "NameOfTheFolderToDownload.zip"
                     let ss =
                           mapM
-                            ( \n -> do
-                                inZipPath <- mkEntrySelector (path n)
-                                loadEntry Store inZipPath (getPathFromFileId (show $ fileSystemId n))
+                            ( \file -> do
+                                inZipPath <- mkEntrySelector $ fromMaybe (name file) (path file)
+                                loadEntry Store inZipPath (getPathFromFileId (show $ fileSystemId file))
                             )
                             xs
                     createArchive tmpFileName ss
@@ -271,6 +272,7 @@ deleteApi allHeaders restUrl fileId = runReq (defaultHttpConfig {httpConfigCheck
       bsResponse
       (header "Authorization" (getOneHeader allHeaders "Authorization") <> port 8080) -- parentID not in Headers
   liftIO $ logStdOut $ S8.unpack (responseBody r)
+  liftIO $ logStdOut (show (http (DataText.pack restUrl) /: "api" /: "v1" /: "filesystem" /: DataText.pack fileId /: "delete") )
   return (responseBody r, responseStatusCode r, responseStatusMessage r)
 
 health :: Application
@@ -359,8 +361,8 @@ instance ToJSON User
 
 data RestResponseFile = RestResponseFile
   { fileSystemId :: !Int,
-    name :: !String,
-    path :: !String,
+    name ::  String,
+    path :: Maybe String,
     size :: Int,
     owner :: User,
     lastUpdatedBy :: User,

From c219a25ceb6093d13404e68d877f5d33c79e72a5 Mon Sep 17 00:00:00 2001
From: qvalentin <valentin.theodor@web.de>
Date: Thu, 13 May 2021 17:55:13 +0200
Subject: [PATCH 38/38] fix pipeline name, dont run feature pipeline all the
 time

---
 .github/workflows/featureRelease.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/featureRelease.yml b/.github/workflows/featureRelease.yml
index 697ce5f..46ad3fd 100644
--- a/.github/workflows/featureRelease.yml
+++ b/.github/workflows/featureRelease.yml
@@ -1,10 +1,10 @@
-name: Latest Release
+name: Feature Release
 
 on:
   workflow_dispatch:
   push:
     branches:
-     - 'feature/**'
+     - 'featureWithPipeline/**'
     paths:
       - 'app/**'
       - 'src/**'