From 84c7115c83440548603be14eb03b052c67843ca2 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Mon, 13 Feb 2023 17:05:32 +0200 Subject: [PATCH] Basic backup functionality --- .gitignore | 2 ++ .sops.yaml | 3 +++ default.nix | 11 +++++---- flake.nix | 6 ++++- image-backup.cabal | 5 +++- secrets.yaml | 33 +++++++++++++++++++++++++++ src/MyLib.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++-- 7 files changed, 108 insertions(+), 9 deletions(-) create mode 100644 .sops.yaml create mode 100644 secrets.yaml diff --git a/.gitignore b/.gitignore index 2cc8a4f..aee4437 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ .direnv .envrc dist-newstyle +*.eventlog* +*.hp diff --git a/.sops.yaml b/.sops.yaml new file mode 100644 index 0000000..7c7dede --- /dev/null +++ b/.sops.yaml @@ -0,0 +1,3 @@ +creation_rules: + - path_regex: "secrets.yaml$" + pgp: "95DBE64C2EA64D6B0E0C8C2F9DE6E04ED1918118" diff --git a/default.nix b/default.nix index c1eb175..58066a1 100644 --- a/default.nix +++ b/default.nix @@ -1,7 +1,7 @@ { mkDerivation, amazonka, amazonka-s3, base, bytestring, conduit -, cryptonite, directory, ekg-core, filepath, lib, mtl, servant -, servant-server, sqlite-simple, text, unordered-containers, wai -, wai-middleware-metrics, warp +, cryptonite, directory, ekg-core, filepath, generic-lens, lens +, lib, mtl, servant, servant-server, sqlite-simple, text, unliftio +, unordered-containers, wai, wai-middleware-metrics, warp }: mkDerivation { pname = "image-backup"; @@ -11,8 +11,9 @@ mkDerivation { isExecutable = true; libraryHaskellDepends = [ amazonka amazonka-s3 base bytestring conduit cryptonite directory - ekg-core filepath mtl servant servant-server sqlite-simple text - unordered-containers wai wai-middleware-metrics warp + ekg-core filepath generic-lens lens mtl servant servant-server + sqlite-simple text unliftio unordered-containers wai + wai-middleware-metrics warp ]; executableHaskellDepends = [ base ]; testHaskellDepends = [ base ]; diff --git a/flake.nix b/flake.nix index 399152d..c5dfb47 100644 --- a/flake.nix +++ b/flake.nix @@ -27,7 +27,7 @@ in { devShell = hp.shellFor { packages = h: [h.image-backup]; - withHoogle = false; + withHoogle = true; # Enabling hoogle because of amazonka-2 buildInputs = with pkgs; [ cabal-install hp.hlint @@ -39,6 +39,10 @@ hp.graphmod hp.haskell-language-server + + sops + + hp.eventlog2html ]; }; } diff --git a/image-backup.cabal b/image-backup.cabal index 421969d..7cba69e 100644 --- a/image-backup.cabal +++ b/image-backup.cabal @@ -87,6 +87,9 @@ library , unordered-containers , wai , warp + , unliftio + , lens + , generic-lens -- Directories containing source files. hs-source-dirs: src @@ -117,7 +120,7 @@ executable image-backup -- Base language which the package is written in. default-language: Haskell2010 - ghc-options: -threaded -with-rtsopts=-T + ghc-options: -threaded -with-rtsopts=-T -eventlog -finfo-table-map -fdistinct-constructor-tables -rtsopts test-suite image-backup-test -- Import common warning flags. diff --git a/secrets.yaml b/secrets.yaml new file mode 100644 index 0000000..e38aa3b --- /dev/null +++ b/secrets.yaml @@ -0,0 +1,33 @@ +AWS_ACCESS_KEY_ID: ENC[AES256_GCM,data:Kh5orSwK+1IKUkxqL918wXnDTVo=,iv:s5CV/q4KibAFqAtawPe+6usZ9wqlkxhArPRJFXCd3r4=,tag:3dGqerYkWVS9kQQUsm8Vnw==,type:str] +AWS_SECRET_KEY: ENC[AES256_GCM,data:vTSTYgksBPgVwQU/KLmLrrU47FhJoR93KbZqsDEKOJuOPzV6,iv:z2z169DxFa7wx/7AbSdgSCeZpUi+dqv9Co1WM01Ija4=,tag:TshCQPq1e+ym6k7XCWOf9A==,type:str] +sops: + kms: [] + gcp_kms: [] + azure_kv: [] + hc_vault: [] + age: [] + lastmodified: "2023-02-13T07:31:42Z" + mac: ENC[AES256_GCM,data:Uh4fyZmTOMMp1LKEajUJMiOFn2dnnRiODCqoTsvYkK9CjJJ040yx4RpxD3mVlIuJPs/lH0XsQTJN2lI4mFCaxc5M2rVQPADYIuvBThjp8A2stvkMPBQ9YaZphHM7rBl2+E+hsepqo5TbecPYWIQXAs2L4X7e+Dab6CH4OTmqiwI=,iv:3YyqIcZP3Fakadk3FqbAr7sdsXb+kl0J/Oc/un1K/es=,tag:Zwvh+AJC7XgHTdAQvnHdrg==,type:str] + pgp: + - created_at: "2023-02-13T07:31:04Z" + enc: |- + -----BEGIN PGP MESSAGE----- + + wcFMA4gPJmmgK0uyARAAhiVs6F2+MkmY124mkUB+d2sxj1ZHpYqJjn4yo2dMnocm + A/VYHpXfxO+BuUBQ+yxu2wYk3Um+gVunXOLUkCIH4dKYszkU7lj5gSqzKcytvT8X + BQY3jSGeb1/kPBDKvx/3ntNwUS/2n3JyLIn7InVm33mnJgraoAL03pDxCUG/9jw3 + LgtYyx7pr0WKCXTWqpzhRfisG7QzlxPzPV1YlbC2SRGufYrvTkfmu5jSyb33WDNP + wRWB+U8Aw1soeEMNEP4RlvK8sWr2imEno0+HLYlMbL5Omg3N5DRarNse/LQfDLhb + L/Rd7IvM/BJ010iqNTMnQyfNVktd5+/GHP4BghHH3a8Yn5og9mxVNhWz+cOOZH+/ + NW5Go7c2xiXvkzOFBe4DoRicXjXxzc5KewcatX+QTBiM2A9SChv2fZkj+khYn5Qe + P7c/ymlCHF9up4t+ThPuzeLyjQzMBkrnSgvyQ7JT0LeEfvM9Zwo8/oXc9DB8Rknu + Pt7wCaKLWWsrisdGyrSdIJ8n8MrM+4k0+VSA69IofH+q9R2anEOcSQUyhjq0G8Lt + lYZC4DqgiPTTz5rdYf9RNhsD9wrkFVjqeU4zAOkVx89DcmanTIX65udrCoZKLANW + 2h1vT+Vccs8BcMNXtqSlAqmx1eEY95T8ugVtacZMBeQQVN/XYfXynJFJGn5pSPHS + UQGN5x/W2RMnOPHtWKp5Cyg3/do6Kttza4EFH5jtQd23eSLFJCpkO9+rjTB5y3mL + H5bncvN3D4DZx//WwxZNSeRNnI9DokwlGAuZ9C/+2cn5wA== + =N/j1 + -----END PGP MESSAGE----- + fp: 95DBE64C2EA64D6B0E0C8C2F9DE6E04ED1918118 + unencrypted_suffix: _unencrypted + version: 3.7.3 diff --git a/src/MyLib.hs b/src/MyLib.hs index 651ca7c..02c168c 100644 --- a/src/MyLib.hs +++ b/src/MyLib.hs @@ -1,16 +1,33 @@ {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DeriveGeneric #-} -module MyLib (someFunc) where +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DataKinds #-} +module MyLib where import Network.Wai.Metrics (metrics, registerWaiMetrics) import System.Metrics (Store, newStore, registerGcMetrics) import Servant.Metrics.Prometheus import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort) -import Data.Function ((&)) import Servant import GHC.Generics (Generic) +import Conduit (runConduit, (.|), MonadUnliftIO, liftIO, ConduitT, MonadResource) +import System.FilePath (isExtensionOf, takeBaseName) +import qualified Data.Conduit.Combinators as C +import Crypto.Hash (HashAlgorithm, Digest, SHA256) +import qualified Crypto.Hash as Crypto +import Amazonka (newEnv, Region(..), Env, Env'(..), setEndpoint, runResourceT, send, chunkedFile, defaultChunkSize) +import Amazonka.Auth (discover) +import qualified Amazonka.S3 as S3 +import qualified Data.Text as T +import Control.Lens (set, (&)) +import Data.Generics.Product (field) +import Control.Monad (void) +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) +import qualified Data.HashMap.Strict as HM newtype Routes route = Routes { _getMetrics :: route :- MetricsRoute } @@ -21,8 +38,44 @@ type API = NamedRoutes Routes app :: Store -> Application app store = serve (Proxy @API) Routes { _getMetrics = metricsServer store } +hash :: (HashAlgorithm a, MonadUnliftIO m) => FilePath -> m (Digest a) +hash path = C.withSourceFile path $ \source -> + Crypto.hashFinalize <$> runConduit (source .| C.foldl Crypto.hashUpdate Crypto.hashInit) + +data Image = Image + { imagePath :: !FilePath + , imageHash :: !(Digest SHA256) + } + deriving Show + +imageToMetadata :: Image -> HashMap Text Text +imageToMetadata img = HM.fromList [("sha256", T.pack . show . imageHash $ img)] + +uploadImage :: Env -> S3.BucketName -> Image -> IO S3.PutObjectResponse +uploadImage env bucket img = do + obj <- chunkedFile defaultChunkSize (imagePath img) + runResourceT $ do + let putObj = S3.newPutObject bucket key obj & set (field @"metadata") mt & set (field @"contentType") (Just "image/jpeg") + key = S3.ObjectKey (T.pack . takeBaseName . imagePath $ img) + mt = imageToMetadata img + send env putObj + +scan :: (MonadResource m) => FilePath -> (FilePath -> Bool) -> ConduitT () FilePath m () +scan root predicate = C.sourceDirectoryDeep False root .| C.filter predicate + +analyze :: (MonadUnliftIO m) => ConduitT FilePath Image m () +analyze = C.mapM (\p -> Image p <$> hash p) + someFunc :: IO () someFunc = do + discoveredEnv <- newEnv discover + let env = discoveredEnv + { region = Region' "fr-par" + , overrides = setEndpoint True "s3.fr-par.scw.cloud" 443 + } + bucket = S3.BucketName "introitu-photoprism" + _ <- runResourceT $ runConduit $ scan "/home/masse/wikidata/" (isExtensionOf ".jpg") .| analyze .| C.iterM (liftIO . print) .| C.mapM_ (void . liftIO . uploadImage env bucket) + putStrLn "done" store <- newStore waiMetrics <- registerWaiMetrics store registerGcMetrics store